#!/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}. " $@<br>\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<html><head><title>$title</title>\n";
print "<link rel=\"stylesheet\" href=\"$css\" type=\"text/css\">\n";
print "$chartype\n</head><body>\n";

print "[ <a href=\"$homepage\">$lex{Main}</a> |\n";
print "<a href=\"$eoypage\">$lex{Eoy}</a> ]\n";

print "<h1>$title</h1>\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}<br>\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 "</body></html>\n";

    exit;

}


#----------------
sub showStartPage {
#----------------

    print "<table cellpadding=\"3\" cellspacing=\"0\" border=\"0\">\n";
    print "<form action=\"$self\" method=\"post\">\n";
    print "<input type=\"hidden\" name=\"page\" value=\"1\">\n";

    print "<tr><td class=\"ra\"><b>". $lex{'Empty Phrase Table'};
    print "</b></td><td><input type=\"checkbox\" name=\"emptyphrase\" value=\"1\">";
    print "</td></tr>\n";


    print "<tr><td class=\"bra\">$lex{'Find Phrases to Translate'}</td>\n";
    print "<td></td></tr>\n";

    print "<tr><td class=\"ra\">$lex{'Html Pages'}</td>\n";
    print "<td><input type=\"checkbox\" name=\"html\" value=\"1\">";
    print "</td></tr>\n";

    print "<tr><td class=\"ra\">$lex{'Meta table'}</td>\n";
    print "<td><input type=\"checkbox\" name=\"meta\" value=\"1\">";
    print "</td></tr>\n";

    print "<tr><td class=\"ra\">$lex{Admin} $lex{'Site Scripts'}</td>\n";;
    print "<td><input type=\"checkbox\" name=\"cgi\" value=\"1\">";
    print "</td></tr>\n";

    print "<tr><td class=\"ra\">$lex{Teacher} $lex{'Site Scripts'}</td>\n";
    print "<td><input type=\"checkbox\" name=\"tcgi\" value=\"1\">";
    print "</td></tr>\n";

    print "<tr><td class=\"ra\">$lex{Parent} $lex{'Site Scripts'}</td>\n";
    print "<td><input type=\"checkbox\" name=\"pcgi\" value=\"1\">";
    print "</td></tr>\n";


    print "<tr><td class=\"ra\">";
    print "<input type=\"submit\" value=\"$lex{Continue}\"></td><td></td></tr>\n";
    print "</form></table></body></html>\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 "<h3>HTML $lex{Translation}</h3>\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 = <FH>; 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 "<div style=\"font-size:130%;font-weight:bold;\">HTML $lex{'Update Complete'}</div>\n";

    return;

} # end of extractHTML



#-------------
sub extractMeta {
#-------------

    print "<h3>Meta $lex{Translation}</h3>\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<br>\n";

    }
    
    print "<div style=\"font-size:130%;font-weight:bold;\">Meta $lex{'Update Complete'}</div>\n";

    return;

} # end of extractMeta



#---------------
sub extractScript {
#---------------

    my $mode = shift;

    my $cgipath = '../../cgi';
    my $tcgipath = '../../tcgi';
    my $pcgipath = '../../pcgi';

    if ( $mode eq 'cgi' ) {
	print "<h3>$lex{Main} $lex{'Site Translation'}</h3>\n";
	find(\&parseFile, $cgipath );

    } elsif ( $mode eq 'tcgi' ) {
	print "<h3>$lex{Teacher} $lex{'Site Translation'}</h3>\n";
	find(\&parseFile, $tcgipath );

    } elsif ( $mode eq 'pcgi' ) {
	print "<h3>$lex{Parent} $lex{'Site Translation'}</h3>\n";
	find(\&parseFile, $pcgipath );

    }

    print "<div style=\"font-size:130%;font-weight:bold;\">$lex{'Update Complete'}</div>\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 = <FH>; close FH;}

    print " $cgifile "; 

    my ( $extracted, $remainder, $prefix ) = extract_variable($text,'(?s).*?(?=%lex)');

    if ( not $extracted ) {
	print  "<br><b>Missing %lex in $cgifile</b><br>\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 "<br>Status: $status<br>\n";
	print "<b>String</b>: $hash\n\n";
	die;
    }
    my $version = $csv->version;

    my @fields = $csv->fields;
    $status = $csv->status;
    if ( not $status ) {
	print "\n<br><b>String</b>: $hash<br>\n\n";
	print "<br><b>Array:</b><br>";
	foreach my $fld ( @fields ) {
	    print "F:$fld ";
	}
	print "<br>\n";
	die;
    }
    if ( not @fields ) {
	print "\n<br><b> NO Fields</b>\n";
	print "<br>Hash: $hash\n";
	print "<br>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
