#! /usr/bin/perl # Copyright 2001-2018 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. use DBI; use CGI; use Cwd; use Number::Format qw(:subs); my %lex = ('Transfer' => 'Transfer', 'Report' => 'Report', 'Missing' => 'Missing', 'Date' => 'Date', 'Student' => 'Student', 'Enrollments' => 'Enrollments', 'Withdrawals' => 'Withdrawals', 'Code' => 'Code', 'Count' => 'Count', 'Main' => 'Main', 'Start Date' => 'Start Date', 'End Date' => 'End Date', 'Continue' => 'Continue', 'Error' => 'Error', 'Description' => 'Description', 'Edit' => 'Edit', 'View' => 'View', ); my $self = "rpttranscode.pl"; my $configpath = '../..'; # main config file eval require "$configpath/etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } # pull in global enrol/withdraw descriptors eval require "$globdir/global.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } # Get current dir so know what CSS to display and shift to teacher settings. if ( getcwd() =~ /tcgi/ ) { # we are in tcgi $css = $tchcss; $homepage = $tchpage; $downloaddir = $tchdownloaddir; $webdownloaddir = $tchwebdownloaddir; } my $maxlines = 28; my $shortname = "transtat$$"; my $filename = "$shortname.tex"; # Get Date my @tim = localtime(time); my $year = @tim[5] + 1900; my $month = @tim[4] + 1; my $day = @tim[3]; if ( length( $day ) == 1 ) { $day = '0'. $day; } if ( length( $month ) == 1 ) { $month = '0'. $month; } my $currsdate = "$year-$month-$day"; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; my $q = new CGI; print $q->header( -charset, $charset ); my %arr = $q->Vars; # Testing throughput #foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n}; } # rounding format my $fmt = new Number::Format(-decimal_fill => '1', -decimal_digits => '2'); # print page header print qq{$doctype\n$lex{Transfer} $lex{Report}\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{$chartype\n[ $lex{Main} ]\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; showTransfers(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; showType(); } #----------- sub showType { #----------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my ( $code, $display, $select1, $select2 ); if ( exists $arr{exitcode} ) { $code = $arr{exitcode}; $display = $g_wdraw{$code}; $select1 = "type = 'withdraw'"; if ( not $code ) { $display = qq{$lex{Missing} $lex{Code}}; $select2 = qq{exittype = '' or exittype is NULL}; } else { $select2 = qq{exittype = '$arr{exitcode}'}; } } else { $code = $arr{entrycode}; $display = $g_enrol{$code}; $select1 = "type != 'withdraw'"; $select2 = "entrytype = '$arr{entrycode}' "; } print qq{

$lex{View} $lex{Enrollments}/$lex{Withdrawals}

\n}; if ( not $display ) { $display = qq{Missing Code}; } print qq{

$display

\n}; print qq{\n}; print qq{\n}; my $sth = $dbh->prepare("select * from transfer where $select1 and to_days( date ) >= to_days('$arr{startdate}') and to_days( date ) <= to_days('$arr{enddate}') and $select2 order by date"); $sth->execute(); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; my $count = 1; while ( my $ref = $sth->fetchrow_hashref ) { print qq{\n}; print qq{\n}; $count++; } print qq{
$lex{Student}$lex{Date}
$count. $ref->{firstname} $ref->{lastname}$ref->{date}
\n}; print qq{\n}; print qq{
}; print qq{
\n}; exit; } #----------------- sub showTransfers { #----------------- if ( not $arr{startdate} or not $arr{enddate} ) { print qq{

$lex{Missing} $lex{Date}

\n}; print qq{\n}; exit; } print qq{
$lex{'Start Date'}: $arr{startdate} }; print qq{$lex{'End Date'}: $arr{enddate}
\n}; # Enrols print qq{

$lex{Student} $lex{Enrollments}

\n}; print qq{\n}; print qq{\n}; my $sth = $dbh->prepare("select distinct entrytype, count(*) from transfer where type != 'withdraw' and to_days( date ) >= to_days('$arr{startdate}') and to_days( date ) <= to_days('$arr{enddate}') group by entrytype order by entrytype"); $sth->execute(); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; while ( my ( $entrytype, $count ) = $sth->fetchrow ) { my $desc; if ( not $entrytype ) { $desc = qq{$lex{Missing} $lex{Code}}; } else { $desc = $g_enrol{$entrytype}; } print qq{\n}; print qq{\n}; } print qq{
$lex{Code}$lex{Description}$lex{Count}
$entrytype$desc$count
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
\n}; # Withdraws print qq{

$lex{Student} $lex{Withdrawals}

\n}; print qq{\n}; print qq{\n}; my $sth = $dbh->prepare("select distinct exittype, count(*) from transfer where type = 'withdraw' and to_days( date ) >= to_days('$arr{startdate}') and to_days( date ) <= to_days('$arr{enddate}') group by exittype order by exittype"); $sth->execute(); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; while ( my ( $exittype, $count ) = $sth->fetchrow ) { my $desc; if ( not $exittype ) { $desc = qq{$lex{Missing} $lex{Code}}; } else { $desc = $g_wdraw{$exittype}; } print qq{\n}; print qq{\n}; } print qq{
$lex{Code}$lex{Description}$lex{Count}
$exittype$count$desc
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
\n}; print qq{\n}; exit; } #----------------- sub showStartPage { #----------------- # Get default papersize my $papersize = $defaultpapersize; $papersize =~ s/paper//; # strip off the 'paper' ending; $papersize = ucfirst( $papersize ); # print sortorder and selection input form. print qq{

$lex{Transfer} $lex{Report}

\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{'Start Date'}}; print qq{\n}; print qq{
$lex{'End Date'}}; print qq{
}; print qq{
\n}; print qq{\n}; print qq{\n}; exit; }