#!/usr/bin/perl # Copyright 2001-2024 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 = ('Withdraw' => 'Withdraw', 'Student' => 'Student', 'No Student(s) Found' => 'No Student(s) Found', 'Withdrawn' => 'Withdrawn', 'Contact' => 'Contact', 'Main' => 'Main', 'Error' => 'Error', 'Last,First/Last/Initials/Studnum' => 'Last,First/Last/Initials/Studnum', 'Search' => 'Search', 'Name' => 'Name', 'Birthdate' => 'Birthdate', 'Grade' => 'Grade', 'Homeroom' => 'Homeroom', 'Province' => 'Province', 'Country' => 'Country', 'Description' => 'Description', 'Reason' => 'Reason', 'Code' => 'Code', 'Transfer' => 'Transfer', 'Date' => 'Date', 'Yes' => 'Yes', 'Delete' => 'Delete', 'Insert' => 'Insert', 'Cannot open' => 'Cannot open', 'Student Number' => 'Student Number', ); use DBI; use CGI; use Time::JulianDay; my $self = 'withdraw.pl'; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } # Load audit write function eval require "../../lib/libaudit.pl"; if ( $@ ) { print $lex{Error}. ": $@
\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); # Page Header. my $title = qq{$lex{Withdraw} $lex{Student}}; print qq{$doctype\n$title \n}; if ( $arr{page} == 2 ) { # calendar popup. print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; } print qq{$chartype\n\n}; if ( not $arr{page} ) { print qq{\n}; } else { print qq{\n}; } print qq{

[ $lex{Main} ]

\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectStudent(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; confirmWithdraw(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; withdrawStudent(); } #---------------- sub showStartPage { #---------------- print qq{\n}; print qq{\n}; exit; } # end of showStartPage #---------------- sub selectStudent { #---------------- my $student = $arr{student}; # Setup the Search if ($student =~ /\d+/) { # we have a student number $studnum = $student; $sth = $dbh->prepare("select lastname, firstname, studnum from student where studnum = ?"); $sth->execute( $studnum ); } else { # we have words hopefully with a comma ($lastname,$firstname) = split /\,/, $student; $firstname =~ s/^\s*//; $lastname =~ s/^\s*//; if ($lastname and $firstname){ # both entered. $sth = $dbh->prepare("select lastname, firstname, studnum from student where lastname = ? and firstname = ? order by lastname, firstname"); $sth->execute( $lastname, $firstname ); } elsif ( $lastname and not $firstname ){ # only lastname (no comma) if (length($lastname) == 2){ # search by initials: fi, li. $fi = substr($lastname,0,1); $li = substr($lastname,1,1); $fi .= '%'; $li .= '%'; $sth = $dbh->prepare("select lastname,firstname, studnum from student where lastname $sql{like} ? and firstname $sql{like} ? order by lastname, firstname"); $sth->execute( $li, $fi ); } else { $sth = $dbh->prepare("select lastname, firstname, studnum from student where lastname = ? order by lastname, firstname"); $sth->execute( $lastname ); } } else { $sth = $dbh->prepare("select lastname, firstname, studnum from student order by lastname, firstname"); } } # Last Else if ( $DBI::errstr ) { print $lex{Error}. ": $DBI::errstr"; die $DBI::errstr; } my $first = 1; # print table heading. print qq{\n}; # Loop through each found student. while ( my ( $lastname, $firstname,$studnum ) = $sth->fetchrow ) { print qq{\n}; $first = 0; } if ( $first ) { # no students print qq{\n}; print qq{

}; print qq{

}; print qq{$lex{'No Student(s) Found'}

\n}; showStartPage(); } else { print qq{\n}; } exit; } # end of selectStudent #------------------ sub confirmWithdraw { #------------------ # foreach my $key (keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $studnum = $arr{studnum}; # Set current time my @tim = localtime(time); my $year = @tim[5] + 1900; my $month = @tim[4] + 1; my $day = @tim[3]; my $currdate = "$year-$month-$day"; # Load global codes if ( not -e "$globdir/global.conf" ) { print qq{

$lex{'Cannot open'} global.conf file!}; print qq{\n}; exit; } # Read the global enrol/withdraw reasons. eval { require "$globdir/global.conf"; }; if ( $@ ) { print qq{

$lex{'Cannot open'} global.conf:\n $@

\n}; die $lex{'Cannot open'}. " global.conf: $@\n"; } # Read the student data. $sth = $dbh->prepare("select lastname, firstname, birthdate, grade, homeroom from student where studnum = ?"); $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname, $birthdate, $grade, $homeroom ) = $sth->fetchrow; # Start Form print qq{

\n}; print qq{\n}; print qq{\n}; # Start Table print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Blank row # print qq{\n}; # Withdraw Date print qq{\n\n}; # Withdraw Reason print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{}; print qq{\n}; print qq{\n}; print qq{

$lex{Name}	}; print qq{$firstname $lastname
$lex{'Student Number'}	$studnum
$lex{Birthdate}	$birthdate
$lex{Grade}	$grade
$lex{Homeroom}	$homeroom

$lex{Withdraw} $lex{Date}	}; print qq{\n}; print qq{\n}; print qq{
$lex{Withdraw} $lex{Reason}
$lex{Province} $lex{Code}	}; print qq{ $lex{Transfer} -> $lex{Province}
$lex{Country} $lex{Code}	}; print qq{ $lex{Transfer} -> $lex{Country}
$lex{Description}	}; print qq{
	}; print qq{}; print qq{

\n}; print qq{\n}; print qq{\n}; exit; } #------------------ sub withdrawStudent { #------------------ # foreach my $key (keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Passed 6 fields: studnum, exittype, date, description, prov, country. # Check for blank values.... date, reason. If so fail. if ( not $arr{date} or not $arr{exittype} ) { print qq{

Missing Exit Reason or Date

\n}; print qq{\n}; exit; } # check that exit date is after (or equal) enrollment date and within school year. my $jd = julian_day( split('-', $arr{date})); my $dow = day_of_week($jd); if ( $dow == 0 or $dow == 6 ) { # Sunday=0, Sat=6, Error print qq{

Withdrawal on a weekend not allowed!

\n}; print qq{\n}; exit; } # Check for closed date. my $sth = $dbh->prepare("select * from dates where date = ?"); $sth->execute( $arr{date} ); my $ref = $sth->fetchrow_hashref; my %d = %$ref; if ( $d{dayfraction} > 0.99 ) { print qq{

Withdrawal on a closed date not allowed!

\n}; print qq{\n}; exit; } my $endjd = julian_day( split('-', $schoolend)); # Get Previous Enrollment record; verify that's it an enrollment. my $sth = $dbh->prepare("select * from transfer where studnum = ? order by date desc"); $sth->execute( $arr{studnum} ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $tref = $sth->fetchrow_hashref; my %t = %$tref; # latest record; we had better have an enrollment, NOT a withdrawal # Allow for the fact that some students have no enrollment info, but are current. if ( $t{type} and $t{type} ne 'enrol' ) { # Error. Provide a link to view/edit records.ew.pl) print qq{

Error - Last transfer record is not an enrollment.

\n}; print qq{\n}; print qq{\n}; exit; } my $enroljd = julian_day( split('-', $t{date})); # check that withdrawal date is >= enroldate (enroljd) and before year end (endjd) if ( $jd < $enroljd ) { print qq{

Error: Withdrawal date ($arr{date}) is earlier than }; print qq{Enrollment Date ($t{date})

\n}; print qq{\n}; print qq{\n}; exit; } elsif ( $jd > $endjd ) { print qq{

Error: Withdrawal date ($arr{date}) is after }; print qq{the End of the School Year ($schoolend)

\n}; print qq{\n}; exit; } # Check that the student IS a current student. # Shouldn't be necessary, since we only search current students at the start. my $sth = $dbh->prepare("select * from student where studnum = ?"); # not studentwd/studentall $sth->execute( $arr{studnum} ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; # use this for transfer records. $sth->execute( $arr{studnum} ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my @student = $sth->fetchrow; if ( not $student[0] ) { # not a current student. print qq{

$lex{Error}: You cannot withdraw a student who is already withdrawn!

\n}; print qq{\n}; exit; } # Add Audit record. my %audit; $audit{userid} = $ENV{REMOTE_USER}; $audit{ipaddr} = $ENV{REMOTE_ADDR}; $audit{scriptname} = $self; $audit{tablename} = 'transfer'; $audit{tableid} = $id; $audit{startval} = $tref; $audit{endval} = \%arr; addAudit( \%audit, $dbh ); # Insert Student Record into WD student table foreach my $studfld ( @student ){ $studfld = $dbh->quote( $studfld ); } $student[0] = $sql{default}; # reset the studid/id to NULL. my $studentstr = join(', ', @student); $sth = $dbh->prepare("insert into studentwd values ( $studentstr )"); $sth->execute; if ( $DBI::errstr) { print qq{

$lex{Insert} $lex{Student} $lex{Error}:}; print qq{$lex{Contact} $adminname }; print qq{[ $adminemail
\n}; print qq{$lex{Error}:$DBI::errstr

\n}; die qq{$lex{Error}:$self: $DBI::errstr\n}; } print qq{

$lex{Student} -> $lex{Withdrawn} $lex{Student}

\n}; # Delete Original Student Record from student table $sth = $dbh->prepare("delete from student where studnum = ?"); $sth->execute( $arr{studnum} ); if ( $DBI::errstr) { print qq{

$lex{Delete} $lex{Student} $lex{Error}:}; print qq{$lex{Contact} $adminname }; print qq{[ $adminemail
\n}; print qq{$lex{Error}:$DBI::errstr

\n}; die qq{$lex{Delete} $lex{Student} $lex{Error}:$self: $DBI::errstr\n}; } # Insert a transfer record. # Get student record, now in studentwd #$sth = $dbh->prepare("select * from studentwd where studnum = ?"); #$sth->execute( $arr{studnum} ); #if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } #my $ref = $sth->fetchrow_hashref; # $ref is defined above line ~339 my %stud = %$ref; $sth = $dbh->prepare("insert into transfer ( studnum, date, type, description, exittype, prov, country, lastname, firstname, middlename, birthdate, provnum ) values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )"); $sth->execute( $arr{studnum}, $arr{date}, 'withdraw', $arr{description}, $arr{exittype}, $arr{prov}, $arr{country}, $stud{lastname}, $stud{firstname}, $stud{initial}, $stud{birthdate}, $stud{provnum} ); if ($DBI::errstr) { print qq{

$lex{Insert} $lex{Error}:}; print qq{$lex{Contact} $adminname }; print qq{[ $adminemail
\n}; print qq{$lex{Error}:$DBI::errstr

\n}; die qq{$lex{Insert} $lex{Error}:$self: $DBI::errstr\n}; } print qq{