#! /usr/bin/perl # Copyright 2001-2020 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', 'Template' => 'Template', 'Creator' => 'Creator', 'Description' => 'Description', 'Type' => 'Type', 'Select' => 'Select', 'Fields' => 'Fields', 'Error' => 'Error', 'Continue' => 'Continue', 'Column' => 'Column', 'Number' => 'Number', 'Width' => 'Width', 'Order' => 'Order', 'Tabular' => 'Tabular', 'Multicolumn' => 'Multicolumn', 'Reorder' => 'Reorder', 'Student Roster' => 'Student Roster', 'Report' => 'Report', 'Created' => 'Created', 'Delete' => 'Delete', 'Select' => 'Select', 'Deleted' => 'Deleted', 'Save' => 'Save', 'Drag' => 'Drag', 'Change' => 'Change', 'Order' => 'Order', 'View' => 'View', 'New' => 'New', 'Missing' => 'Missing', ); my $self = 'templatecreator.pl'; my $templatepath = '../template/'; my $startTemplateDelete = 5; # Starting Number for User Created Templates (to delete) use DBI; use CGI; use Cwd; # Read config variables eval require "../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } # Setup Database access my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); =head # redundant until doing direct db load # my @fieldnames = qw( g_jquery_url g_jquery_ui_url ); my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); foreach my $var ( qw( g_jquery_url g_jquery_ui_url )) { $sth->execute( $var ); my $datavalue = $sth->fetchrow; eval $datavalue; if ( $@ ) { print qq{$lex{Error}: $@
\n}; die "$lex{Error}: $@\n"; } } =cut 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; } # Page Header my $title = "$lex{Template} $lex{Creator}"; print qq{$doctype\n$title\n}; print qq{\n}; if ( $arr{page} == 1 ) { # load jQuery libs, css print qq{\n}; print qq{\n}; print qq{\n}; } print qq{$chartype\n\n}; print qq{
[ $lex{Main} ]\n}; if ( not $arr{page} ) { print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; } else { print qq{\n}; # close div. } print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectOptions(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; createTemplate(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; selectTemplateToDelete(); } elsif ( $arr{page} == 4 ) { delete $arr{page}; deleteTemplate(); } #----------------- sub deleteTemplate { #----------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } foreach my $key ( sort keys %arr ) { my $fullname = $templatepath . $key; my $result = unlink( $fullname ); if ( $result ) { print qq{

$key $lex{Deleted}

\n}; } } print qq{

[ $lex{'Student Roster'} $lex{Report} | \n}; print qq{$lex{Template} $lex{Creator} | \n}; print qq{$lex{Main} ]

\n}; print qq{\n}; exit; } #------------------------- sub selectTemplateToDelete { #------------------------- # Open the Report Templates my @files = glob($templatepath."rptstudrost*.tpl"); for my $tplfile ( @files ) { # read each label file and get description unless ( open (FH,"<$tplfile")) { print qq{$lex{Error} $lex{Template}: $!\n}; die "$lex{Error} $lex{Template}: $!\n"; } # read first 2 lines of the template only. my $desc = ; chomp $desc; $desc =~ s/\[//g; # strip any opening square labels, just in case. my $modeline = ; $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, "$desc ($mode) [$tplfile]"; } print qq{

$lex{Delete} $lex{Template}

\n}; print qq{
\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; foreach my $desc ( @desc ) { $desc =~ m/rptstudrost(.*)\.tpl/; my $num = $1; print qq{\n}; } print qq{
$lex{Template}$lex{Select}
$desc\n}; if ( $num >= $startTemplateDelete ) { print qq{}; } print qq{
\n}; print qq{
\n}; print qq{
\n}; print qq{\n}; exit; } #----------------- sub createTemplate { #----------------- # Debug Option # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n"; } my $reporttype = lc( $arr{tc_reporttype} ); delete $arr{tc_reporttype}; my $description = $arr{tc_description}; delete $arr{tc_description}; my $pdftype = lc( $arr{tc_pdftype} ); delete $arr{tc_pdftype}; my $colcount = $arr{tc_colcount}; delete $arr{tc_colcount}; my $filename; for my $i ( 0 .. 99 ) { if ( length $i == 1 ) { $i = '0'. $i; } # prepend a zero. $filename = 'rptstudrost'. $i. '.tpl'; my $fullname = $templatepath. $filename; if ( -e $fullname ) { next; } # skip last; # we have a filename to use. } # my @fields = split(",", $arr{sortorder} ); foreach my $fld ( @fields ) { $fld =~ s/s\_//; } delete $arr{sortorder}; # Extract the width keys, check for missing values my %width = (); foreach my $key ( keys %arr ) { if ( $key =~ m/wid\_(.*)/) { if ( $arr{$key} =~ m/\D/ or not $arr{$key} ) { # non digit or missing print qq{

$lex{Width} $lex{Error}: }; print qq{$key -> $arr{$key}

\n}; print qq{\n}; exit; } $width{ $1 } = $arr{$key}; delete $arr{$key}; } } # foreach my $key ( sort keys %arr ) { print qq{K:$key V: $arr{$key}
\n}; } # Open File unless ( open ( FH,">", $templatepath. $filename )) { print qq{$lex{Error} $lex{Template}: $!\n}; die qq{$lex{Error} $lex{Template}: $!\n}; } # Write Description line - Line 1 print FH $description. "\n"; if ( $reporttype eq 'pdf' ) { if ( $pdftype eq 'tabular' ) { # Write Type and Format Line - Line 2 print FH 'pdf::\begin{tabular}{|'; foreach my $fld ( @fields ) { print FH 'p{'. $width{ $fld }. 'mm}|'; } print FH '}\hline::\end{tabular}'. "\n"; # Write the header line - Line 3 my $first = 1; print FH '\rowcolor[gray]{0.85}'; foreach my $fld ( @fields ) { if ( not $first ) { print FH ' &'; } else { $first = 0; } print FH '{\bf <*'. $fld. '*>}'; } print FH '\\\\ \hline'. "\n"; print FH "\n"; # blank line 4 and 5 for future expansion. print FH "\n"; # Write the layout. my $first = 1; foreach my $fld ( @fields ) { if ( not $first ) { print FH ' &'; } else { $first = 0; } print FH '<@'. $fld. '@>'; } print FH '\\\\ \hline'. "\n"; } else { # pdftype is multicolumn # Write Type and Format Line - Line 2 print FH 'pdf::\begin{multicols}{'. $colcount. '}::\end{multicols}'. "\n"; # Write blank header line - Line 3 print FH "\n"; print FH "\n"; # blank line 4 and 5 for future expansion. print FH "\n"; # Write the layout. foreach my $fld ( @fields ) { print FH '<*'. $fld. '*> <@'. $fld. '@>\\\\'. "\n"; } } } else { # HTML report type # Write Type and Format Line - Line 2 print FH qq{html::}; print FH qq{::
::\n}; # no record count; # Write the header line - Line 3 print FH ''; foreach my $fld ( @fields ) { print FH '<*'. $fld. '*>'; } print FH ''. "\n"; print FH "\n"; # blank line 4 and 5 for future expansion. print FH "\n"; # Write the layout. print FH ''; foreach my $fld ( @fields ) { print FH '<@'. $fld. '@>'; } print FH ''. "\n"; } close FH; print qq{

$lex{Template}: $filename $lex{Created}

\n}; print qq{

[ $lex{View} $lex{New} $lex{Report} |\n}; print qq{$lex{Main} ]

\n}; print qq{\n}; exit; } #---------------- sub selectOptions { #---------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n";OA } # Check for Missing Fields my $hasfields; foreach my $key ( sort keys %arr ) { if ( $key =~ m/tc\_.*/ ) { next; } $hasfields = 1; } if ( not $hasfields ) { print qq{

$lex{Error}: $lex{Fields} $lex{Missing}

\n}; print qq{\n}; exit; } if ( not $arr{'tc_description'} ) { print qq{

$lex{Error}: $lex{Description} $lex{Missing}

\n}; print qq{\n}; exit; } if ( not $arr{'tc_reporttype'} ) { print qq{

$lex{Error}: $lex{Report} $lex{Type} $lex{Missing}

\n}; print qq{\n}; exit; } if ( $arr{'tc_reporttype'} eq 'PDF' and not $arr{'tc_pdftype'} ) { print qq{

$lex{Error}: PDF $lex{Type} $lex{Missing}

\n}; print qq{\n}; exit; } # Create hash for fieldnames from meta. my $sth = $dbh->prepare("select fieldid, fieldname from meta where tableid = ? order by arrayidx"); $sth->execute( 'student' ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my %fieldnames = (); while ( my ( $fieldid, $fieldname ) = $sth->fetchrow ) { $fieldnames{$fieldid} = $fieldname; } # Start Form print qq{
\n}; print qq{\n}; # put in hidden keys foreach my $key ( sort keys %arr ) { print qq{\n}; } if ( $arr{tc_reporttype} eq 'PDF' ) { # add more fields # Start Table print qq{\n}; if ( $arr{tc_pdftype} eq $lex{Tabular} ) { print qq{\n}; foreach my $key ( sort keys %arr ) { if ( $key =~ m/tc\_.*/ ) { next; } print qq{\n}; print qq{\n}; } } else { # multicol # get column count print qq{\n}; print qq{\n}; } # end of pdf - multicol print qq{
$lex{Fields}$lex{Width}
$key}; print qq{ mm
$lex{Column} $lex{Number}\n}; print qq{
\n}; } # additional PDF options. # start of Sorting section. print qq{

$lex{Drag} $lex{Fields} = $lex{Change} $lex{Order} (Top is Leftmost Field)

\n}; print qq{
\n}; print qq{
\n}; foreach my $key ( sort keys %arr ) { if ( $key =~ m/tc\_.*/ ) { next; } # skip non field values my $id = 's_'. $key; print qq{
}; print qq{$fieldnames{$key}
\n}; } print qq{
\n}; # end of Sorting section. # Save Button print qq{

\n}; print qq{\n}; print qq{
\n}; # Javscript Function for Sorting. print q{ }; print qq{\n}; exit; } # end of selectOptions #---------------- sub showStartPage { #---------------- # Start Form print qq{
\n}; print qq{\n}; print qq{\n}; # above, only create HTML reports now # Table print qq{\n}; # Continue Button print qq{\n}; # Description print qq{\n}; print qq{\n}; # Now only HTML reports, as above. # Report Type: pdf or html # print qq{\n}; # print qq{\n}; # PDF Type: tabular or multicolumn # print qq{\n}; # print qq{\n}; # Create hash for fieldnames from meta. my $sth = $dbh->prepare("select fieldid, fieldname from meta where tableid = ? order by arrayidx"); $sth->execute( 'student' ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } # Select Fields to Show print qq{\n}; while ( my ( $fieldid, $fieldname ) = $sth->fetchrow ) { print qq{\n}; } print qq{\n}; # Continue Button print qq{\n}; print qq{
\n}; print qq{
$lex{Description}
$lex{Type}
PDF $lex{Type}
}; print qq{$lex{Select} $lex{Fields}
\n}; print qq{ $fieldname
\n}; print qq{
\n}; print qq{\n}; exit; }