#!/usr/bin/perl # Copyright 2001-2012 Leslie Richardson # This file is part of Open Admin for Schools. # Open Admin for Schools 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. # Extract phrase values from html templates, scripts, and meta data # and used to populate the xlat_phrase table. my %lex = ('Main' => 'Main', 'Error' => 'Error', 'Extract Translation' => 'Extract Translation', 'Eoy' => 'Eoy', 'Html Pages' => 'Html Pages', 'Find Phrases to Translate' => 'Find Phrases to Translate', 'Meta table' => 'Meta table', 'Admin Site Scripts' => 'Admin Site Scripts', 'Teacher Site Scripts' => 'Teacher Site Scripts', 'Continue' => 'Continue', 'Cannot open file' => 'Cannot open file', 'Translation' => 'Translation', 'Update Complete' => 'Update Complete', 'Site Translation' => 'Site Translation', 'Teacher' => 'Teacher', 'Admin' => 'Admin', 'Site Scripts' => 'Site Scripts', 'Empty Phrase Table' => 'Empty Phrase Table', 'Parent' => 'Parent', ); my $self = 'xlatExtract.pl'; use DBI; use CGI; use Text::Balanced qw(extract_bracketed extract_codeblock extract_variable ); use Text::CSV_XS; use File::Find; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } my $q = new CGI; print $q->header( -charset, $charset); my %arr = $q->Vars; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); # Print Page Header my $title = "$lex{'Extract Translation'}"; print "$doctype\n$title\n"; print "\n"; print "$chartype\n\n"; print "[ $lex{Main} |\n"; print "$lex{Eoy} ]\n"; print "

$title

\n"; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; doExtracts(); } #---------------- sub doExtracts { #---------------- #foreach my $key (keys %arr ) { print "K:$key V:$arr{$key}
\n"; } #die; if ( $arr{emptyphrase} ) { emptyPhrase(); } if ( $arr{html} ) { extractHTML(); } if ( $arr{meta} ) { extractMeta(); } if ( $arr{cgi} ) { extractScript(cgi); } if ( $arr{tcgi} ) { extractScript(tcgi); } if ( $arr{pcgi} ) { extractScript(pcgi); } print "\n"; exit; } #---------------- sub showStartPage { #---------------- print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n";; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

". $lex{'Empty Phrase Table'}; print "	"; print "
$lex{'Find Phrases to Translate'}
$lex{'Html Pages'}	"; print "
$lex{'Meta table'}	"; print "
$lex{Admin} $lex{'Site Scripts'}	"; print "
$lex{Teacher} $lex{'Site Scripts'}	"; print "
$lex{Parent} $lex{'Site Scripts'}	"; print "
"; print "

\n"; exit; } #------------- sub emptyPhrase { #------------- # empty records from xlat_phrase table; my $sth = $dbh->prepare("delete from xlat_phrase"); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } return; } # end of emptyPhrase #------------- sub extractHTML { #------------- print "

HTML $lex{Translation}

\n"; my @templatefiles = glob( "../../template/html/*.tpl"); for my $htmlfile ( @templatefiles ) { # Slurp in html template file. unless ( open (FH,"<$htmlfile")) { print $lex{'Cannot open file'}. ":$htmlfile: $!\n"; die $lex{'Cannot open file'}. ":$htmlfile: $!\n"; } my $text; { local $/; $text = ; close FH;} my @text = (); # Now find tagged text, and put into @text. while ( $text =~ m{\<\#(.*?)\#\>}g ) { push @text,$1; } my $taggedfile = $htmlfile; $taggedfile =~ s/^.*\///; $taggedfile =~ s/\.tpl$//; my $sth = $dbh->prepare("insert into xlat_phrase values( NULL,'html','$taggedfile',?)"); my $sth1 = $dbh->prepare("select count(*) from xlat_phrase where phrase = ? and file = ?"); foreach my $phrase ( @text ) { #print "Checking phrase: $phrase "; $sth1->execute( $phrase, $taggedfile ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth1->fetchrow; if ( $count > 0 ) { next; } # skip # insert the phrase $sth->execute( $phrase ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } # end of phrase insert loop } # End of HTML Files loop print "

HTML $lex{'Update Complete'}

\n"; return; } # end of extractHTML #------------- sub extractMeta { #------------- print "

Meta $lex{Translation}

\n"; my $sth = $dbh->prepare("select tableid, fieldid from meta order by tableid, fieldid"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $sth1 = $dbh->prepare("insert into xlat_phrase ( area, file, phrase ) values( 'meta',?,?)"); my $sth2 = $dbh->prepare("select count(*) from xlat_phrase where area = 'meta' and file = ? and phrase = ?"); while ( my ( $tableid, $fieldid ) = $sth->fetchrow ) { $sth2->execute( $tableid, $fieldid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth2->fetchrow; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } if ( $count > 0 ) { next; } # insert the phrase $sth1->execute( $tableid, $fieldid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } #print "Table: $tableid Field: $fieldid
\n"; } print "

Meta $lex{'Update Complete'}

\n"; return; } # end of extractMeta #--------------- sub extractScript { #--------------- my $mode = shift; my $cgipath = '../../cgi'; my $tcgipath = '../../tcgi'; my $pcgipath = '../../pcgi'; if ( $mode eq 'cgi' ) { print "

$lex{Main} $lex{'Site Translation'}

\n"; find(\&parseFile, $cgipath ); } elsif ( $mode eq 'tcgi' ) { print "

$lex{Teacher} $lex{'Site Translation'}

\n"; find(\&parseFile, $tcgipath ); } elsif ( $mode eq 'pcgi' ) { print "

$lex{Parent} $lex{'Site Translation'}

\n"; find(\&parseFile, $pcgipath ); } print "

$lex{'Update Complete'}

\n"; return; } # end of insertScript #------------ sub parseFile { # extract version #------------ my $cgifile = $_; my $csv = Text::CSV_XS->new( {binary => 1} ); if ( $cgifile eq '.' or $cgifile eq '..' ) { return } if ( not $cgifile =~ m/.*\.pl/ ) { return } # Slurp in file. unless ( open (FH,"<$cgifile") ) { print $lex{'Cannot open file'}. ":$cgifile: $!\n"; die $lex{'Cannot open file'}. ":$cgifile: $!\n"; } my $text; { local $/; $text = ; close FH;} print " $cgifile "; my ( $extracted, $remainder, $prefix ) = extract_variable($text,'(?s).*?(?=%lex)'); if ( not $extracted ) { print "
Missing %lex in $cgifile
\n"; return; } $remainder =~ s/^\s*=\s*//; # strip equal sign and space my ( $hash,$finalremainder ) = extract_bracketed($remainder,'()'); $hash =~ s/^$\s*//; # strip leading parens and space. $hash =~ s/$\s*$//; # strip trailing parenthesis. $hash =~ s/\s*\n\s*//g; # strip newlines and leading spaces between fields; $hash =~ s/\s*\=\>\s*\n*/,/g; # convert fat commas $hash =~ s/\'/\"/g; # replace single quotes with double quotes. $hash =~ s/\\"/\'/g; # put any escaped words back. chomp $hash; # remove trailing newline. #$hash =~ s/,$//; my $status = $csv->parse( $hash ); if ( not $status ) { print "
Status: $status
\n"; print "String: $hash\n\n"; die; } my $version = $csv->version; my @fields = $csv->fields; $status = $csv->status; if ( not $status ) { print "\n
String: $hash
\n\n"; print "
Array:
"; foreach my $fld ( @fields ) { print "F:$fld "; } print "
\n"; die; } if ( not @fields ) { print "\n
NO Fields\n"; print "
Hash: $hash\n"; print "
Field Status: $status\n"; die; } my %lex = @fields; my @phrases = (); foreach my $key ( keys %lex ) { #$key =~ s/^\'//; #$key =~ s/\'\s*$//; if ( not $key =~ m/\S+/ ) { next; } push @phrases, $key; } # $cgifile =~ s/^.*\///; # not needed; prefix already gone. my $sth = $dbh->prepare("insert into xlat_phrase values( $sql{default},'Script','$cgifile',?)"); my $sth1 = $dbh->prepare("select count(*) from xlat_phrase where phrase = ? and file = ?"); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $pcount = 1; foreach my $phrase ( @phrases ) { # check whether already present... $sth1->execute( $phrase, $cgifile ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth1->fetchrow; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } if ($count > 0 ) { next; } # insert the phrase $sth->execute( $phrase ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } $pcount++; } return; } # end of parseFile; extract version