#!/usr/bin/perl use CGI; use File::Basename; use File::Find; use URI::Escape; use MIME::Lite; use CGI::Carp qw(fatalsToBrowser); $CGI::POST_MAX = 1024 * 30; # 30k should be plenty my $original_dir = "/www/t/tcbnetworks/translate/original/"; my $translate_dir = "/www/t/tcbnetworks/translate/translations/"; my $q = new CGI; my $SaveParam = "save"; my $ContinueParam = "continue"; my $DownloadParam = "download"; my $SubmitParam = "send"; my $FinalSubmitParam = "finalsend"; main(); sub main { if ($q->param($SaveParam)) { SaveProgress(); exit(); } if ($q->param($DownloadParam)) { DownloadFile(); exit(); } print $q->header(); if ($q->param($SubmitParam)) { SubmitFile(); exit(); } if ($q->param($FinalSubmitParam)) { Send(); exit(); } if ($q->param($ContinueParam)) { ContinueFromUpload($q->param('FILE')); exit(); } my $translate_lang = uri_unescape($q->param('lang')); my $translate_mods = uri_unescape($q->param('mods')); my $version = $q->param('ver'); my $x = 0; while ($author = $q->param("AUTHOR$x")) { push Authors, $author; $x++; } print "\n"; if ($translate_lang) { if ($translate_mods) { if ($version) { CreateFile($translate_lang, $translate_mods, \@Authors); } else { TranslateMods($translate_lang, $translate_mods); } } else { ChooseMods($translate_lang); } } else { MainPage(); } exit(); } sub MainPage() { find ( sub { # Print the Directory if (! -d $File::Find::name ) { $File::Find::name =~ /.*\/(.*)\.lng/; $LangName = $1; if ($LangName) { $main::langlist{$LangName} = 1; } } }, $translate_dir ); print qq~ StrokeIt Translation System

StrokeIt Translation System

Welcome to the StrokeIt Online Translation page. From here, you will be able to easily create, save, and update StrokeIt language files.

If you do create or update a translation, please take the time to submit your translation, so that other users can benefit from it.



~; foreach my $lang (sort keys %langlist) { if ($langlist{$lang} == 1) { $escaped = uri_escape($lang); print qq~ ~; } } print qq~
Update Existing Translations
$lang


Create new translation
Language:


Continue a translation
File:
~; } sub ChooseMods() { my $translate_lang = shift; find ( sub { # Print the Directory if ( -d $File::Find::name ) { $File::Find::name =~ /$original_dir(.*)/; $DirName = $1; if ($DirName) { $main::modlist{$DirName} = 1; } } }, $original_dir ); print qq~ Translating $translate_lang

$translate_lang Translation
Outdated Current
~; my @oldlist; my @curlist; foreach my $mod (sort keys %modlist) { if ($modlist{$mod} == 1) { $cur = GetModVersion($mod, $translate_lang); $latest = GetModLatest($mod); if ($cur eq $latest) { push @curlist, $mod; } else { push @oldlist, $mod; } } } # Outdated foreach $mod (@oldlist) { print ""; print $mod; print "
"; } print qq~ 		~; # Current foreach $mod (@curlist) { print ""; print $mod; print "
"; } print qq~
~; } # TranslateMods ( , , [Version], [@Foreign], [@Authors] ) sub TranslateMods { my $translate_lang = shift; my $translate_mod = shift; my $version = shift; my $foreign_array = shift; my $authors_array = shift; @Foreign = @$foreign_array; @Authors = @$authors_array; print qq~ $translate_lang $translate_mod ~; if (! @Foreign) { $foreign = $translate_dir . $translate_mod . "/" . $translate_lang . ".lng"; # Make sure it exists if ( -e $foreign ) { open (FOREIGN, $foreign); chomp(@Foreign = ); close FOREIGN; foreach (@Foreign) { s/\r$//; } foreach (@Foreign) { if (/^#VERSION:(.*)/) { $version = $1; last; } } foreach (@Foreign) { if (/^#AUTHOR: (.*)/) { push Authors, $1; } } foreach (@Foreign) { s/\r$//; } @Foreign = grep /\S/ => @Foreign; } } # Find the corresponding english file $mod_dir = $original_dir . $translate_mod . "/"; find ( sub { # Print the Directory if ( ! -d $File::Find::name ) { $File::Find::name =~ /$mod_dir(.*)/; $FileName = $1; if ( $FileName =~ /^!?English\.?$version$/ ) { $old_english = $mod_dir . $FileName; } if ( $FileName =~ /^!English/ ) { $new_english = $mod_dir . $FileName; } } }, $mod_dir ); open (OLD_ENGLISH, $old_english); open (NEW_ENGLISH, $new_english); # open (FOREIGN, $foreign) or bag("Couldn't open $foreign: $!"); chomp(@OldEnglish = ); close OLD_ENGLISH; chomp(@NewEnglish = ); close NEW_ENGLISH; # chomp(@Foreign = ); # close FOREIGN; # Remove the \r in case this is a dos file foreach (@OldEnglish) { s/\r$//; } foreach (@NewEnglish) { s/\r$//; } # Remove "blank" lines @OldEnglish = grep /\S/ => @OldEnglish; @NewEnglish = grep /\S/ => @NewEnglish; # Get the new version foreach (@NewEnglish) { if (/^#VERSION:(.*)/) { $newversion = $1; last; } } # Remove lines that start with # @OldEnglish = grep !/^#/, @OldEnglish; @NewEnglish = grep !/^#/, @NewEnglish; @Foreign = grep !/^#/, @Foreign; $diffs = diff(\@OldEnglish, \@NewEnglish); my @removed; my @added; if (@$diffs) { foreach $chunk (@$diffs) { foreach $line (@$chunk) { my ($sign, $lineno, $text) = @$line; if ($sign eq "+") { push @added, $lineno; } else { push @removed, $lineno; } } } #print "

Removing lines:
"; my $count = 0; foreach $lineno(@removed) { # print "$lineno : @Foreign[$lineno-$count]
"; splice (@Foreign, $lineno-$count, 1); $count = $count + 1; } #print "

Adding lines:
"; foreach $lineno(@added) { # print "$lineno
"; splice (@Foreign, $lineno, 0, $NewEnglish[$lineno]); } } $lines = $#Foreign + 1; print qq~
~; my $x = 0; foreach (@Authors) { print " \n"; $x++; } print qq~ ~; $count = 0; $added_count = 0; foreach $line (@Foreign) { print ""; $val = $count+1; print ""; print "\n"; $count = $count+1; } print qq~
Translated Text Original English Text
$val"; printf "\n"; print "@NewEnglish[$count]
~; } sub CreateFile { print "Translating $translate_lang"; my $translate_lang = shift; my $translate_mod = shift; my $authors_array = shift; @Authors = @$authors_array; my $version = $q->param('ver'); $count = 0; while ( $q->param("LINE" . sprintf("%04d", $count) )) { push @lines, $q->param('LINE' . sprintf("%04d", $count)); $count = $count+1; } $lines = $q->param('lines'); if ($count != $lines) { $val = $count+1; print "Incomplete form (empty value in line $val).
Please make sure each line has been translated."; exit(); } print qq~
~; my $x = 0; foreach (@Authors) { print " \n"; $x++; } print qq~

File: $translate_mod\/$translate_lang.lng
~; $file = "#VERSION:$version\n"; # This needs to be here, it is a placeholder $file .= "\n#AUTHOR: Your Name Will Be Here! ($version)\n"; foreach $author (@Authors) { $file = $file . "#AUTHOR: $author\n"; } $file .= "\n"; foreach $line (@lines) { $file = $file . "$line\n"; } $rows = $#lines+8; print qq~
~; } # string GetModVersion ( "module", "language" ) sub GetModVersion { $mod = shift; $lang = shift; $foreign = $translate_dir . $mod . "/" . $lang . ".lng"; # Make sure it exists if ( -e $foreign ) { open (FOREIGN, $foreign); chomp(@Foreign = ); close FOREIGN; foreach (@Foreign) { s/\r$//; if (/^#VERSION:(.*)/) { return $1; } } } } # string GetModLatest ( "module ) sub GetModLatest { $mod = shift; $mod_dir = $original_dir . $mod . "/"; my $ret; find ( sub { $File::Find::name =~ /$mod_dir(.*)/; $FileName = $1; if ( $FileName =~ /^!English(.*)/ ) { $ret = $1; next; } }, $mod_dir ); return $ret; } sub SaveProgress { $lines = $q->param('lines'); my $lang = uri_unescape($q->param('lang')); my $mod = uri_unescape($q->param('mods')); my $version = $q->param('ver'); $FileData = "VERSION=$version\r\n"; $FileData .= "LANGUAGE=$lang\r\n"; $FileData .= "FILE=$mod\r\n"; $author_count = 0; foreach ($q->param()) { if (/^AUTHOR/) { $FileData .= "AUTHOR$author_count=" . CGI::unescapeHTML($q->param($_)) . "\r\n"; $author_count++; } if (/^LINE/) { $FileData .= "$_=" . $q->param($_) . "\r\n"; } } $FileData = CGI::unescapeHTML($FileData); $FileLength = length $FileData; $FileName = "$lang\_$mod\_$version.txt"; print "Content-Disposition: attachment; filename=\"$FileName\"\n"; print "Content-Length: $FileLength\n"; print "Content-Type: text/plain\n\n"; print $FileData; } sub ContinueFromUpload { $FileData = shift; my %values; while (<$FileData>) { /(.*)\=(.*)/; @values{$1} = $2; } my @Foreign; foreach (sort keys %values) { chomp(@values{$_}); @values{$_} =~ s/\r$//; if (/^AUTHOR/) { push @Authors, @values{$_}; } if (/^LINE/) { $count = push @Foreign, @values{$_}; } } my $lang = @values{'LANGUAGE'}; my $ver = @values{'VERSION'}; my $mod = @values{'FILE'}; TranslateMods($lang, $mod, $ver, \@Foreign, \@Authors); } sub DownloadFile { my $lang = uri_unescape($q->param('lang')); # my $ver = $q->param('ver'); $FileData = CGI::unescapeHTML($q->param('strings')); $FileLength = length $FileData; $FileName = "$lang.lng"; print "Content-Disposition: attachment; filename=\"$FileName\"\n"; print "Content-Length: $FileLength\n"; print "Content-Type: unknown/text\n\n"; print $FileData; } sub SubmitFile { my $lang = uri_unescape($q->param('lang')); my $ver = $q->param('ver'); my $mod = $q->param('mod'); $FileData = $q->param('strings'); my $x = 0; while ($author = CGI::unescapeHTML($q->param("AUTHOR$x"))) { push Authors, $author; $x++; } $val = $FileData; print qq~
~; my $x = 0; foreach (@Authors) { print " \n"; $x++; } print qq~
File: $mod
Language: $lang
Version: $ver
Author Name:
Author E-Mail:

~; } sub Send { print qq~ Thank you for your translation.

Home ~; my $lang = uri_unescape($q->param('lang')); my $ver = $q->param('ver'); my $mod = $q->param('mod'); my $FileData = CGI::unescapeHTML($q->param('strings')); my $author = CGI::unescapeHTML($q->param('author')); my $email = CGI::unescapeHTML($q->param('email')); my $comments = CGI::unescapeHTML($q->param('comments')); # Replace the first #AUTHOR placeholder with the new author's name $FileData =~ s/#AUTHOR:.*\r\n/#AUTHOR: $author ($ver)\r\n/; # open (message, "| /usr/sbin/sendmail -t"); # print message "From: $author \n"; # print message "To: strings\@tcbmi.com\n"; # print message "Reply-To: $author <$email>\n"; # print message "Subject: $lang $mod Translation\n\n"; # print message "From: $author <$email>\n"; # print message "Version: $ver\n"; # print message "File: $mod\n"; # print message "Language: $lang\n"; # print message "Comments:\n"; # print message "$comments\n"; # close(message); my $body = "From: $author <$email>\n"; $body .= "Version: $ver\n"; $body .= "File: $mod\n"; $body .= "Language: $lang\n"; $body .= "Comments:\n"; $body .= "$comments\n"; ### Create a new multipart message: $msg = MIME::Lite->new( From =>'translate@tcbmi.com', To =>'string@tcbmi.com', Subject =>"$lang $mod Translation", Type =>'multipart/mixed' ); ### Add parts (each "attach" has same arguments as "new"): $msg->attach( Type =>'TEXT', Data =>"$body" ); $msg->attach( Type =>'text/plain', Data =>"$FileData", Filename =>"$lang_$mod.lng", Disposition => 'attachment' ); $msg->send; } # Create a hash that maps each element of $aCollection to the set of positions # it occupies in $aCollection, restricted to the elements within the range of # indexes specified by $start and $end. # The fourth parameter is a subroutine reference that will be called to # generate a string to use as a key. # Additional parameters, if any, will be passed to this subroutine. # # my $hashRef = _withPositionsOfInInterval( \@array, $start, $end, $keyGen ); sub _withPositionsOfInInterval { my $aCollection = shift; # array ref my $start = shift; my $end = shift; my $keyGen = shift; my %d; my $index; for ( $index = $start ; $index <= $end ; $index++ ) { my $element = $aCollection->[$index]; my $key = &$keyGen( $element, @_ ); if ( exists( $d{$key} ) ) { unshift ( @{ $d{$key} }, $index ); } else { $d{$key} = [$index]; } } return wantarray ? %d : \%d; } # Find the place at which aValue would normally be inserted into the array. If # that place is already occupied by aValue, do nothing, and return undef. If # the place does not exist (i.e., it is off the end of the array), add it to # the end, otherwise replace the element at that point with aValue. # It is assumed that the array's values are numeric. # This is where the bulk (75%) of the time is spent in this module, so try to # make it fast! sub _replaceNextLargerWith { my ( $array, $aValue, $high ) = @_; $high ||= $#$array; # off the end? if ( $high == -1 || $aValue > $array->[-1] ) { push ( @$array, $aValue ); return $high + 1; } # binary search for insertion point... my $low = 0; my $index; my $found; while ( $low <= $high ) { $index = ( $high + $low ) / 2; # $index = int(( $high + $low ) / 2); # without 'use integer' $found = $array->[$index]; if ( $aValue == $found ) { return undef; } elsif ( $aValue > $found ) { $low = $index + 1; } else { $high = $index - 1; } } # now insertion point is in $low. $array->[$low] = $aValue; # overwrite next larger return $low; } # This method computes the longest common subsequence in $a and $b. # Result is array or ref, whose contents is such that # $a->[ $i ] == $b->[ $result[ $i ] ] # foreach $i in ( 0 .. $#result ) if $result[ $i ] is defined. # An additional argument may be passed; this is a hash or key generating # function that should return a string that uniquely identifies the given # element. It should be the case that if the key is the same, the elements # will compare the same. If this parameter is undef or missing, the key # will be the element as a string. # By default, comparisons will use "eq" and elements will be turned into keys # using the default stringizing operator '""'. # Additional parameters, if any, will be passed to the key generation routine. sub _longestCommonSubsequence { my $a = shift; # array ref my $b = shift; # array ref my $keyGen = shift; # code ref my $compare; # code ref # set up code refs # Note that these are optimized. if ( !defined($keyGen) ) # optimize for strings { $keyGen = sub { $_[0] }; $compare = sub { my ( $a, $b ) = @_; $a eq $b }; } else { $compare = sub { my $a = shift; my $b = shift; &$keyGen( $a, @_ ) eq &$keyGen( $b, @_ ); }; } my ( $aStart, $aFinish, $bStart, $bFinish, $matchVector ) = ( 0, $#$a, 0, $#$b, [] ); # First we prune off any common elements at the beginning while ( $aStart <= $aFinish and $bStart <= $bFinish and &$compare( $a->[$aStart], $b->[$bStart], @_ ) ) { $matchVector->[ $aStart++ ] = $bStart++; } # now the end while ( $aStart <= $aFinish and $bStart <= $bFinish and &$compare( $a->[$aFinish], $b->[$bFinish], @_ ) ) { $matchVector->[ $aFinish-- ] = $bFinish--; } # Now compute the equivalence classes of positions of elements my $bMatches = _withPositionsOfInInterval( $b, $bStart, $bFinish, $keyGen, @_ ); my $thresh = []; my $links = []; my ( $i, $ai, $j, $k ); for ( $i = $aStart ; $i <= $aFinish ; $i++ ) { $ai = &$keyGen( $a->[$i], @_ ); if ( exists( $bMatches->{$ai} ) ) { $k = 0; for $j ( @{ $bMatches->{$ai} } ) { # optimization: most of the time this will be true if ( $k and $thresh->[$k] > $j and $thresh->[ $k - 1 ] < $j ) { $thresh->[$k] = $j; } else { $k = _replaceNextLargerWith( $thresh, $j, $k ); } # oddly, it's faster to always test this (CPU cache?). if ( defined($k) ) { $links->[$k] = [ ( $k ? $links->[ $k - 1 ] : undef ), $i, $j ]; } } } } if (@$thresh) { for ( my $link = $links->[$#$thresh] ; $link ; $link = $link->[0] ) { $matchVector->[ $link->[1] ] = $link->[2]; } } return wantarray ? @$matchVector : $matchVector; } sub traverse_sequences { my $a = shift; # array ref my $b = shift; # array ref my $callbacks = shift || {}; my $keyGen = shift; my $matchCallback = $callbacks->{'MATCH'} || sub { }; my $discardACallback = $callbacks->{'DISCARD_A'} || sub { }; my $finishedACallback = $callbacks->{'A_FINISHED'}; my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { }; my $finishedBCallback = $callbacks->{'B_FINISHED'}; my $matchVector = _longestCommonSubsequence( $a, $b, $keyGen, @_ ); # Process all the lines in @$matchVector my $lastA = $#$a; my $lastB = $#$b; my $bi = 0; my $ai; for ( $ai = 0 ; $ai <= $#$matchVector ; $ai++ ) { my $bLine = $matchVector->[$ai]; if ( defined($bLine) ) # matched { &$discardBCallback( $ai, $bi++, @_ ) while $bi < $bLine; &$matchCallback( $ai, $bi++, @_ ); } else { &$discardACallback( $ai, $bi, @_ ); } } # The last entry (if any) processed was a match. # $ai and $bi point just past the last matching lines in their sequences. while ( $ai <= $lastA or $bi <= $lastB ) { # last A? if ( $ai == $lastA + 1 and $bi <= $lastB ) { if ( defined($finishedACallback) ) { &$finishedACallback( $lastA, @_ ); $finishedACallback = undef; } else { &$discardBCallback( $ai, $bi++, @_ ) while $bi <= $lastB; } } # last B? if ( $bi == $lastB + 1 and $ai <= $lastA ) { if ( defined($finishedBCallback) ) { &$finishedBCallback( $lastB, @_ ); $finishedBCallback = undef; } else { &$discardACallback( $ai++, $bi, @_ ) while $ai <= $lastA; } } &$discardACallback( $ai++, $bi, @_ ) if $ai <= $lastA; &$discardBCallback( $ai, $bi++, @_ ) if $bi <= $lastB; } return 1; } sub traverse_balanced { my $a = shift; # array ref my $b = shift; # array ref my $callbacks = shift || {}; my $keyGen = shift; my $matchCallback = $callbacks->{'MATCH'} || sub { }; my $discardACallback = $callbacks->{'DISCARD_A'} || sub { }; my $discardBCallback = $callbacks->{'DISCARD_B'} || sub { }; my $changeCallback = $callbacks->{'CHANGE'}; my $matchVector = _longestCommonSubsequence( $a, $b, $keyGen, @_ ); # Process all the lines in match vector my $lastA = $#$a; my $lastB = $#$b; my $bi = 0; my $ai = 0; my $ma = -1; my $mb; while (1) { # Find next match indices $ma and $mb do { $ma++ } while ( $ma <= $#$matchVector && !defined $matchVector->[$ma] ); last if $ma > $#$matchVector; # end of matchVector? $mb = $matchVector->[$ma]; # Proceed with discard a/b or change events until # next match while ( $ai < $ma || $bi < $mb ) { if ( $ai < $ma && $bi < $mb ) { # Change if ( defined $changeCallback ) { &$changeCallback( $ai++, $bi++, @_ ); } else { &$discardACallback( $ai++, $bi, @_ ); &$discardBCallback( $ai, $bi++, @_ ); } } elsif ( $ai < $ma ) { &$discardACallback( $ai++, $bi, @_ ); } else { # $bi < $mb &$discardBCallback( $ai, $bi++, @_ ); } } # Match &$matchCallback( $ai++, $bi++, @_ ); } while ( $ai <= $lastA || $bi <= $lastB ) { if ( $ai <= $lastA && $bi <= $lastB ) { # Change if ( defined $changeCallback ) { &$changeCallback( $ai++, $bi++, @_ ); } else { &$discardACallback( $ai++, $bi, @_ ); &$discardBCallback( $ai, $bi++, @_ ); } } elsif ( $ai <= $lastA ) { &$discardACallback( $ai++, $bi, @_ ); } else { # $bi <= $lastB &$discardBCallback( $ai, $bi++, @_ ); } } return 1; } sub LCS { my $a = shift; # array ref my $matchVector = _longestCommonSubsequence( $a, @_ ); my @retval; my $i; for ( $i = 0 ; $i <= $#$matchVector ; $i++ ) { if ( defined( $matchVector->[$i] ) ) { push ( @retval, $a->[$i] ); } } return wantarray ? @retval : \@retval; } sub diff { my $a = shift; # array ref my $b = shift; # array ref my $retval = []; my $hunk = []; my $discard = sub { push ( @$hunk, [ '-', $_[0], $a->[ $_[0] ] ] ) }; my $add = sub { push ( @$hunk, [ '+', $_[1], $b->[ $_[1] ] ] ) }; my $match = sub { push ( @$retval, $hunk ) if scalar(@$hunk); $hunk = [] }; traverse_sequences( $a, $b, { MATCH => $match, DISCARD_A => $discard, DISCARD_B => $add }, @_ ); &$match(); return wantarray ? @$retval : $retval; }
Comments: