#!/usr/bin/perl

# This script is published under Perl License
# (c)2001 JL4CVB Yuzo

# User Configuration ----------------------------------------------------

$Directory = './PALM/PROGRAMS/Docs'; #このスクリプトから見た相対Directory
$TextFiles = ['*.htm', '*.html', '*.HTM', '*.txt', '*.TXT'];
$BackUp = 0;
$Secret = 1;

# This script will not write "before $DeleteHeaderTill" and 
# "after $DeleteFooterFrom" to PDB file.
# (PDBに変換する際、$DeleteHeaderTill以前と 
# $DeleteFooterFrom以降は書き出さない)
#$DeleteHeaderTill = '<body[^>]*>';
#$DeleteFooterFrom = '<address>';

#------------------------------------------------------------------------

$RecMaxSize = 4096;
$RecMinSize = 3072;

{

    $0 =~ m/^(.*[\/\\])[^\/\\]*$/;
    my $scriptDir = $1;
    $scriptDir =~ s!/[^/]*$!! if(($scriptDir ne '') and (! -d $scriptDir));
    chdir("$scriptDir$Directory");

    my $tfiles = &globFiles($TextFiles);

    foreach $tfName (keys %$tfiles){
#	my $tftime = $tfiles->{$tfName};
	my $text2Write = [];
	
	# [78,94] means pdb-header(78) and  pdb-header + doc-headerDOC (78+16)
	# (pdbヘッダ(78)と pdbヘッダ＋DOCヘッダ(78+16))
	my $recOffset = [78,94]; 
	
	($text2Write,$recOffset) = 
	    &decideOffset($tfName, $text2Write, $recOffset);
#	&decideOffset_old($tfName, $text2Write, $recOffset);
	
	my $recNum = scalar(@$recOffset) - 1;
	for(my $i=0; $i < $recNum; $i++){
	    $recOffset->[$i] += ($recNum * 8) ;
	}
	
	# $recOffset->[-1] is "length of document itself"
	$recOffset->[-1] -= 94;
	
	&writePDB($text2Write,$recOffset,$recNum,$tfName);
    }
}

sub decideOffset($\@\@){
    my ($file,$result,$recOffset) = @_;
    my $text = [];
    my $recSize = 0;
    my ($line2Start,$lineNum) = (0,1);

    open(TXT,"$file");
    while(<TXT>){
	s/[\r\n]+$/\n/;
	push(@$text,$_);
    }
    close(TXT);
 
    if ($DeleteHeaderTill ne ''){
	for(@$text){
	    $line2Start = $lineNum if (/$DeleteHeaderTill\n?(.*)/i);
	    $lineNum ++;
	}
    }

    $lineNum = 0;
    while(@$text){
	my $line = shift(@$text);
	$lineNum++;
	last if (($DeleteFooterFrom ne '')and($line =~ /^$DeleteFooterFrom/i));

	next if ($lineNum < $line2Start);
	if($lineNum == $line2Start){
	    $line =~ s/$DeleteHeaderTill\n?(.*)/$line = $1 if ($1 ne '')/e;
	}
	
	push(@$result,$line);
	($recOffset,$recSize) = 
	    &addRecOffset($recOffset,$recSize,length($line));
    }
    push(@$recOffset, $recOffset->[-1] + $recSize) if ($recSize > 0);
    return ($result,$recOffset);
}

sub decideOffset_old($\@\@){
    my ($file,$result,$recOffset) = @_;
    my $recSize = 0;
    my $flagGet = ($DeleteHeaderTill eq '')? 1 : 0;
    # Read from top of file if ($DeleteHeaderTill eq '')

    open(TXT,"$file");
    while(<TXT>){
	s/[\r\n]+$/\n/;

	last if (($DeleteFooterFrom ne '') and (/^$DeleteFooterFrom/i));

	if ($flagGet == 1){
	    push(@$result,$_);
	    ($recOffset,$recSize) = 
		&addRecOffset($recOffset,$recSize,length($_));

	}elsif(/$DeleteHeaderTill\n?(.*)/i){
	    if ($1 ne ''){
		push(@$result,$1);
		($recOffset,$recSize) = 
		    &addRecOffset($recOffset,$recSize,length($1));
	    }
	    $flagGet = 1;
	}
    }
    push(@$recOffset, $recOffset->[-1] + $recSize) if ($recSize > 0);
    close(TXT);

    return ($result,$recOffset);
}


sub addRecOffset(\@$$){
    my ($recOffset,$recSize,$lineSize) = @_;
    die "Line is too long" if ($lineSize > $RecMaxSize);

    if (($recSize + $lineSize) >= $RecMaxSize){
	push(@$recOffset, $recOffset->[-1] + $recSize);
	$recSize = $lineSize;

    }elsif (($recSize + $lineSize) > $RecMinSize){
	push(@$recOffset, $recOffset->[-1] + $recSize + $lineSize);
	$recSize = 0;

    }else{
	$recSize += $lineSize;
    }
    return ($recOffset,$recSize);
}

sub writePDB(\@\@$$){
    my ($text,$recOffset,$numRec,$tfName) = @_;
    my $pfName = $tfName;
    $pfName =~ s/\..*$/.pdb/;
    $pfName =~ s/old\-\d+$//;
    my $time = time;

    if((-f $pfName) and ($BackUp > 0)){
	$pfName =~ /^(.*)\.(.*)$/; 
	my ($fn1, $fn2, $i) = ($1, $2, 0);
	while(-f "$fn1\-old$i\.$fn2"){ $i++; };
	rename("$pfName", "$fn1\-old$i\.$fn2");
    }

    print "$tfName -> $pfName\n";

    open (PDBW,">$pfName");
    binmode PDBW;

    #pdb-header (78bytes)
    # $file->[1] : pdb name (32bytes), padded by \x00
    # 8 : backup bit
    # 114377902 : create/modified date. by txt2pdbdoc.c
    # TEXt, REAd : type, creatorID. 'REAd' means 'for DOCreader'
    #       http://www.palmos.com/dev/tech/palmos/creatorid/ 
    # $numRec : numbers of Record (document-header included).
    print PDBW pack("a32nx2N2x16a4a4x8n",
		    ($tfName,8,114377902,114377902,"TEXt","REAd",$numRec));
    
    # record header (8bytes each)
    for(my $i=0;$i < $numRec; $i++){
	# RecOffset->[$i] : where the record starts (4bytes)
	# 16945, $i+32768 = \x40 \x6F \x80 $i
	#               : some Flag (1byte) and recID (3bytes)
	print PDBW pack("Nnn",($recOffset->[$i],16495,$i + 32768));
	print "size:$recOffset->[$i]\n";
    }

    # doc header(16bytes)
    # 1          :  1=plain, 2=compressed (2bytes) 
    # $recOffset->[-1] : length of non-compressed DOCUMENT (not PDB data) (4)
    # $numRec -1 : numbers of records in DOCUMENT (not PDB data) (2bytes)
    # 4096       : max size of each record (2bytes)
    print PDBW pack ("nx2Nnnx4",(1,$recOffset->[-1],($numRec - 1),4096));

    for(@$text){
	print PDBW "$_";
    }
    close(PDBW);
}

sub globFiles(\@){
    my $glob = shift;
    my ($fileList,$g,$f,@l, @fst);
    use Config;

    foreach $g (@$glob){

	if ($Config{'archname'} =~ /WCE/i){  # Perl for WinCE
	    system("ls -1 $g");
	    rename("/ls-stdout.txt","glob.tmp");
	    open(GLOB,"glob.tmp");
	    @l = <GLOB>;
	    close(GLOB);
	    unlink('glob.tmp');
	}else{
	    @l = glob($g);
	}

	foreach $f (@l){
	    $f = lc($f) if ($Config{'archname'} =~ /MSWin32/);
	    next if (($f =~ m/(_cnv|\~)$/i) or ($fileList->{$f} > 0));
	    @fst = lstat($f);
	    $fileList->{$f} = $fst[9];
	}
    }
    return $fileList;
}