#!/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. my %lex = ('Main' => 'Main', 'Error' => 'Error', 'Insert' => 'Insert', 'Translation' => 'Translation', 'Eoy' => 'Eoy', 'Html Pages' => 'Html Pages', 'Insert Into' => 'Insert Into', 'Meta table' => 'Meta table', 'Scripts' => 'Scripts', 'Teacher' => 'Teacher', 'Parent' => 'Parent', 'Text Encoding' => 'Text Encoding', 'Continue' => 'Continue', 'Cannot open file' => 'Cannot open file', 'Translation' => 'Translation', 'Missing' => 'Missing', 'Update Complete' => 'Update Complete', 'Language Code' => 'Language Code', ); my @encodings = qw( iso-8859-1 utf-8 ); my @language = qw( en fr es de sb); my $self = 'xlatInsert.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{Insert} $lex{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}; doInserts(); } #---------------- sub doInserts { #---------------- #foreach my $key (keys %arr ) { print "K:$key V:$arr{$key}
\n"; } #die; if ( $arr{html} ) { insertHTML(); } if ( $arr{meta} ) { insertMeta(); } if ( $arr{cgi} ) { insertScript(cgi); } if ( $arr{tcgi} ) { insertScript(tcgi); } if ( $arr{pcgi} ) { insertScript(pcgi); } print "\n"; exit; } #---------------- sub showStartPage { #---------------- print "\n"; print "\n"; print "\n"; print "\n"; print ""; print "\n"; print "\n"; print "\n"; print "\n"; print ""; print "\n"; print ""; print "\n"; print ""; print "\n"; print "\n"; print "

$lex{'Insert Into'}
$lex{'Html Pages'}	"; print "
". $lex{'Text Encoding'}; print "
". $lex{'Language Code'}; print "
". $lex{'Meta table'}; print "	"; print "
$lex{Main} $lex{Scripts}	"; print "
$lex{Teacher} $lex{Scripts}	"; print "
$lex{Parent} $lex{Scripts}	"; print "
"; print "

\n"; exit; } #------------- sub insertHTML { #------------- print "

HTML $lex{Translation}

\n"; my @templatefiles = glob( "../../template/html/*.tpl"); # Get all translated values my $sth = $dbh->prepare("select phrase, translation from xlat_lang"); $sth->execute; my %values = (); while ( my ( $phrase, $translation ) = $sth->fetchrow ) { $values{$phrase} = $translation; } for my $htmlfile ( @templatefiles ) { # Slurp in html template file. unless ( open (FH,"<$htmlfile")) { print $lex{'Cannot open file'}. " $!\n"; die $lex{'Cannot open file'}. " $!\n"; } my $text; { local $/; $text = ; close FH;} print "HTML: $htmlfile
\n"; if ( $arr{encoding} ne 'iso-8859-1' ) { my $newenc = $arr{encoding}; $text =~ s/iso-8859-1/$newenc/; } if ( $arr{lang} ne 'en' ) { my $newlang = 'js/lang/calendar-'. $arr{lang}; $text =~ s/js\/lang\/calendar-en/$newlang/; } $htmlfile =~ s/^.*\///; # remove leading path $htmlfile =~ s/\.tpl$//; # remove the extension my $subdir; if ( $htmlfile eq 'teacher.html' ) { $subdir = 'tadmin'; } elsif ( $htmlfile eq 'parent.html' ) { $subdir = 'padmin'; } else { $subdir = 'admin'; } my $outfile = '../..'. q{/}. $subdir .q{/}. $htmlfile; # Open Output file unless ( open ( OUT,">$outfile")) { print $lex{'Cannot open file'}. ": $!\ $outfile \n"; die $lex{'Cannot open file'}. ": $!"; } # Now put replacement text back in. $text =~ s{\<\#(.*?)\#\>} { exists($values{$1}) ? $values{$1} : $1 }gsex; print OUT $text; close OUT; } # End of HTML Files loop print "

HTML $lex{'Update Complete'}

\n"; return; } # end of insertHTML #------------- sub insertMeta { #------------- print "

Meta $lex{Translation}

\n"; # Set Selects my $sth = $dbh->prepare("select id, fieldid from meta order by tableid, fieldid"); $sth->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $sth1 = $dbh->prepare("select translation from xlat_lang where phrase = ?"); while ( my ( $id, $fieldid ) = $sth->fetchrow ) { # Get translation $sth1->execute( $fieldid ); # find the translation for phrase ($fieldid); my $translation = $sth1->fetchrow; if ( not $translation ) { print "$lex{Missing} $lex{Translation}: $fieldid
\n"; next; } # set new value. my $sth2 = $dbh->prepare("update meta set fieldname = ? where id = ?"); $sth2->execute( $translation, $id ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } #print "Field: $fieldid \n"; } # End of Meta table loop. print "

Meta ". $lex{'Update Complete'}. "

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

$lex{Admin} $lex{Scripts}

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

$lex{'Update Complete'}

\n"; } elsif ( $mode eq 'tcgi' ) { print "

$lex{Teacher} $lex{Scripts}

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

". $lex{'Update Complete'}. "

\n"; } elsif ( $mode eq 'pcgi' ) { print "

$lex{Parent} $lex{Scripts}

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

$lex{'Update Complete'}

\n"; } return; } # end of insertScript #------------ sub parseFile { #------------ my $cgifile = $_; my $csv = Text::CSV_XS->new( {binary => 1} ); if ( $cgifile eq '.' or $cgifile eq '..' ) { return } if ( not $cgifile =~ m/.*\.pl/ ) { return } if ( $cgifile eq 'xlatInsert.pl' ) { return } # can't rewrite executing file. # Slurp in file. unless ( open (FH,"<$cgifile") ) { print $lex{'Cannot open file'}. ": $!\n"; die $lex{'Cannot open file'}. ": $!\n"; } my $text; { local $/; $text = ; close FH;} print " $cgifile "; if ( $arr{lang} ne 'en' ) { my $newlang = 'js/lang/calendar-'. $arr{lang}; $text =~ s/js\/lang\/calendar-en/$newlang/; } 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 $sth = $dbh->prepare("select translation from xlat_lang where phrase = ?"); my $lexstring = '%lex = ('; foreach my $key ( keys %lex ) { if ( not $key ) { next; } # skip any blanks my $tmpkey = q{'}. $key. q{'}; #$tmpkey =~ s/^\'//; #$tmpkey =~ s/\'\s*$//; $sth->execute( $key ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $translation = $sth->fetchrow; $translation =~ s/'/\\'/g; if ( not $translation ) { print "
". $lex{Error}. " $tmpkey - $cgifile
\n"; $lexstring .= "$tmpkey => $tmpkey,\n"; } else { $translation = q{'}. $translation. q{'}; $lexstring .= "$tmpkey => $translation,\n"; } } # Add on trailing bracket (parens), and write new file. $lexstring .= ')'; #print "Lex is: $lexstring \n\n"; my $newtext = $prefix . $lexstring. $finalremainder; # Now open for output (rewriting) unless ( open (OUT, ">$cgifile") ) { print $lex{'Cannot open file'}. ": $!\n"; die $lex{'Cannot open file'}. ": $!\n"; } print OUT $newtext; close OUT; } # end of parseFile