#!/usr/bin/perl
#  Copyright 2001-2008 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 $self = 'lexcheck.pl';

use CGI;
use Text::Balanced qw(extract_bracketed extract_codeblock extract_variable );
use Text::CSV_XS;
use File::Find;

open(LOG, ">lex.log");

find(\&parseFile, '.' );


#------------
sub parseFile {  # extract lex phrases and compare.
#------------

    my $cgifile = $_;

    my $csv = Text::CSV_XS->new( {binary => 1} );

    if ( $cgifile eq '.' or $cgifile eq '..' or $cgifile eq $self ) { return }
    if ( not $cgifile =~ m/.*\.pl/ ) { return }

    # Slurp in file.
    unless ( open (FH,"<$cgifile") ) {
	print $lex{'Cannot open file'}. ": $!\n";
	die $lex{'Cannot open file'}. ": $!\n";

    }
    my $text;
    { local $/; $text = <FH>; close FH;}

    print "$cgifile \n"; 

    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; }
	$phrases{$key} = 1;
    }

#    print LOG "Phrases:\n";
$count = 0;
    foreach my $key (sort keys %phrases ) {
       $count++;
#       if ( $count % 5 == 0 ) { print LOG "\n"; }
#      print LOG "$key  ";
    }

    # Now deal with $finalremainder
    my %used = ();
    while ( $finalremainder =~ m/\$lex\{(.*?)\}/g){
	my $temp = $1;
	$temp =~ s/^\'//;
	$temp =~ s/\'$//;
	$used{$temp} = 1;
	#print "$temp  ";
    }

    # Now compare and see what's left over.
    my %test = ();
    %test = %phrases;

    foreach my $key ( keys %phrases ) {
        if ( $used{$key} ) { # if this is already used, 
	   delete $used{$key};
           delete $test{$key};
        }
    }

if ( not %used and not %test ) { return; }

    print LOG uc("\n\n$cgifile\n");

    print LOG "Missing Lexicon Phrases:\n";
    foreach my $key (sort keys %used ) {
       $count++;
       if ( $count % 5 == 0 ) { print LOG "\n"; }
	print LOG $key. q{ };
    }

    print LOG "\n\nUnused Lexicon Phrases:\n";
    foreach my $key (sort keys %test ) {
       $count++;
       if ( $count % 5 == 0 ) { print LOG "\n"; }
	print LOG $key. q{ };
    }

    return;

} # end of parseFile;