mirror of
git://xwords.git.sourceforge.net/gitroot/xwords/xwords
synced 2025-01-09 05:24:44 +01:00
remove files I'll never need again
This commit is contained in:
Eric House
parent
98d134b491
commit
10ae99fb5e
3 changed files with 0 additions and 1101 deletions
|
|
@ -1,10 +0,0 @@
|
||||||
#!/usr/bin/perl
|
|
||||||
|
|
||||||
# Print all ascii characters (for pasting into Makefiles etc. when you
|
|
||||||
# don't know what key combination produces them)
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
|
|
||||||
for ( my $i = int(' '); $i <= 255; ++$i ) {
|
|
||||||
printf "%.3d: %c\n", $i, $i;
|
|
||||||
}
|
|
||||||
|
|
@ -1,857 +0,0 @@
|
||||||
#!/usr/bin/perl
|
|
||||||
|
|
||||||
##############################################################################
|
|
||||||
# adapted from C++ code Copyright (C) 2000 Falk Hueffner
|
|
||||||
# This version Copyright (C) 2002 Eric House (xwords@eehouse.org)
|
|
||||||
#
|
|
||||||
# This program is free software; you can redistribute it and/or modify
|
|
||||||
# it under the terms of the GNU General Public License as published by
|
|
||||||
# the Free Software Foundation; either version 2 of the License, or
|
|
||||||
# (at your option) any later version.
|
|
||||||
#
|
|
||||||
# This program is distributed in the hope that it will be useful, but
|
|
||||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
||||||
# General Public License for more details.
|
|
||||||
#
|
|
||||||
# You should have received a copy of the GNU General Public License
|
|
||||||
# along with this program; if not, write to the Free Software
|
|
||||||
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
|
||||||
# USA
|
|
||||||
##############################################################################
|
|
||||||
|
|
||||||
# inputs: 0. Name of file mapping letters to 0..31 values. In English
|
|
||||||
# case just contains A..Z. This will be used to translate the tries
|
|
||||||
# on output.
|
|
||||||
# 1. Max number of bytes per binary output file.
|
|
||||||
#
|
|
||||||
# 2. Basename of binary files for output.
|
|
||||||
|
|
||||||
# 3. Name of file to which to write the number of the
|
|
||||||
# startNode, since I'm not rewriting a bunch of code to expect Falk's
|
|
||||||
# '*' node at the start.
|
|
||||||
#
|
|
||||||
|
|
||||||
# In STDIN, the text file to be compressed. It absolutely
|
|
||||||
# must be sorted. The sort doesn't have to follow the order in the
|
|
||||||
# map file, however.
|
|
||||||
|
|
||||||
# This is meant eventually to be runnable as part of a cgi system for
|
|
||||||
# letting users generate Crosswords dicts online.
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
use POSIX;
|
|
||||||
|
|
||||||
my $gFirstDiff;
|
|
||||||
my @gCurrentWord;
|
|
||||||
my $gCurrentWord; # save so can check for sortedness
|
|
||||||
my $gDone = 0;
|
|
||||||
my @gInputStrings;
|
|
||||||
my $gNeedsSort = 1; # read from cmd line eventually
|
|
||||||
my @gNodes; # final array of nodes
|
|
||||||
my $gNBytesPerOutfile = 0xFFFFFFFF;
|
|
||||||
my $gTableFile;
|
|
||||||
my $gOutFileBase;
|
|
||||||
my $gStartNodeOut;
|
|
||||||
my $gInFileName;
|
|
||||||
my $gKillIfMissing = 1;
|
|
||||||
my $gTermChar = '/n';
|
|
||||||
my $gDumpText = 0; # dump the dict as text after?
|
|
||||||
my $gCountFile;
|
|
||||||
my $gBytesPerNodeFile; # where to write whether node size 3 or 4
|
|
||||||
my $gWordCount = 0;
|
|
||||||
my %gTableHash;
|
|
||||||
my $gBlankIndex;
|
|
||||||
my @gRevMap;
|
|
||||||
my $debug = 0;
|
|
||||||
my %gSubsHash;
|
|
||||||
my $gForceFour = 0; # use four bytes regardless of need?
|
|
||||||
my $gNBytesPerNode;
|
|
||||||
my $gUseUnicode;
|
|
||||||
|
|
||||||
main();
|
|
||||||
|
|
||||||
exit;
|
|
||||||
|
|
||||||
##############################################################################
|
|
||||||
|
|
||||||
sub main() {
|
|
||||||
|
|
||||||
if ( !parseARGV() ) {
|
|
||||||
usage();
|
|
||||||
exit();
|
|
||||||
}
|
|
||||||
|
|
||||||
makeTableHash();
|
|
||||||
|
|
||||||
my $infile;
|
|
||||||
|
|
||||||
if ( $gInFileName ) {
|
|
||||||
open $infile, "<$gInFileName";
|
|
||||||
} else {
|
|
||||||
$infile = \*STDIN;
|
|
||||||
}
|
|
||||||
|
|
||||||
@gInputStrings = parseAndSort( $infile );
|
|
||||||
if ( $gInFileName ) {
|
|
||||||
close $infile;
|
|
||||||
}
|
|
||||||
|
|
||||||
# Do I need this stupid thing? Better to move the first row to
|
|
||||||
# the front of the array and patch everything else. Or fix the
|
|
||||||
# non-palm dictionary format to include the offset of the first
|
|
||||||
# node.
|
|
||||||
|
|
||||||
my $dummyNode = 0xFFFFFFFF;
|
|
||||||
@gNodes = ( $dummyNode );
|
|
||||||
|
|
||||||
readNextWord();
|
|
||||||
|
|
||||||
my $firstRootChildOffset = buildNode(0);
|
|
||||||
|
|
||||||
moveTopToFront( \$firstRootChildOffset );
|
|
||||||
|
|
||||||
if ( $gStartNodeOut ) {
|
|
||||||
writeOutStartNode( $gStartNodeOut, $firstRootChildOffset );
|
|
||||||
}
|
|
||||||
|
|
||||||
print STDERR "\n... dumping table ...\n" if $debug;
|
|
||||||
printNodes( \@gNodes, "done with main" ) if $debug;
|
|
||||||
|
|
||||||
# write out the number of nodes if requested
|
|
||||||
if ( $gCountFile ) {
|
|
||||||
open OFILE, "> $gCountFile";
|
|
||||||
print OFILE pack( "N", $gWordCount );
|
|
||||||
close OFILE;
|
|
||||||
print STDERR "wrote out: got $gWordCount words\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( $gOutFileBase ) {
|
|
||||||
emitNodes( $gNBytesPerOutfile, $gOutFileBase );
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( $gDumpText && @gNodes > 0 ) {
|
|
||||||
printOneLevel( $firstRootChildOffset, "" );
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( $gBytesPerNodeFile ) {
|
|
||||||
open OFILE, "> $gBytesPerNodeFile";
|
|
||||||
print OFILE $gNBytesPerNode;
|
|
||||||
close OFILE;
|
|
||||||
}
|
|
||||||
print STDERR "Used $gNBytesPerNode per node.\n";
|
|
||||||
} # main
|
|
||||||
|
|
||||||
# We now have an array of nodes with the last subarray being the
|
|
||||||
# logical top of the tree. Move them to the start, fixing all fco
|
|
||||||
# refs, so that legacy code like Palm can assume top==0.
|
|
||||||
#
|
|
||||||
# Note: It'd probably be a bit faster to integrate this with emitNodes
|
|
||||||
# -- unless I need to have an in-memory list that can be used for
|
|
||||||
# lookups. But that's best for debugging, so keep it this way for now.
|
|
||||||
#
|
|
||||||
# Also Note: the first node is a dummy that can and should be tossed
|
|
||||||
# now.
|
|
||||||
|
|
||||||
sub moveTopToFront($) {
|
|
||||||
my ( $firstRef ) = @_;
|
|
||||||
|
|
||||||
my $firstChild = ${$firstRef};
|
|
||||||
${$firstRef} = 0;
|
|
||||||
my @lastSub;
|
|
||||||
|
|
||||||
if ( $firstChild > 0 ) {
|
|
||||||
# remove the last (the root) subarray
|
|
||||||
@lastSub = splice( @gNodes, $firstChild );
|
|
||||||
} else {
|
|
||||||
die "there should be no words!!" if $gWordCount != 0;
|
|
||||||
}
|
|
||||||
# remove the first (garbage) node
|
|
||||||
shift @gNodes;
|
|
||||||
|
|
||||||
my $diff;
|
|
||||||
if ( $firstChild > 0 ) {
|
|
||||||
# -1 because all move down by 1; see prev line
|
|
||||||
$diff = @lastSub - 1;
|
|
||||||
die "something wrong with len\n" if $diff < 0;
|
|
||||||
} else {
|
|
||||||
$diff = 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
# stick it on the front
|
|
||||||
splice( @gNodes, 0, 0, @lastSub);
|
|
||||||
|
|
||||||
# We add $diff to everything. There's no subtracting because
|
|
||||||
# nobody had any refs to the top list.
|
|
||||||
|
|
||||||
for ( my $i = 0; $i < @gNodes; ++$i ) {
|
|
||||||
my $fco = TrieNodeGetFirstChildOffset( $gNodes[$i] );
|
|
||||||
if ( $fco != 0 ) { # 0 means NONE, not 0th!!
|
|
||||||
TrieNodeSetFirstChildOffset( \$gNodes[$i], $fco+$diff );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} # moveTopToFront
|
|
||||||
|
|
||||||
|
|
||||||
sub buildNode {
|
|
||||||
my ( $depth ) = @_;
|
|
||||||
|
|
||||||
if ( @gCurrentWord == $depth ) {
|
|
||||||
# End of word reached. If the next word isn't a continuation
|
|
||||||
# of the current one, then we've reached the bottom of the
|
|
||||||
# recursion tree.
|
|
||||||
readNextWord();
|
|
||||||
if ($gFirstDiff < $depth || $gDone) {
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
my @newedges;
|
|
||||||
|
|
||||||
do {
|
|
||||||
my $letter = $gCurrentWord[$depth];
|
|
||||||
my $isTerminal = @gCurrentWord - 1 == $depth ? 1:0;
|
|
||||||
|
|
||||||
my $nodeOffset = buildNode($depth+1);
|
|
||||||
my $newNode = MakeTrieNode($letter, $isTerminal, $nodeOffset);
|
|
||||||
push( @newedges, $newNode );
|
|
||||||
|
|
||||||
} while ( ($gFirstDiff == $depth) && !$gDone);
|
|
||||||
|
|
||||||
TrieNodeSetIsLastSibling( \@newedges[@newedges-1], 1 );
|
|
||||||
|
|
||||||
return addNodes( \@newedges );
|
|
||||||
} # buildNode
|
|
||||||
|
|
||||||
sub addNodes {
|
|
||||||
my ( $newedgesR ) = @_;
|
|
||||||
|
|
||||||
my $found = findSubArray( $newedgesR );
|
|
||||||
|
|
||||||
if ( $found >= 0 ) {
|
|
||||||
die "0 is an invalid match!!!" if $found == 0;
|
|
||||||
return $found;
|
|
||||||
} else {
|
|
||||||
|
|
||||||
my $firstFreeIndex = @gNodes;
|
|
||||||
|
|
||||||
print STDERR "adding...\n" if $debug;
|
|
||||||
printNodes( $newedgesR ) if $debug;
|
|
||||||
|
|
||||||
push @gNodes, (@{$newedgesR});
|
|
||||||
|
|
||||||
registerSubArray( $newedgesR, $firstFreeIndex );
|
|
||||||
return $firstFreeIndex;
|
|
||||||
}
|
|
||||||
} # addNodes
|
|
||||||
|
|
||||||
sub printNode {
|
|
||||||
my ( $index, $node ) = @_;
|
|
||||||
|
|
||||||
print STDERR "[$index] ";
|
|
||||||
|
|
||||||
my $letter = TrieNodeGetLetter($node);
|
|
||||||
printf( STDERR
|
|
||||||
"letter=%d(%s); isTerminal=%d; isLastSib=%d; fco=%d;\n",
|
|
||||||
$letter, "" . $gRevMap[$letter],
|
|
||||||
TrieNodeGetIsTerminal($node),
|
|
||||||
TrieNodeGetIsLastSibling($node),
|
|
||||||
TrieNodeGetFirstChildOffset($node));
|
|
||||||
} # printNode
|
|
||||||
|
|
||||||
sub printNodes {
|
|
||||||
my ( $nodesR, $name ) = @_;
|
|
||||||
|
|
||||||
my $len = @{$nodesR};
|
|
||||||
# print "printNodes($name): len = $len\n";
|
|
||||||
|
|
||||||
for ( my $i = 0; $i < $len; ++$i ) {
|
|
||||||
my $node = ${$nodesR}[$i];
|
|
||||||
printNode( $i, $node );
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# Hashing. We'll keep a hash of offsets into the existing nodes
|
|
||||||
# array, and as the key use a string that represents the entire sub
|
|
||||||
# array. Since the key is what we're matching for, there should never
|
|
||||||
# be more than one value per hash and so we don't need buckets.
|
|
||||||
# Return -1 if there's no match.
|
|
||||||
|
|
||||||
sub findSubArray {
|
|
||||||
my ( $newedgesR ) = @_;
|
|
||||||
|
|
||||||
my $key = join('', @{$newedgesR});
|
|
||||||
|
|
||||||
if ( exists( $gSubsHash{$key} ) ) {
|
|
||||||
return $gSubsHash{$key};
|
|
||||||
} else {
|
|
||||||
return -1;
|
|
||||||
}
|
|
||||||
} # findSubArray
|
|
||||||
|
|
||||||
# add to the hash
|
|
||||||
sub registerSubArray {
|
|
||||||
my ( $edgesR, $nodeLoc ) = @_;
|
|
||||||
|
|
||||||
my $key = join( '', @{$edgesR} );
|
|
||||||
|
|
||||||
if ( exists $gSubsHash{$key} ) {
|
|
||||||
die "entry for key shouldn't exist!!";
|
|
||||||
} else {
|
|
||||||
$gSubsHash{$key} = $nodeLoc;
|
|
||||||
}
|
|
||||||
|
|
||||||
} # registerSubArray
|
|
||||||
|
|
||||||
sub toWord($) {
|
|
||||||
my ( $tileARef ) = @_;
|
|
||||||
my $word = "";
|
|
||||||
|
|
||||||
foreach my $tile (@$tileARef) {
|
|
||||||
foreach my $letter (keys (%gTableHash) ) {
|
|
||||||
if ( $tile == $gTableHash{$letter} ) {
|
|
||||||
$word .= $letter;
|
|
||||||
last;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return $word;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub readNextWord() {
|
|
||||||
my @word;
|
|
||||||
|
|
||||||
if ( !$gDone ) {
|
|
||||||
$gDone = @gInputStrings == 0;
|
|
||||||
if ( !$gDone ) {
|
|
||||||
@word = @{shift @gInputStrings};
|
|
||||||
} else {
|
|
||||||
print STDERR "gDone set to true\n" if $debug;
|
|
||||||
}
|
|
||||||
|
|
||||||
print STDERR "got word: ", join(',',@word), "\n" if $debug;
|
|
||||||
}
|
|
||||||
my $numCommonLetters = 0;
|
|
||||||
my $len = @word;
|
|
||||||
if ( @gCurrentWord < $len ) {
|
|
||||||
$len = @gCurrentWord;
|
|
||||||
}
|
|
||||||
|
|
||||||
while ( @gCurrentWord[$numCommonLetters] eq @word[$numCommonLetters]
|
|
||||||
&& $numCommonLetters < $len) {
|
|
||||||
++$numCommonLetters;
|
|
||||||
}
|
|
||||||
|
|
||||||
$gFirstDiff = $numCommonLetters;
|
|
||||||
if ( #$debug &&
|
|
||||||
@gCurrentWord > 0 && @word > 0
|
|
||||||
&& !firstBeforeSecond( \@gCurrentWord, \@word ) ) {
|
|
||||||
die "words ", join(",",@gCurrentWord), " (" . toWord(\@gCurrentWord) .
|
|
||||||
") and " . join(",", @word) . " (" . toWord(\@word) .
|
|
||||||
") out of order";
|
|
||||||
}
|
|
||||||
@gCurrentWord = @word;
|
|
||||||
} # readNextWord
|
|
||||||
|
|
||||||
sub firstBeforeSecond {
|
|
||||||
my ( $firstR, $secondR ) = @_;
|
|
||||||
|
|
||||||
for ( my $i = 0; ; ++$i ) {
|
|
||||||
|
|
||||||
# if we reach the end of the first word/list, we're done.
|
|
||||||
if ( $i == @{$firstR} ) {
|
|
||||||
die "duplicate!!!" if $i == @{$secondR};
|
|
||||||
return 1;
|
|
||||||
# but if we reach the second end first, we've failed
|
|
||||||
} elsif ( $i == @{$secondR} ) {
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
my $diff = ${$firstR}[$i] <=> ${$secondR}[$i];
|
|
||||||
|
|
||||||
if ( $diff == 0 ) {
|
|
||||||
next;
|
|
||||||
} else {
|
|
||||||
return $diff < 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} # firstBeforeSecond
|
|
||||||
|
|
||||||
# passed to sort. Should remain unprototyped for effeciency's sake
|
|
||||||
|
|
||||||
sub cmpWords {
|
|
||||||
|
|
||||||
my $lenA = @{$a};
|
|
||||||
my $lenB = @{$b};
|
|
||||||
my $min = $lenA > $lenB? $lenB: $lenA;
|
|
||||||
|
|
||||||
for ( my $i = 0; $i < $min; ++$i ) {
|
|
||||||
my $ac = ${$a}[$i];
|
|
||||||
my $bc = ${$b}[$i];
|
|
||||||
|
|
||||||
my $res = $ac <=> $bc;
|
|
||||||
|
|
||||||
if ( $res != 0 ) {
|
|
||||||
return $res; # we're done
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# If we got here, they match up to their common length. Longer is
|
|
||||||
# greater.
|
|
||||||
my $res = @{$a} <=> @{$b};
|
|
||||||
return $res; # which is longer?
|
|
||||||
} # cmpWords
|
|
||||||
|
|
||||||
sub parseAndSort() {
|
|
||||||
my ( $infile ) = @_;
|
|
||||||
|
|
||||||
my @wordlist;
|
|
||||||
my @word;
|
|
||||||
|
|
||||||
my $lastWord;
|
|
||||||
WORDLOOP:
|
|
||||||
for ( ; ; ) {
|
|
||||||
|
|
||||||
my $dropWord = 0;
|
|
||||||
splice @word; # empty it
|
|
||||||
|
|
||||||
# for each byte
|
|
||||||
for ( ; ; ) {
|
|
||||||
my $byt = getc($infile);
|
|
||||||
|
|
||||||
if ( $byt eq undef ) {
|
|
||||||
last WORDLOOP;
|
|
||||||
} elsif ( $byt eq $gTermChar ) {
|
|
||||||
if ( !$dropWord ) {
|
|
||||||
push @wordlist, [ @word ];
|
|
||||||
++$gWordCount;
|
|
||||||
}
|
|
||||||
$lastWord = "";
|
|
||||||
next WORDLOOP;
|
|
||||||
} elsif ( exists( $gTableHash{$byt} ) ) {
|
|
||||||
if ( !$dropWord ) {
|
|
||||||
push @word, $gTableHash{$byt};
|
|
||||||
die "word too long" if @word > 15;
|
|
||||||
if ( $gKillIfMissing ) {
|
|
||||||
$lastWord .= $byt;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} elsif ($gKillIfMissing) {
|
|
||||||
die "$0: chr $byt (", $byt+0, ") not in map file $gTableFile\n"
|
|
||||||
. "last word was $lastWord\n";
|
|
||||||
} else {
|
|
||||||
$dropWord = 1;
|
|
||||||
splice @word; # lose anything we already have
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( $gNeedsSort && ($gWordCount > 0) ) {
|
|
||||||
print STDERR "starting sort...\n" if $debug;
|
|
||||||
@wordlist = sort cmpWords @wordlist;
|
|
||||||
print STDERR "sort finished\n" if $debug;
|
|
||||||
}
|
|
||||||
|
|
||||||
print STDERR "length of list is ", @wordlist + 0, ".\n" if $debug;
|
|
||||||
|
|
||||||
return @wordlist;
|
|
||||||
} # parseAndSort
|
|
||||||
|
|
||||||
# Print binary representation of trie array. This isn't used yet, but
|
|
||||||
# eventually it'll want to dump to multiple files appropriate for Palm
|
|
||||||
# that can be catenated together on other platforms. There'll need to
|
|
||||||
# be a file giving the offset of the first node too. Also, might want
|
|
||||||
# to move to 4-byte representation when the input can't otherwise be
|
|
||||||
# handled.
|
|
||||||
|
|
||||||
sub dumpNodes {
|
|
||||||
|
|
||||||
for ( my $i = 0; $i < @gNodes; ++$i ) {
|
|
||||||
my $node = $gNodes[$i];
|
|
||||||
my $bstr = pack( "I", $node );
|
|
||||||
print STDOUT $bstr;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
##############################################################################
|
|
||||||
# Little node-field setters and getters to hide what bits represent
|
|
||||||
# what.
|
|
||||||
#
|
|
||||||
# high bit (31) is ACCEPTING bit
|
|
||||||
# next bit (30) is LAST_SIBLING bit
|
|
||||||
# next 6 bits (29-24) are tile bit (allowing alphabets of 64 letters)
|
|
||||||
# final 24 bits (23-0) are the index of the first child (fco)
|
|
||||||
#
|
|
||||||
##############################################################################
|
|
||||||
|
|
||||||
sub TrieNodeSetIsTerminal {
|
|
||||||
my ( $nodeR, $isTerminal ) = @_;
|
|
||||||
|
|
||||||
if ( $isTerminal ) {
|
|
||||||
${$nodeR} |= (1 << 31);
|
|
||||||
} else {
|
|
||||||
${$nodeR} &= ~(1 << 31);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub TrieNodeGetIsTerminal {
|
|
||||||
my ( $node ) = @_;
|
|
||||||
return ($node & (1 << 31)) != 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub TrieNodeSetIsLastSibling {
|
|
||||||
my ( $nodeR, $isLastSibling ) = @_;
|
|
||||||
if ( $isLastSibling ) {
|
|
||||||
${$nodeR} |= (1 << 30);
|
|
||||||
} else {
|
|
||||||
${$nodeR} &= ~(1 << 30);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub TrieNodeGetIsLastSibling {
|
|
||||||
my ( $node ) = @_;
|
|
||||||
return ($node & (1 << 30)) != 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub TrieNodeSetLetter {
|
|
||||||
my ( $nodeR, $letter ) = @_;
|
|
||||||
|
|
||||||
die "$0: letter ", $letter, " too big" if $letter >= 64;
|
|
||||||
|
|
||||||
my $mask = ~(0x3F << 24);
|
|
||||||
${$nodeR} &= $mask; # clear all the bits
|
|
||||||
${$nodeR} |= ($letter << 24); # set new ones
|
|
||||||
}
|
|
||||||
|
|
||||||
sub TrieNodeGetLetter {
|
|
||||||
my ( $node ) = @_;
|
|
||||||
$node >>= 24;
|
|
||||||
$node &= 0x3F; # is 3f ok for 3-byte case???
|
|
||||||
return $node;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub TrieNodeSetFirstChildOffset {
|
|
||||||
my ( $nodeR, $fco ) = @_;
|
|
||||||
|
|
||||||
die "$0: $fco larger than 24 bits" if ($fco & 0xFF000000) != 0;
|
|
||||||
|
|
||||||
my $mask = ~0x00FFFFFF;
|
|
||||||
${$nodeR} &= $mask; # clear all the bits
|
|
||||||
${$nodeR} |= $fco; # set new ones
|
|
||||||
}
|
|
||||||
|
|
||||||
sub TrieNodeGetFirstChildOffset {
|
|
||||||
my ( $node ) = @_;
|
|
||||||
$node &= 0x00FFFFFF; # 24 bits
|
|
||||||
return $node;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub MakeTrieNode {
|
|
||||||
my ( $letter, $isTerminal, $firstChildOffset, $isLastSibling ) = @_;
|
|
||||||
my $result = 0;
|
|
||||||
|
|
||||||
TrieNodeSetIsTerminal( \$result, $isTerminal );
|
|
||||||
TrieNodeSetIsLastSibling( \$result, $isLastSibling );
|
|
||||||
TrieNodeSetLetter( \$result, $letter );
|
|
||||||
TrieNodeSetFirstChildOffset( \$result, $firstChildOffset );
|
|
||||||
|
|
||||||
return $result;
|
|
||||||
} # MakeTrieNode
|
|
||||||
|
|
||||||
# Caller may need to know the offset of the first top-level node.
|
|
||||||
# Write it here.
|
|
||||||
sub writeOutStartNode {
|
|
||||||
my ( $startNodeOut, $firstRootChildOffset ) = @_;
|
|
||||||
|
|
||||||
open NODEOUT, ">$startNodeOut";
|
|
||||||
print NODEOUT pack( "N", $firstRootChildOffset );
|
|
||||||
close NODEOUT;
|
|
||||||
} # writeOutStartNode
|
|
||||||
|
|
||||||
# build the hash for translating. I'm using a hash assuming it'll be
|
|
||||||
# fast. Key is the letter; value is the 0..31 value to be output.
|
|
||||||
sub makeTableHash {
|
|
||||||
my $i;
|
|
||||||
open TABLEFILE, "< $gTableFile";
|
|
||||||
|
|
||||||
splice @gRevMap; # empty it
|
|
||||||
|
|
||||||
for ( $i = 0; ; ++$i ) {
|
|
||||||
my $ch = getc(TABLEFILE);
|
|
||||||
if ( $ch eq undef ) {
|
|
||||||
last;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( $gUseUnicode ) { # skip the first byte each time: tmp HACK!!!
|
|
||||||
$ch = getc(TABLEFILE);
|
|
||||||
}
|
|
||||||
if ( $ch eq undef ) {
|
|
||||||
last;
|
|
||||||
}
|
|
||||||
|
|
||||||
push @gRevMap, $ch;
|
|
||||||
|
|
||||||
if ( ord($ch) == 0 ) { # blank
|
|
||||||
$gBlankIndex = $i;
|
|
||||||
next; # we want to increment i when blank seen since
|
|
||||||
# it is a tile value
|
|
||||||
}
|
|
||||||
|
|
||||||
die "$0: $gTableFile too large\n" if $i > 64;
|
|
||||||
die "$0: only blank (0) can be 64th char\n" if ($i == 64 && $ch != 0);
|
|
||||||
|
|
||||||
$gTableHash{$ch} = $i;
|
|
||||||
}
|
|
||||||
|
|
||||||
close TABLEFILE;
|
|
||||||
} # makeTableHash
|
|
||||||
|
|
||||||
# emitNodes. "input" is $gNodes. From it we write up to
|
|
||||||
# $nBytesPerOutfile to files named $outFileBase0..n, mapping the
|
|
||||||
# letter field down to 5 bits with a hash built from $tableFile. If
|
|
||||||
# at any point we encounter a letter not in the hash we fail with an
|
|
||||||
# error.
|
|
||||||
|
|
||||||
sub emitNodes($$) {
|
|
||||||
my ( $nBytesPerOutfile, $outFileBase ) = @_;
|
|
||||||
|
|
||||||
# now do the emit.
|
|
||||||
|
|
||||||
# is 17 bits enough?
|
|
||||||
printf STDERR ("There are %d (0x%x) nodes in this DAWG.\n",
|
|
||||||
0 + @gNodes, 0 + @gNodes );
|
|
||||||
my $nTiles = 0 + keys(%gTableHash); # blank is not included in this count!
|
|
||||||
if ( @gNodes > 0x1FFFF || $gForceFour || $nTiles > 32 ) {
|
|
||||||
$gNBytesPerNode = 4;
|
|
||||||
} elsif ( $nTiles < 32 ) {
|
|
||||||
$gNBytesPerNode = 3;
|
|
||||||
} else {
|
|
||||||
if ( $gBlankIndex == 32 ) { # blank
|
|
||||||
print STDERR "blank's at 32; 3-byte-nodes still ok\n";
|
|
||||||
$gNBytesPerNode = 3;
|
|
||||||
} else {
|
|
||||||
die "$0: move blank to last position in info.txt for smaller DAWG";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
my $nextIndex = 0;
|
|
||||||
my $nextFileNum = 0;
|
|
||||||
|
|
||||||
for ( $nextFileNum = 0; ; ++$nextFileNum ) {
|
|
||||||
|
|
||||||
if ( $nextIndex >= @gNodes ) {
|
|
||||||
last; # we're done
|
|
||||||
}
|
|
||||||
|
|
||||||
die "Too many outfiles; infinite loop?" if $nextFileNum > 99;
|
|
||||||
|
|
||||||
my $outName = sprintf("${outFileBase}_%03d.bin", $nextFileNum);
|
|
||||||
open OUTFILE, "> $outName";
|
|
||||||
binmode( OUTFILE );
|
|
||||||
my $curSize = 0;
|
|
||||||
|
|
||||||
while ( $nextIndex < @gNodes ) {
|
|
||||||
|
|
||||||
# scan to find the next terminal
|
|
||||||
my $i;
|
|
||||||
for ( $i = $nextIndex;
|
|
||||||
!TrieNodeGetIsLastSibling($gNodes[$i]);
|
|
||||||
++$i ) {
|
|
||||||
|
|
||||||
# do nothing but a sanity check
|
|
||||||
if ( $i >= @gNodes) {
|
|
||||||
die "bad trie format: last node not last sibling" ;
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
|
||||||
++$i; # move beyond the terminal
|
|
||||||
my $nextSize = ($i - $nextIndex) * $gNBytesPerNode;
|
|
||||||
if ($curSize + $nextSize > $nBytesPerOutfile) {
|
|
||||||
last;
|
|
||||||
} else {
|
|
||||||
# emit the subarray
|
|
||||||
while ( $nextIndex < $i ) {
|
|
||||||
outputNode( $gNodes[$nextIndex], $gNBytesPerNode,
|
|
||||||
\*OUTFILE );
|
|
||||||
++$nextIndex;
|
|
||||||
}
|
|
||||||
$curSize += $nextSize;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
close OUTFILE;
|
|
||||||
}
|
|
||||||
|
|
||||||
} # emitNodes
|
|
||||||
|
|
||||||
sub printWord {
|
|
||||||
my ( $str ) = @_;
|
|
||||||
|
|
||||||
print STDERR "$str\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
# print out the entire dictionary, as text, to STDERR.
|
|
||||||
|
|
||||||
sub printOneLevel {
|
|
||||||
|
|
||||||
my ( $index, $str ) = @_;
|
|
||||||
|
|
||||||
for ( ; ; ) {
|
|
||||||
|
|
||||||
my $newStr = $str;
|
|
||||||
my $node = $gNodes[$index++];
|
|
||||||
|
|
||||||
my $lindx = $gRevMap[TrieNodeGetLetter($node)];
|
|
||||||
|
|
||||||
if ( ord($lindx) >= 0x20 ) {
|
|
||||||
$newStr .= "$lindx";
|
|
||||||
} else {
|
|
||||||
print STDERR "sub space" if $debug;
|
|
||||||
$newStr .= "\\" . chr('0'+$lindx);
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( TrieNodeGetIsTerminal($node) ) {
|
|
||||||
printWord( $newStr );
|
|
||||||
}
|
|
||||||
|
|
||||||
my $fco = TrieNodeGetFirstChildOffset( $node );
|
|
||||||
if ( $fco != 0 ) {
|
|
||||||
printOneLevel( $fco, $newStr );
|
|
||||||
}
|
|
||||||
|
|
||||||
if ( TrieNodeGetIsLastSibling($node) ) {
|
|
||||||
last;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub outputNode ($$$) {
|
|
||||||
my ( $node, $nBytes, $outfile ) = @_;
|
|
||||||
|
|
||||||
my $fco = TrieNodeGetFirstChildOffset($node);
|
|
||||||
my $fourthByte;
|
|
||||||
|
|
||||||
if ( $nBytes == 4 ) {
|
|
||||||
$fourthByte = $fco >> 16;
|
|
||||||
die "$0: fco too big" if $fourthByte > 0xFF;
|
|
||||||
$fco &= 0xFFFF;
|
|
||||||
}
|
|
||||||
|
|
||||||
# Formats are different depending on whether it's to have 3- or
|
|
||||||
# 4-byte nodes.
|
|
||||||
|
|
||||||
# Here's what the three-byte node looks like. 16 bits plus one
|
|
||||||
# burried in the last byte for the next node address, five for a
|
|
||||||
# character/tile and one each for accepting and last-edge.
|
|
||||||
|
|
||||||
# 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
|
|
||||||
# |-------- 16 bits of next node address -------| | | | |-tile indx-|
|
|
||||||
# | | |
|
|
||||||
# accepting bit ---+ | |
|
|
||||||
# last edge bit ------+ |
|
|
||||||
# ---- last bit (17th on next node addr)---------+
|
|
||||||
|
|
||||||
# The four-byte format adds a byte at the right end for
|
|
||||||
# addressing, but removes the extra bit (5) in order to let the
|
|
||||||
# chars field be six bits. Bits 7 and 6 remain the same.
|
|
||||||
|
|
||||||
# write the fco (less that one bit). We want two bytes worth
|
|
||||||
# in three-byte mode, and three in four-byte mode
|
|
||||||
|
|
||||||
# first two bytes are low-word of fco, regardless of format
|
|
||||||
for ( my $i = 1; $i >= 0; --$i ) {
|
|
||||||
my $tmp = ($fco >> ($i * 8)) & 0xFF;
|
|
||||||
print $outfile pack( "C", $tmp );
|
|
||||||
}
|
|
||||||
$fco >>= 16; # it should now be 1 or 0
|
|
||||||
die "fco not 1 or 0" if $fco > 1;
|
|
||||||
|
|
||||||
my $chIn5 = TrieNodeGetLetter($node);
|
|
||||||
my $bits = $chIn5;
|
|
||||||
die "$0: char $bits too big" if $bits > 0x1F && $nBytes == 3;
|
|
||||||
|
|
||||||
if ( TrieNodeGetIsLastSibling($node) ) {
|
|
||||||
$bits |= 0x40;
|
|
||||||
}
|
|
||||||
if ( TrieNodeGetIsTerminal($node) ) {
|
|
||||||
$bits |= 0x80;
|
|
||||||
}
|
|
||||||
|
|
||||||
# We set the 17th next-node bit only in 3-byte case (where char is
|
|
||||||
# 5 bits)
|
|
||||||
if ( $nBytes == 3 && $fco != 0 ) {
|
|
||||||
$bits |= 0x20;
|
|
||||||
}
|
|
||||||
print $outfile pack( "C", $bits );
|
|
||||||
|
|
||||||
# the final byte, if in use
|
|
||||||
if ( $nBytes == 4 ) {
|
|
||||||
print $outfile pack( "C", $fourthByte );
|
|
||||||
}
|
|
||||||
} # outputNode
|
|
||||||
|
|
||||||
sub usage {
|
|
||||||
print STDERR "usage: $0 \n"
|
|
||||||
. "\t[-b bytesPerFile] (default = 0xFFFFFFFF)\n"
|
|
||||||
. "\t-m mapFile\n"
|
|
||||||
. "\t-mn mapFile (unicode)\n"
|
|
||||||
. "\t-ob outFileBase\n"
|
|
||||||
. "\t-sn start node out file\n"
|
|
||||||
. "\t[-if input file name] -- default = stdin\n"
|
|
||||||
. "\t[-term ch] (word terminator -- default = '\\0'\n"
|
|
||||||
. "\t[-nosort] (input already sorted in accord with -m; " .
|
|
||||||
" default=sort'\n"
|
|
||||||
. "\t[-dump] (write dictionary as text to STDERR for testing)\n"
|
|
||||||
. "\t[-force4](use 4 bytes per node regardless of need)\n"
|
|
||||||
. "\t[-r] (reject words with letters not in mapfile)\n"
|
|
||||||
. "\t[-k] (kill if any letters no in mapfile -- default)\n"
|
|
||||||
. "\t[-debug] (print a bunch of stuff)\n"
|
|
||||||
;
|
|
||||||
|
|
||||||
} # usage
|
|
||||||
|
|
||||||
sub parseARGV {
|
|
||||||
|
|
||||||
my $arg;
|
|
||||||
while ( my $arg = shift(@ARGV) ) {
|
|
||||||
|
|
||||||
SWITCH: {
|
|
||||||
if ($arg =~ /-b/) {$gNBytesPerOutfile = shift(@ARGV), last SWITCH;}
|
|
||||||
if ($arg =~ /-mn/) {$gTableFile = shift(@ARGV);
|
|
||||||
$gUseUnicode = 1;
|
|
||||||
last SWITCH;}
|
|
||||||
if ($arg =~ /-m/) {$gTableFile = shift(@ARGV); last SWITCH;}
|
|
||||||
if ($arg =~ /-ob/) {$gOutFileBase = shift(@ARGV), last SWITCH;}
|
|
||||||
if ($arg =~ /-sn/) {$gStartNodeOut = shift(@ARGV), last SWITCH;}
|
|
||||||
if ($arg =~ /-if/) {$gInFileName = shift(@ARGV), last SWITCH;}
|
|
||||||
if ($arg =~ /-r/) {$gKillIfMissing = 0; last SWITCH;}
|
|
||||||
if ($arg =~ /-k/) {$gKillIfMissing = 1; last SWITCH;}
|
|
||||||
if ($arg =~ /-term/) {$gTermChar = chr(shift(@ARGV)); last SWITCH;}
|
|
||||||
if ($arg =~ /-dump/) {$gDumpText = 1; last SWITCH;}
|
|
||||||
if ($arg =~ /-nosort/) {$gNeedsSort = 0; last SWITCH;}
|
|
||||||
if ($arg =~ /-wc/) {$gCountFile = shift(@ARGV); last SWITCH;}
|
|
||||||
if ($arg =~ /-ns/) {$gBytesPerNodeFile = shift(@ARGV); last SWITCH;}
|
|
||||||
if ($arg =~ /-force4/) {$gForceFour = 1; last SWITCH;}
|
|
||||||
# accept -fsize for compatibility with c++ version (but drop it)
|
|
||||||
if ($arg =~ /-fsize/) {shift(@ARGV); last SWITCH;}
|
|
||||||
if ($arg =~ /-debug/) {$debug = 1; last SWITCH;}
|
|
||||||
die "unexpected arg $arg\n";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
print STDERR "gNBytesPerOutfile=$gNBytesPerOutfile\n" if $debug;
|
|
||||||
print STDERR "gTableFile=$gTableFile\n" if $debug;
|
|
||||||
print STDERR "gOutFileBase=$gOutFileBase\n" if $debug;
|
|
||||||
print STDERR "gStartNodeOut=$gStartNodeOut\n" if $debug;
|
|
||||||
printf STDERR "gTermChar=%s(%d)\n", $gTermChar, ord($gTermChar) if $debug;
|
|
||||||
|
|
||||||
return $gTableFile;
|
|
||||||
|
|
||||||
} # parseARGV
|
|
||||||
|
|
@ -1,234 +0,0 @@
|
||||||
#!/usr/bin/perl
|
|
||||||
|
|
||||||
# Copyright 2002 by Eric House (xwords@eehouse.org) All rights reserved.
|
|
||||||
#
|
|
||||||
# This program is free software; you can redistribute it and/or
|
|
||||||
# modify it under the terms of the GNU General Public License
|
|
||||||
# as published by the Free Software Foundation; either version 2
|
|
||||||
# of the License, or (at your option) any later version.
|
|
||||||
#
|
|
||||||
# This program is distributed in the hope that it will be useful,
|
|
||||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
||||||
# GNU General Public License for more details.
|
|
||||||
#
|
|
||||||
# You should have received a copy of the GNU General Public License
|
|
||||||
# along with this program; if not, write to the Free Software
|
|
||||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
||||||
|
|
||||||
# Only enough of par's features to support building a crosswords dict
|
|
||||||
# pdb
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
|
|
||||||
my $debug = 0;
|
|
||||||
|
|
||||||
|
|
||||||
# stolen from par source
|
|
||||||
my $PRC_FLAGS_RESOURCE = (0x1<<0);
|
|
||||||
my $PRC_FLAGS_READONLY = (0x1<<1);
|
|
||||||
my $PRC_FLAGS_DIRTY = (0x1<<2);
|
|
||||||
my $PRC_FLAGS_BACKUP = (0x1<<3);
|
|
||||||
my $PRC_FLAGS_NEWER = (0x1<<4);
|
|
||||||
my $PRC_FLAGS_RESET = (0x1<<5);
|
|
||||||
my $PRC_FLAGS_COPYPREVENT = (0x1<<6);
|
|
||||||
my $PRC_FLAGS_STREAM = (0x1<<7);
|
|
||||||
my $PRC_FLAGS_HIDDEN = (0x1<<8);
|
|
||||||
my $PRC_FLAGS_LAUNCHABLE = (0x1<<9);
|
|
||||||
my $PRC_FLAGS_RECYCLABLE = (0x1<<10);
|
|
||||||
my $PRC_FLAGS_BUNDLE = (0x1<<11);
|
|
||||||
my $PRC_FLAGS_OPEN = (0x1<<15);
|
|
||||||
|
|
||||||
|
|
||||||
my $gAttrs = 0;
|
|
||||||
my $gVersion = 1; # par defaults this to 1
|
|
||||||
|
|
||||||
my $cmd = shift( @ARGV );
|
|
||||||
die "only 'c' supported now" if $cmd ne "c" && $cmd ne "-c";
|
|
||||||
|
|
||||||
readHOptions( \@ARGV );
|
|
||||||
|
|
||||||
my $dbfile = shift( @ARGV );
|
|
||||||
my $name = shift( @ARGV );
|
|
||||||
die "name $name too long" if length($name) > 31;
|
|
||||||
my $type = shift( @ARGV );
|
|
||||||
die "type $type must be of length 4" if length($type) != 4;
|
|
||||||
my $cid = shift( @ARGV );
|
|
||||||
die "cid $cid must be of length 4" if length($cid) != 4;
|
|
||||||
|
|
||||||
my @fileNames;
|
|
||||||
my @fileLengths;
|
|
||||||
|
|
||||||
my $nFiles = 0;
|
|
||||||
|
|
||||||
while ( @ARGV > 0 ) {
|
|
||||||
my $filename = shift( @ARGV );
|
|
||||||
push @fileNames, $filename;
|
|
||||||
push @fileLengths, -s $filename;
|
|
||||||
++$nFiles;
|
|
||||||
}
|
|
||||||
|
|
||||||
# from par's prcp.h; thanks djw!
|
|
||||||
# typedef struct prc_file_t {
|
|
||||||
# prc_byte_t name[32];
|
|
||||||
# prc_byte_t flags[2];
|
|
||||||
# prc_byte_t version[2];
|
|
||||||
# prc_byte_t ctime[4];
|
|
||||||
# prc_byte_t mtime[4];
|
|
||||||
# prc_byte_t btime[4];
|
|
||||||
# prc_byte_t modnum[4];
|
|
||||||
# prc_byte_t appinfo[4];
|
|
||||||
# prc_byte_t sortinfo[4];
|
|
||||||
# prc_byte_t type[4];
|
|
||||||
# prc_byte_t cid[4];
|
|
||||||
# prc_byte_t unique_id_seed[4];
|
|
||||||
# prc_byte_t next_record_list[4];
|
|
||||||
# prc_byte_t nrecords[2];
|
|
||||||
# } prc_file_t;
|
|
||||||
|
|
||||||
my $str;
|
|
||||||
my $offset = 0;
|
|
||||||
|
|
||||||
open OUTFILE, "> $dbfile" or die "couldn't open outfile $dbfile for writing";
|
|
||||||
|
|
||||||
# print the string, then pad with 0s
|
|
||||||
$offset = length($name);
|
|
||||||
print OUTFILE $name;
|
|
||||||
while ( $offset < 32 ) {
|
|
||||||
print OUTFILE pack("c", 0);
|
|
||||||
++$offset;
|
|
||||||
}
|
|
||||||
|
|
||||||
$str = pack("n", $gAttrs); # flags
|
|
||||||
print OUTFILE $str;
|
|
||||||
$offset += length($str);
|
|
||||||
|
|
||||||
$str = pack("n", $gVersion); # version
|
|
||||||
print OUTFILE $str;
|
|
||||||
$offset += length($str);
|
|
||||||
|
|
||||||
my $time = time() + 2082844800;
|
|
||||||
$str = pack("NNN", $time, $time, 0); # ctime, mtime, btime
|
|
||||||
print OUTFILE $str;
|
|
||||||
$offset += length($str);
|
|
||||||
|
|
||||||
$str = pack("N", 0 ); # mod num
|
|
||||||
print OUTFILE $str;
|
|
||||||
$offset += length($str);
|
|
||||||
|
|
||||||
$str = pack("N", 0 ); # appinfo
|
|
||||||
print OUTFILE $str;
|
|
||||||
$offset += length($str);
|
|
||||||
|
|
||||||
$str = pack("N", 0 ); # sortinfo
|
|
||||||
print OUTFILE $str;
|
|
||||||
$offset += length($str);
|
|
||||||
|
|
||||||
|
|
||||||
print OUTFILE $type; # type
|
|
||||||
print OUTFILE $cid; # cid
|
|
||||||
$offset += 8;
|
|
||||||
|
|
||||||
$str = pack("NN", 0, 0 ); # unique_id_seed, next_record_list
|
|
||||||
print OUTFILE $str;
|
|
||||||
$offset += length($str);
|
|
||||||
|
|
||||||
$str = pack("n", $nFiles ); # nrecords
|
|
||||||
print OUTFILE $str;
|
|
||||||
$offset += length($str);
|
|
||||||
|
|
||||||
$offset += $nFiles * 8;
|
|
||||||
$offset += 2; # djw adds 2 bytes after size list; see below
|
|
||||||
foreach my $len ( @fileLengths ) {
|
|
||||||
print OUTFILE pack( "N", $offset );
|
|
||||||
print OUTFILE pack( "N", 0 );
|
|
||||||
$offset += $len;
|
|
||||||
}
|
|
||||||
|
|
||||||
print OUTFILE pack( "n", 0 ); # djw does this sans comment: flush.c, line 87
|
|
||||||
|
|
||||||
foreach my $file ( @fileNames ) {
|
|
||||||
open INFILE, "<$file" or die "couldn't open infile $file\n";
|
|
||||||
my $buffer;
|
|
||||||
while ( read INFILE, $buffer, 1024 ) {
|
|
||||||
print OUTFILE $buffer;
|
|
||||||
}
|
|
||||||
close INFILE;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
close OUTFILE;
|
|
||||||
|
|
||||||
exit 0;
|
|
||||||
|
|
||||||
##############################################################################
|
|
||||||
# Subroutines
|
|
||||||
##############################################################################
|
|
||||||
|
|
||||||
sub readHOptions {
|
|
||||||
|
|
||||||
my ( $argvR ) = @_;
|
|
||||||
|
|
||||||
for ( ; ; ) {
|
|
||||||
my $opt = ${$argvR}[0];
|
|
||||||
|
|
||||||
if ( $opt !~ /^-/ ) {
|
|
||||||
last;
|
|
||||||
}
|
|
||||||
|
|
||||||
# it starts with a '-': use it; else don't consume anything
|
|
||||||
shift @{$argvR};
|
|
||||||
|
|
||||||
if ( $opt eq "-a" ) {
|
|
||||||
my $attrs = shift @{$argvR};
|
|
||||||
processAttrString( $attrs );
|
|
||||||
} elsif ( $opt eq "-v" ) {
|
|
||||||
$gVersion = shift @{$argvR};
|
|
||||||
} else {
|
|
||||||
die "what's with \"$opt\": -a and -v are the only hattrs supported";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
} # readHOptions
|
|
||||||
|
|
||||||
sub processAttrString {
|
|
||||||
|
|
||||||
my ( $attrs ) = @_;
|
|
||||||
|
|
||||||
foreach my $flag ( split /\|/, $attrs ) {
|
|
||||||
|
|
||||||
print STDERR "looking at flag $flag\n" if $debug;
|
|
||||||
|
|
||||||
if ( $flag =~ /resource/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_RESOURCE;
|
|
||||||
die "resource attr not supported";
|
|
||||||
} elsif ( $flag =~ /readonly/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_READONLY;
|
|
||||||
} elsif ( $flag =~ /dirty/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_DIRTY;
|
|
||||||
} elsif ( $flag =~ /backup/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_BACKUP;
|
|
||||||
} elsif ( $flag =~ /newer/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_NEWER;
|
|
||||||
} elsif ( $flag =~ /reset/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_RESET;
|
|
||||||
} elsif ( $flag =~ /copyprevent/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_COPYPREVENT;
|
|
||||||
} elsif ( $flag =~ /stream/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_STREAM;
|
|
||||||
die "stream attr not supported";
|
|
||||||
} elsif ( $flag =~ /hidden/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_HIDDEN;
|
|
||||||
} elsif ( $flag =~ /launchable/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_LAUNCHABLE;
|
|
||||||
} elsif ( $flag =~ /recyclable/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_RECYCLABLE;
|
|
||||||
} elsif ( $flag =~ /bundle/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_BUNDLE;
|
|
||||||
} elsif ( $flag =~ /open/ ) {
|
|
||||||
$gAttrs |= $PRC_FLAGS_OPEN;
|
|
||||||
} else {
|
|
||||||
die "flag $flag not supportd";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} # processAttrString
|
|
||||||
Loading…
Reference in a new issue