rewrite keyidGen.pl

it creates 4 letter key IDs (same as in pot/po files)

l10ntools/scripts/keyidGen.pl

@@ -31,15 +31,10 @@ eval 'exec perl -S $0 ${1+"$@"}'
 # add keyids to sdf file
 #
 
-use Compress::Zlib();
+my $infile = $ARGV[0];
+if ( !$infile ) {die "Usage: $0 <infile> [<outfile>]\n";}
 
-print "\nkeyidGen version 1.0 \n\n";
-
-my ( $infile,$outfile,$dbimport );
-get_options();
-
-print_help() if ( !defined $infile || $help );
-exit 1 if ( !defined $infile );
+my $outfile = $ARGV[1];
 if ( ! defined $outfile )
 {
     $outfile = $infile;
@@ -47,139 +42,105 @@ if ( ! defined $outfile )
     $outfile .= "_KeyID.sdf";
 }
 
-$collisions = 0;
-%hashcodes = ();
-$count = 0;
 print "writing to $outfile\n";
 open INFILE,"<$infile" || die "could not open $infile $! $^E\n";
 open OUTFILE,">$outfile" || die "could not open $outfile $! $^E\n";
 
 while ( <INFILE> )
 {
-    $line = $_;
-    chomp $line;
-    $hash = 0;
-    if ( $line =~ /^([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)$/ )
+    chomp;
+    if ( /^([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)$/ )
     {
-        $string="$1 $2 $4 $5 $6 $7 $8";
-        $hashp = makeID( $string );
-
-        if ( defined ($hashcodes{ $hashp } ) )
-        {
-            $collisions ++ unless $hashcodes{ $hashp } eq $string;
-        }
-        $hashcodes{ $hashp } = $string;
-        $count++;
-        if ( $dbimport )
-        {
-            my ( $pre, $post, $old );
-            $pre = "$1\t$2\t";
-            $post = "\t$4\t$5\t$6\t$7\t$8\t$9\t$10\t$11\t$12\t$13\t$14\t$15\n";
-            $old = $3;
-            $old =~ s/;{0,1}keyid:......;{0,1}//;
-            $old =~ s/^0$//;
-            if ( $old ne "" ) { $old .= ";"; }
-            print OUTFILE "$pre${old}keyid:$hashp$post";
-        }
-        else
-        {
-            print OUTFILE "$1\t$2\t$3\t$4\t$5\t$6\t$7\t$8\t$9\t$10\t".makekidstr($hashp,$11)."\t".makekidstr($hashp,$12)."\t$13\t".makekidstr($hashp,$14)."\t$15\n";
-        }
+        my $prj            = defined $1 ? $1 : '';
+        my $file           = defined $2 ? $2 : '';
+        my $dummy          = defined $3 ? $3 : '';
+        my $type           = defined $4 ? $4 : '';
+        my $gid            = defined $5 ? $5 : '';
+        my $lid            = defined $6 ? $6 : '';
+        my $helpid         = defined $7 ? $7 : '';
+        my $platform       = defined $8 ? $8 : '';
+        my $width          = defined $9 ? $9 : '';
+        my $lang           = defined $10 ? $10 : '';
+        my $text           = defined $11 ? $11 : '';
+        my $helptext       = defined $12 ? $12 : '';
+        my $quickhelptext  = defined $13 ? $13 : '';
+        my $title          = defined $14 ? $14 : '';
+        my $timestamp      = defined $15 ? $15 : '';
+        @path = split ( "\\\\" , $file );
+        $key = $path[-3] . "_" . $path[-2] . "_" . $path[-1] . "#" . $gid . ".";
+        if (length($lid)) {$key .= $lid . ".";}
+        if (length($type)) {$key .= $type . ".";}
+        # replace non-word characters to _ just as in po files in source keys
+        $key =~ s|[^\w#\./]|_|g;
+        # ISO 639 private use code
+	$lang = "qtz";
+	if ( $text ne "") {$text = makekeyidstr(keyidgen($key . "text"),$text);}
+	if ( $quickhelptext ne "") {$quickhelptext = makekeyidstr(keyidgen($key . "quickhelptext"),$quickhelptext);}
+	if ( $title ne "") {$title = makekeyidstr(keyidgen($key . "title"),$title);}
+        print OUTFILE "$prj\t$file\t$dummy\t$type\t$gid\t$lid\t$helpid\t$platform\t$width\t$lang\t$text\t$helptext\t$quickhelptext\t$title\t$timestamp\n";
     }
 }
-print "$count entries\n";
-print "$collisions collisions\n";
 
 close INFILE;
 close OUTFILE;
 
-sub makeID
+sub keyidgen
 {
-    my ( $String ) = shift;
-    my ( $hash );
-    # hardcoded to prevent windows installer to choke on bad directoryname :-((
-    if ( $String eq "scp2 source\\ooo\\directory_ooo.ulf LngText STR_DIR_KAPITEL   " )
+    my $key = shift;
+    my $crc = crc24($key);
+    my $symbols="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz#_";
+    my $keyid = "";
+    while ( length($keyid) < 4 )
     {
-        return "keyid1";
+        $keyid .= substr($symbols, $crc & 63, 1);
+        $crc = $crc >> 6;
     }
-
-    $hash = Compress::Zlib::crc32( $String, undef );
-    return makenumber( $hash );
+    return $keyid;
 }
 
-sub makenumber
+sub crc24
 {
-    $h = shift;
-    #                  1         2         3         4
-    #         1234567890123456789012345678901234567890
-    $symbols="0123456789abcdefghijklmnopqrstuvwxyz+-[=]";
-    $order = length($symbols);
-    $result = "";
-    while ( length( $result ) < 6 )
+    my $CRC24_INIT = 0x00b704ce;
+    my $CRC24_POLY = 0x00864cfb;
+    my $key = shift;
+    my $key_length = length($key);
+    my $crc = $CRC24_INIT;
+    my $position = 0;
+
+    while ( $position < $key_length )
     {
-        $result .= substr( $symbols, ($h % $order), 1 );
-        $h = int( $h / $order );
+        $crc ^= (unpack("C", substr($key, $position, 1)) << 16);
+        my $i;
+        for ($i = 0; $i < 8; $i++)
+        {
+            $crc <<= 1;
+            $crc ^= $CRC24_POLY if ($crc & 0x01000000)
+        }
+        $position++;
     }
-    die "makenumber failed because number is too big (this cannot be so this is a strange error)" if $h > 0;
-
-    return reverse $result;
+    return $crc & 0x00ffffff;
 }
 
 
-sub makekidstr
+sub makekeyidstr
 {
-    $kid = shift;
-    $str = shift;
+    my $keyid = shift;
+    my $str = shift;
 
     if ( $str ne "" )
     {
         # special handling for strings starting with font descriptions like {&Tahoma8} (win system integration)
-        if ( $str =~ s/^(\{\&[^\}]+\})// )
+        if ( $str =~ s/^(\{[\&\\][^\}]+\})// )
         {
-            return "$1$kid‖$str";
+            return "$1$keyid‖$str";
         }
         else
         {
-            return "$kid‖$str";
+            return "$keyid‖$str";
         }
     }
     else
     {
         return "";
     }
-#    return "default";
-}
-
-sub print_help
-{
-    print "\n\n";
-    print "keyidGen 0.5 for sdf files\n";
-    print "--------------------------\n";
-    print "Usage:\n";
-    print "keyidGen <infile> [<outfile>] [-dbimport]\n";
-    print "                   add keyids to the entries and write them to a file with\n";
-    print "                   _KeyID added to the name\n";
-    print "   -dbimport       Add KeyID to a new column instead of to the strings.\n";
-    print "                   This is needed to import the IDs into tha database.\n";
-    print "\n\n";
-}
-
-
-sub get_options {
-    my ($arg,$has_infile);
-
-    while ($arg = shift @ARGV) {
-        $arg =~ /^-dbimport$/  and $dbimport = 1 and next;
-        $arg =~ /^-help$/  and $help = 1 and next; #show help
-
-        if ( !$has_infile )
-        {
-            $infile = $arg;
-            $has_infile = 1;
-        }
-        else
-        {
-            $outfile = $arg;
-        }
-    }
 }