#! /usr/bin/perl
#  Copyright 2001-2021 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 $templatepath = '../../template/';

my %lex = ('Medical' => 'Medical',
	   'Report' => 'Report',
	   'Main' => 'Main',
	   'View/Download' => 'View/Download',
	   'View Log File' => 'View Log File',
	   'Cannot open' => 'Cannot open',
	   'Error' => 'Error',
	   'Continue' => 'Continue',
	   'Sort by' => 'Sort by',
	   'Name' => 'Name',
	   'Homeroom' => 'Homeroom',
	   'Grade' => 'Grade',
	   'Select by' => 'Select by',
	   'Font Size' => 'Font Size',
	   'Paper Size' => 'Paper Size',
	   'Letter' => 'Letter',
	   'Legal' => 'Legal',
	   'A4' => 'A4',
	   'Blank=All' => 'Blank=All',
	   'Separate with Spaces' => 'Separate with Spaces',
	   'Not Found' => 'Not Found',
	   'Mode' => 'Mode',
	   'Template' => 'Template',
	   'Select' => 'Select',

	   );

my $self = 'rptmedtemplate.pl';

use DBI;
use CGI;
use Cwd;


# Read config variables
eval require "../../etc/admin.conf";
if ( $@ ) {
    print $lex{Error}. " $@<br>\n";
    die $lex{Error}. " $@\n";
}

eval require "../../lib/liblatex.pl";
if ( $@ ) {
    print $lex{Error}. " $@<br>\n";
    die $lex{Error}. " $@\n";
}

my $q = new CGI;
my %arr = $q->Vars;
print $q->header( -charset, $charset );

# setup for teacher site, if called from there.
if ( getcwd() =~ /tcgi/ ){ # we are in tcgi
    $css = $tchcss;
    $homepage = $tchpage;
    $downloaddir = $tchdownloaddir;
    $webdownloaddir = $tchwebdownloaddir;
}


my ($sec, $min, $hour, $mday, $mon, $year, $wday, 
    $yday, $iddst) = localtime(time);
$year = $year + 1900;
$mon++;
$wday++;
my $currdate = "$dow[$wday], $month[$mon] $mday, $year";


# Page Header
print qq{$doctype\n<html><head><title>$lex{Template} $lex{Medical} $lex{Report}</title>
<link rel="stylesheet" href="$css" type="text/css">
$chartype\n</head><body>\n};
print qq{<p>[ <a href="$homepage">$lex{Main}</a> ]</p>\n};

print qq{<h1>$lex{Medical} $lex{Report} - $lex{Template}</h1>\n};

if ( not $arr{page} ) {
    showStartPage();
}


# Setup Database access
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
$dbh->{mysql_enable_utf8} = 1;


# Get the report template...
my ( $dud, $templatefile ) = split /\[/, $arr{template};
chop $templatefile;

unless ( open ( FH,"<", $templatepath. $templatefile )) {
    print $lex{Error}. q{ }. $lex{Template}.": $!\n";
    die $lex{Error}. q{ }. $lex{Template}.": $!\n";
}

my $formtext;
my $desc = <FH>;

my $modeline = <FH>;
chomp $modeline; # remove trailing CR/LF.
$modeline =~ s/^\s*//; # strip any leading spaces.
my ($mode, $fmtstart,$fmtend) = split /::/, $modeline;

my $header = <FH>;  # header information for both pdf or html.
$header =~ s/^\s*//; # strip any leading spaces

my $line4 = <FH>; # for future expansion, if required.
my $line5 = <FH>;
# Now load rest of template for layout.
{ local $/; $formtext = <FH>; close FH;}

#print qq{Formtext: $formtext<br><br>\n};


# Create hash for fieldnames from meta.
my $sth = $dbh->prepare("select fieldid, fieldname, required 
 from meta where tableid = ?");
$sth->execute( 'student' );
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
my %fieldnames = ();
while ( my ( $fieldid, $fieldname, $required ) = $sth->fetchrow ) {
    if ( $required ) { # has any value
	if ( $mode eq 'html' ) {
	    $fieldname = qq{<span style="font-weight:bold;">$fieldname</span>};
	} else { # pdf format
	    $fieldname = "{\\bf $fieldname}";
	}
    }
    $fieldnames{$fieldid} = $fieldname;
}

# Now put replacement fieldnames back in.
$formtext =~ s{\<\*(.*?)\*\>}
  { exists( $fieldnames{$1} ) 
	? $fieldnames{$1} 
	: $1
  }gsex;


# Replace other non-meta values in formtext.
my %nonmeta = ();
while ( $formtext =~ m/\<\#(.*)\#\>/g){
    if ( $lex{ $1 } ) { # if we have a translation....
	$nonmeta{$1} =  $lex{$1};
    } else { # no translation.
	$nonmeta{$1} = 'NT:'. $1;
    }
}

# now put them back in...
$formtext =~ s{\<\#(.*?)\#\>}
  { exists( $nonmeta{$1} ) 
	? $nonmeta{$1} 
	: $1
  }gsex;

# Update translation in header.
%lex = ( %lex, %fieldnames ); # join %lex and %fieldnames

#foreach my $key ( keys %lex ) {
#    ( $lex{$key} ) = latex_filter( $lex{$key} );
#}

if ( $header ) {

    $header =~ s{\<\*(.*?)\*\>}
    { exists( $lex{$1} ) 
	? $lex{$1} 
	: $1
	}gsex;
}

# Find all fields , so we only wrap forms around them
# ( faster than doing all fields in the table )
my @fields = ();
while ( $formtext =~ m/\<\@(.*)\@\>/g){
    push @fields, $1;
}

# foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}<br>\n}; }
#print qq{Formtext: $formtext<br><br>\n};


# Now select Students
my @students = ();
my $sort = 'name'; # hold type of sort.

if ( $arr{groupvalue} ) { # then we have to do something...
    my $group;
    my @groups = ();
    @groups = split /\s+/, $arr{groupvalue};
    if ( $arr{grouptype} eq $lex{Grade} ) {
	$group = 'grade';
	$sort = 'grade';
    } else {
	$group = 'homeroom';
	$sort = 'homeroom';
    }

    my $sth = $dbh->prepare("select studnum from student where $group = ? 
       order by $group, lastname, firstname");
    foreach my $grp ( @groups ) {
	$sth->execute( $grp );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	while ( my $studnum = $sth->fetchrow ) {
	    push @students, $studnum;
	}
    }

} else { # all students
    my $sortorder = "lastname, firstname";
    if ( $arr{sortorder} eq $lex{Homeroom} ) {
	$sortorder = "homeroom, lastname, firstname";
	$sort = 'homeroom';
    } elsif ( $arr{sortorder} eq $lex{Grade} ) {
	$sortorder = "grade, lastname, firstname";
	$sort = 'grade';
    }

    $sth = $dbh->prepare("select studnum from student order by $sortorder");
    $sth->execute;
    if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
    while ( my $studnum = $sth->fetchrow ) {
	push @students, $studnum;
    }
}


# Now print output based on mode (html or pdf)
if ( $mode eq 'pdf' ) {
    printPDF();
} elsif ( $mode eq 'html' ) {
    printHTML();
} else { # error;
    print qq{$lex{Error}: $lex{Mode} $lex{'Not Found'}\n};
    print qq{</body></html>\n};
}




#-----------
sub printPDF {
#-----------

    # Start TEX Section.
    my $shortname = "rptmedical$$";
    my $filename = "$shortname.tex";

    open(TEX,">$filename") || die $lex{'Cannot open'}. " tex file\n";

    # Set Paper Size, text width and height, fontsize
    my ( $papersize, $textwidth, $textheight );

    if ( $arr{papersize} eq $lex{Letter} ) {
	$papersize = 'letterpaper';
	$textwidth = $g_letterpaper_textwidth;
	$textheight = $g_letterpaper_textheight;
    } elsif ( $arr{papersize} eq $lex{Legal} ) {
	$papersize = 'legalpaper';
	$textwidth = $g_legalpaper_textwidth;
	$textheight = $g_legalpaper_textheight;
    } elsif ( $arr{papersize} eq $lex{A4} ) {
	$papersize = 'a4paper';
	$textwidth = $g_a4paper_textwidth;
	$textheight = $g_a4paper_textheight;
    } 
    # print qq{Papersize: $papersize  TW: $textwidth  TH: $textheight<br>\n};
    # Not required here, perhaps
    # $textheight =~ s/mm//;# $textheight += 16;# $textheight .= 'mm';

    my $fontsize = $arr{fontsize}. 'pt';

    print TEX "\\documentclass[ $fontsize, $papersize ]{article}
\\usepackage{newcent,graphicx,array,colortbl,inputenc,multicol}
$a_latex_header
\\renewcommand{\\familydefault}{\\sfdefault}
\\usepackage[pdftex,bookmarks=false,pdfstartview=FitH]{hyperref}
\\setlength{\\textwidth}{ $textwidth }
\\setlength{\\textheight}{ $textheight }
\\setlength{\\hoffset}{-20mm}
\\setlength{\\voffset}{-25mm}
\\setlength{\\topmargin}{0mm}
\\setlength{\\evensidemargin}{0mm}
\\setlength{\\oddsidemargin}{0mm}
\\setlength{\\parindent}{0mm}
\\setlength{\\extrarowheight}{4pt}
\\begin{document}
\\pagestyle{empty}\n";


    print TEX "$lex{Medical} $lex{Report} - {\\LARGE $schoolname }";
    print TEX " \\hfill $currdate\n\\bigskip\n\n";

    if ( $fmtstart ) {
	print TEX $fmtstart, "\n";
    }

    $header =~ s/\_//g; # filter underscores in field names
    if ( $header ) {
	print TEX $header, "\n";
    }


    my $sth = $dbh->prepare("select * from student_medical as sm, student as s
      where s.studnum = sm.studnum and s.studnum = ?");

    my $first = 1;
    my $curroom = -1;
    my $counter = 1;


    foreach my $studnum ( @students ) {

	$sth->execute( $studnum );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }

	while ( my $ref = $sth->fetchrow_hashref ) {

	    my %rec = %$ref;
	    foreach my $key ( sort keys %rec ) {
		( $rec{$key} ) = latex_filter( $rec{$key});
	    }
	    
	    $oldroom = $curroom;
	    if ( $sort eq 'homeroom' ) { $curroom = $rec{homeroom}; }
	    elsif ( $sort eq 'grade' ) { $curroom = $rec{grade}; }

	    # put in extra page break if we are starting a new room/grade
	    if ( $curroom ne $oldroom and not $first and $sort ne 'name' ) {
		if ( $fmtend ) { print TEX $fmtend, "\n"; }
		print TEX "\\newpage\n\n"; 
		if ( $fmtstart ) { print TEX $fmtstart, "\n"; }
		if ( $header ) { print TEX $header, "\n";}

		$counter = 1;  # Set counter back to one to print x recs/page

	    } else { $first = 0; }
	
  
	    my $text = $formtext; # make a new blank record to plug in...

	    # Now put replacement text back in.
	    $text =~ s{\<\@(.*?)\@\>}
	    { $rec{$1} }gsex;

	    $text =~ s/\_/ /g; # remove underscores in field names.

#	    print qq{TXT:$text<br><br>\n";

	    print TEX $text,"\n";
 
#		if ( $fmtend ) { print TEX $fmtend, "\n"; }
#		print TEX "\\newpage\n\n"; 
#		if ( $fmtstart ) { print TEX $fmtstart, "\n"; }
#		if ( $header ) { print TEX $header, "\n";}
#	    } 

	    $counter++;

	} # End of this medical record

    }  # End of Student Loop

    if ( $fmtend ) {
	print TEX $fmtend;
    }
    print TEX "\\end{document}";
    close TEX;


    system("$pdflatex $filename > pdflog$$.txt");
    system("mv $shortname.pdf $downloaddir");
    system("mv pdflog$$.txt $downloaddir");
    system("rm $shortname.*");

    print qq{<h1><a href="$webdownloaddir/$shortname.pdf">};
    print qq{$lex{'View/Download'} $lex{Medical} $lex{Report}</a></h1>\n};
    print qq{[ <a href="$homepage">$lex{Main}</a> | \n};
    print qq{<a href="$webdownloaddir/pdflog$$.txt">$lex{'View Log File'}</a> ]\n};
    print qq{</body></html>\n};

} # end of printPDF.



#------------
sub printHTML { # Not Updated, yet.
#------------

    print qq{<h1>$lex{Medical} $lex{Report} - $schoolname</h1>\n};
    print qq{<h3>$currdate</h3>\n};

    if ( $fmtstart ) {
	print $fmtstart, qq{\n};
    }
    if ( $header ) {
	print $header, qq{\n};
    }

    my $sth = $dbh->prepare("select * from student where studnum = ?");

    my $first = 1;
    my $curroom = -1;
    my $counter = 1;

    foreach my $studnum ( @students ) {

	$sth->execute( $studnum );
	if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
	my $ref = $sth->fetchrow_hashref;
	my %rec = %$ref;

	$oldroom = $curroom;
	if ( $sort eq 'homeroom' ) { $curroom = $rec{homeroom}; }
	elsif ( $sort eq 'grade' ) { $curroom = $rec{grade}; }

	# put in extra page break if we are starting a new room/grade
	if ( $curroom ne $oldroom and not $first and $sort ne 'name' ) {
	    print qq{</table><p></p><table cellspacing="0" cellpadding="3" border="1">\n};
	} else { $first = 0; }
	
	my $text = $formtext; # make a new blank record to plug in...

	# Now put replacement text back in.
	$text =~ s{\<\@(.*?)\@\>}
  	  { $rec{$1} }gsex;

	print $text,qq{\n};

    }  # End of record printing loop

    print qq{</table>};
    print qq{[ <a href="$homepage">$lex{Main}</a> ]\n};
    print qq{</body></html>\n};

}



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

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

    # Open the Report Templates
    my @files = glob($templatepath."/rptmedical*.tpl");

    for my $tplfile ( @files ) {
	# read each label file and get description
	unless ( open (FH,"<$tplfile")) {
	    print qq{$lex{Error} $lex{Template}: $!\n};
	    die qq{$lex{Error} $lex{Template}: $!\n};
	}

	# read first 2 lines of the template only.
	my $desc = <FH>;
	chomp $desc;
	$desc =~ s/\[//g;  # strip any opening square labels, just in case.

	my $modeline = <FH>;
	$modeline =~ s/^\s*//; # strip any leading spaces
	my ($mode, $fmtstart,$fmtend) = split /::/, $modeline;
	# ignore rest of the file, not required.

	$tplfile =~ s/^.*\///; # strip leading path
	push @desc, qq{$desc ($mode) [$tplfile]};
    }


    print qq{<tr><td class="bra">$lex{Select} $lex{Template}\n};
    print qq{</td><td><select name="template">\n};
    foreach my $desc ( @desc ) {
	print qq{<option>$desc</option>\n};
    }
    print qq{</select></td></tr>\n};


    print qq{<tr><td class="bra">$lex{'Select by'}\n};
    print qq{</td><td><select name="grouptype"><option>$lex{Grade}</option>\n};
    print qq{<option>$lex{Homeroom}</option></select>\n};
    print qq{<input type="text" name="groupvalue" size="12"> };
    print qq{$lex{'Separate with Spaces'}, $lex{'Blank=All'}</td></tr>\n};

    print qq{<tr><td class="bra">$lex{'Sort by'}\n};
    print qq{</td><td><select name="sortorder"><option>$lex{Name}</option>\n};
    print qq{<option>$lex{Grade}</option>\n};
    print qq{<option>$lex{Homeroom}</option>\n};
    print qq{</select></td></tr>\n};

    print qq{<tr><td class="bra">$lex{'Paper Size'}</td><td>};
    print qq{<select name="papersize">\n};
    print qq{<option>$lex{Letter}</option>\n};
    print qq{<option>$lex{Legal}</option>};
    print qq{<option>$lex{A4}</option></select></td></tr>\n};

    print qq{<tr><td class="bra">$lex{'Font Size'}\n};
    print qq{</td><td><select name="fontsize"><option>10</option><option>11</option>\n};
    print qq{<option>12</option></select></td></tr>\n};

    print qq{<tr><td class="cn" colspan="2">\n};
    print qq{<input type="submit" value="$lex{Continue}"></td></tr>\n};
    print qq{</table></form>\n};

    print qq{</body></html>\n};

    exit;

}
