#!/usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. # *** Outline *** # Delete Function to permanently remove students which are already # withdrawn and will never be registered in this or other division # schools (ie. graduate, etc) my %lex = ('Main' => 'Main', 'Eoy' => 'Eoy', 'Error' => 'Error', 'Withdrawn Students' => 'Withdrawn Students', 'Demographics' => 'Demographics', 'Discipline' => 'Discipline', 'Attendance' => 'Attendance', 'Report Card' => 'Report Card', 'Records' => 'Records', 'Birthdate' => 'Birthdate', 'Age' => 'Age', 'Transfers' => 'Transfers', 'Delete' => 'Delete', 'Student' => 'Student', 'Contact' => 'Contact', 'Records Deleted' => 'Records Deleted', 'Demographics' => 'Demographics', 'Delete' => 'Delete', 'Password' => 'Password', 'Continue' => 'Continue', 'Audit' => 'Audit', 'Record(s) Stored' => 'Record(s) Stored', ); my $self = 'permdel.pl'; my $pass = 'tansi'; use DBI; use CGI; # Read config variables 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; # 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 $currdate = "$year-$month-$day"; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; # HTML Header my $title = "$lex{Delete} $lex{'Withdrawn Students'}"; print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} |\n}; print qq{$lex{Eoy} ]\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; showStudents(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; deleteRecords(); } #---------------- sub showStartPage { #---------------- print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Password} \n}; print qq{
Select Students Older than \n}; print qq{}; print qq{ years (ie. 22)
AND/OR
Select Students with Last Enrollment Older than Year \n}; print qq{}; print qq{ (ie. 2018)
Delete Enrollment Records \n}; print qq{
\n}; print qq{

\n}; print qq{
\n}; print qq{\n}; exit; } #--------------- sub showStudents { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Age selector my $selectage; if ( $arr{selectage} ) { $selectage = $arr{selectage}; delete $arr{selectage}; } # Year selector my $selectyear; if ( $arr{selectyear} ) { $selectyear = $arr{selectyear}; delete $arr{selectyear}; } # check password; if ( $arr{pass} ne $pass ) { print qq{

$lex{Password} $lex{Error}

\n}; print qq{\n}; exit; } my $sth = $dbh->prepare("select lastname, firstname, initial, studnum, birthdate from studentwd order by birthdate, lastname, firstname"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die "$DBI::errstr : $! \n";} my $sth1 = $dbh->prepare("select date,type from transfer where studnum = ? order by date desc"); print qq{

$lex{Delete} $lex{Demographics}, $lex{Discipline}, $lex{Attendance},}; print qq{ $lex{'Report Card'} $lex{Records}

\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{

\n}; print qq{\n}; print qq{\n}; while ( my ( $lastname, $firstname, $initial, $studnum, $birthdate ) = $sth->fetchrow ) { # Get any enrollment records... my ($transfers, $selectflag); my $first = 1; $sth1->execute( $studnum ); while ( my ($date,$type) = $sth1->fetchrow) { my ($y,$m,$d) = split(':', $date); if ( $first and $y < $selectyear ) { $selectflag = 1; } $first = 0; $transfers .= "$date - $type
\n"; } my ($age,$mo) = split(':', calcAge( $birthdate, $currdate )); print qq{\n}; print qq{\n}; } print qq{
$lex{Student}$lex{Age} (}; print qq{$lex{Birthdate})$lex{Transfers}
\n}; print qq{$lastname, $firstname $initial ( $studnum )$age yr $mo mo ($birthdate)$transfers
\n}; print qq{

\n}; print qq{
}; print qq{\n}; exit; } #---------- sub calcAge { #---------- # Passed (birthdate, $currdate) my ( $birthdate, $currdate ) = @_; my ($byear,$bmonth,$bday) = split('-',$birthdate); my ($cyear,$cmonth,$cday) = split('-',$currdate); my $age = $cyear - $byear; my $month = $cmonth - $bmonth; #print qq{BD: $birthdate CD: $currdate Age: $age MO:$month
\n}; if ($cmonth < $bmonth){ $month = $month + 12; if ($cday < $bday){ $month--;} $age--; } elsif ($cmonth == $bmonth and $cday < $bday){ $age--; $month = 11; } elsif ($cmonth > $bmonth and $cday < $bday) { $month--; } if ( $age < 0 or $age > 100 ) { $age = 0; $month = 0; } return "$age:$month"; } #---------------- sub deleteRecords { #---------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Delete Enrollment/Transfer records? my $deleteenrol; if ( $arr{deleteenrol} ){ $deleteenrol = 1; } delete $arr{deleteenrol}; # Remove Attendance Records my $sth10 = $dbh->prepare("delete from attend where studentid = ?"); # Remove Evaluation Records my $sth11 = $dbh->prepare("delete from eval where studnum = ?"); # Remove Gradebook Scores my $sth12 = $dbh->prepare("delete from gbscore where studnum = ?"); # Remove Transfer Records, if enabled my $sth13 = $dbh->prepare("delete from transfer where studnum = ?"); # Remove Discipline records my $sth2 = $dbh->prepare("select count(*) from disc_ident where eventid = ?"); my $sth3 = $dbh->prepare("select count(*) from disc_action where eventid = ?"); my $sth4 = $dbh->prepare("delete from disc_action where eventid = ? and studnum = ?"); my $sth5 = $dbh->prepare("delete from disc_ident where eventid = ? and studnum = ?"); my $sth6 = $dbh->prepare("delete from disc_event where id = ?"); foreach my $studnum ( keys %arr ) { # Read WD Student record my $sth = $dbh->prepare("select * from studentwd where studnum = ?"); $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $sref = $sth->fetchrow_hashref; # print qq{SREF:$sref
\n}; my %audit; $audit{userid} = $ENV{REMOTE_USER}; $audit{ipaddr} = $ENV{REMOTE_ADDR}; $audit{scriptname} = $self; $audit{tablename} = 'studentwd'; $audit{tableid} = $sref->{studid}; $audit{startval} = $sref; # $audit{endval} = ''; # blank. addAudit( \%audit, $dbh ); # Remove WD Student record my $sth = $dbh->prepare("delete from studentwd where studnum = ?"); $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Loop over each event id and remove identid and eventid (if only the one) my $sth1 = $dbh->prepare("select distinct id from disc_event where studnum = ?"); $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } while ( my $eventid = $sth->fetchrow ) { # Delete action records for this student to that event. $sth4->execute( $eventid, $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Delete Ident record for this student to that event. $sth5->execute( $eventid, $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Count links to event record now (ie are there other students?) $sth2->execute( $eventid); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $identcount = $sth2->fetchrow; $sth3->execute( $eventid); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $actioncount = $sth3->fetchrow; if ( not $identcount and not $actioncount ) { # no other links, remove record. $sth6->execute( $eventid); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } } } # Remove Attendance Records $sth10->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Remove Evaluation Records $sth11->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Remove Gradebook Scores $sth12->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Remove Transfer Records, if enabled if ( $deleteenrol ) { $sth13->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } } } if ( not $DBI::errstr ) { print qq{

$lex{'Records Deleted'}
$lex{Audit} $lex{'Record(s) Stored'}

\n}; } else { print qq{

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

\n}; } print qq{

[ $lex{Eoy} ]

\n}; print qq{\n}; exit; } # end of deleteRecords