#!/usr/bin/perl # Copyright 2001-2019 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 = ('Edit' => 'Edit', 'Nominal Roll' => 'Nominal Roll', 'Main' => 'Main', 'Delete' => 'Delete', 'Error' => 'Error', 'Student' => 'Student', 'Grade' => 'Grade', 'Select' => 'Select', 'Unable to open template file:' => 'Unable to open template file:', 'Record(s)' => 'Record(s)', 'Updated' => 'Updated', 'Continue' => 'Continue', 'All' => 'All', 'Fields' => 'Fields', 'Students' => 'Students', 'Homeroom' => 'Homeroom', 'Check' => 'Check', 'Next Page' => 'Next Page', 'Blank=All' => 'Blank=All', 'Name' => 'Name', 'Moved' => 'Moved', 'Not Found' => 'Not Found', 'Record' => 'Record', 'Group' => 'Group', 'Save' => 'Save', ); use DBI; use CGI; my $self = 'nrdeled.pl'; $nrtable = 'student_inac'; eval require "../../etc/admin.conf"; 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); $dbh->{mysql_enable_utf8} = 1; # Print Page Header my $title = "$lex{Edit}/$lex{Delete} $lex{'Nominal Roll'} $lex{'Record(s)'}"; print qq{$doctype\n$title\n}; print qq{ $chartype\n\n}; print qq{[ $lex{Main} ]\n}; print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectStudents(); } elsif ( $arr{page} == 2 and $arr{type} eq $lex{Edit} ) { delete $arr{page}; delete $arr{type}; editStudents(); } elsif ( $arr{page} == 2 and $arr{type} eq $lex{Delete} ) { delete $arr{page}; delete $arr{type}; confirmDelete(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; deleteRecords(); } elsif ( $arr{page} == 4 ) { delete $arr{page}; updateRecords(); } #---------------- sub showStartPage { # Entry Values for Custom Script #---------------- # Read student inac fields, and defaults into fields and %fieldname hash. my $sth = $dbh->prepare("select fieldid, fieldname from meta where tableid = 'student_inac' order by fieldname"); $sth->execute; my (%fieldnames, @fields); while ( ( my $fieldid, $fieldname ) = $sth->fetchrow ) { if ( $fieldid eq 'id' ) { next; } # skip id field. $fieldname =~ s/\(//g; $fieldname =~ s/\)//g; # strip parentheses. (sp?) push @fields, $fieldid; $fieldname{ $fieldid } = $fieldname; } print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Select Students print qq{\n}; # Select Fields. print qq{\n}; # Check Next Page print qq{\n}; # Continue print qq{\n}; print qq{
$lex{Select} $lex{Students}}; print qq{\n}; print qq{ $lex{'Blank=All'}
$lex{Select} $lex{Fields}}; print qq{
$lex{Check} $lex{'Next Page'}}; print qq{
\n}; exit; } #--------------- sub selectStudents { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # values passed: check, field, grouptype, groupvalue, my $select; my (@grp, @students, %studrec ); my $checked; if ( $arr{check} ) { $checked = q{checked="checked"}; } # Load Meta Values for Service Provision. my $sth = $dbh->prepare("select defaultvalue from meta where tableid = 'student_inac' and fieldid = 'serviceprovision'"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $sp = $sth->fetchrow; $sp =~ s/\s*$//; # remove trailing spaces my %metasp = split /\s+/, $sp; foreach my $key ( sort keys %metasp ) { $metasp{$key} =~ s/_/ /g; # print qq{K:$key V:$metasp{$key}
\n}; } if ( $arr{groupvalue} ) { my $grp = 'grade'; if ( $arr{grouptype} eq 'homeroom' ) { $grp = 'homeroom'; } # Check Value my $sth = $dbh->prepare("select distinct $grp from student where $grp != '' and $grp is not NULL"); $sth->execute; my %group = (); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $val = $sth->fetchrow ) { $group{$val} = 1; } if ( not $group{ $arr{groupvalue}} ) { print qq{

$lex{Group} $lex{'Not Found'}

\n}; print qq{\n}; exit; } # Get Student Numbers my $sth = $dbh->prepare("select studnum from student where $grp = ? order by lastname, firstname"); $sth->execute( $arr{groupvalue} ); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $studnum = $sth->fetchrow ) { push @students, $studnum; } } else { # all records in nominal roll table my %students; my $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); my $sth = $dbh->prepare("select studnum from $nrtable order by studnum"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $studnum = $sth->fetchrow ) { $sth1->execute( $studnum); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname ) = $sth1->fetchrow; $students{"$lastname$firstname$studnum"} = $studnum; } foreach my $key ( sort keys %students ) { push @students, $students{$key}; } } # Select Students # Form Start print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
}; print qq{
\n}; # Table Start print qq{\n}; print qq{}; print qq{\n}; # Get Name my $sth1 = $dbh->prepare("select lastname, firstname, grade, homeroom from studentall where studnum = ?"); my $sth2 = $dbh->prepare("select count(*) from $nrtable where studnum = ?"); my $sth3 = $dbh->prepare("select count(*) from studentwd where studnum = ?"); my $sth4 = $dbh->prepare("select type,date from transfer where studnum = ? order by date desc"); my $sth5 = $dbh->prepare("select serviceprovision from $nrtable where studnum = ?"); my $count = 1; foreach my $studnum ( @students ) { $sth1->execute($studnum); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname, $grade, $homeroom ) = $sth1->fetchrow; # Check for NR record $sth2->execute($studnum); if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $nrcount = $sth2->fetchrow; # Check if withdrawn. my $wd; $sth3->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $wdcount = $sth3->fetchrow; if ( $wdcount ) { $wd = qq{WD\n}; } # Service Provision (current or last year) $sth5->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $serviceprovision = $sth5->fetchrow; # Get Transfers (Enrol/Withdraw) my (@transfers, $transfers); $sth4->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my ($type,$date) = $sth4->fetchrow ) { push @transfers, "$type - $date"; } my $transfers = join('
', @transfers[0..1]); if ( $nrcount > 0 ) { print qq{\n}; } else { print qq{\n}; } print qq{}; print qq{}; print qq{\n}; $count++; } print qq{
$lex{Select}$lex{Student}$lex{Grade}/
$lex{Homeroom}		Tranfers
Enrol/Withdraw		Service
Provision
$lex{Record} $lex{'Not Found'}$count. $wd $lastname, $firstname ($studnum)$grade/$homeroom$transfers$metasp{$serviceprovision}
\n}; print qq{
}; print qq{
\n}; print qq{
\n}; print qq{\n}; } # end of selectStudents #--------------- sub editStudents { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $field = $arr{field}; delete $arr{field}; my $formtext; if ( $field eq 'all' ) { # Read in Template unless (open (FH,"<../../template/inac.tpl")) { print $lex{'Unable to open template file:'},"$!\n"; die $lex{'Unable to open template file:'},"$!\n"; } { local $/; $formtext = ; close FH;} } else { # dynamically create the form for the fields of interest #$formtext = "\n"; $formtext = q{}; #"; $formtext .= q{\n"; # $formtext .= "
<@studnum@>}; #$formtext .= q{<*}. $field. q{*><@}. $field. '@>'. "

\n"; } # print qq{Formtext:$formtext
\n}; # Read in meta library eval require "../../lib/libmeta.pl"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } # Create hash for fieldnames from meta. my $sth = $dbh->prepare("select fieldid, fieldname from meta where tableid = ?"); $sth->execute( 'student_inac' ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my %fieldnames = (); while ( my ( $fieldid, $fieldname ) = $sth->fetchrow ) { $fieldnames{$fieldid} = $fieldname; } #foreach my $key ( sort keys %fieldnames ) { print qq{K:$key V:$fieldnames{$key}
\n}; } # Now put replacement text back in. $formtext =~ s{\<\*(.*?)\*\>} { exists( $fieldnames{$1} ) ? $fieldnames{$1} : $1 }gsex; # Formtext is now ready for multiple use; only contains <@fieldid@> values. # now parse for form entry replacement elements <@name@> # Extract fields from template my @fields = (); while ( $formtext =~ m/\<\@(.*?)\@\>/g){ push @fields, $1; } # Create Sorted Array - by Name. $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); $sth2 = $dbh->prepare("select count(*) from studentwd where studnum = ?"); my %sortedStudents = (); foreach my $studnum ( keys %arr ) { $sth1->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname ) = $sth1->fetchrow; $sortedStudents{"$lastname$firstname$studnum"} = $studnum; } # print top of form print qq{
\n}; print qq{\n}; print qq{\n}; # Prepare to get record values. $sth = $dbh->prepare("select * from student_inac where studnum = ?"); # If not all fields, start a table. if ( $field ne 'all' ) { # we're creating a table print qq{\n}; print qq{\n}; } # now show students in name order. foreach my $key ( sort keys %sortedStudents ) { my $studnum = $sortedStudents{ $key }; my $text = $formtext; # formtext contains original form. # Check if withdrawn. my $wd; $sth2->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $wdcount = $sth2->fetchrow; if ( $wdcount ) { $wd = qq{WD\n}; } # Now get name; $sth1 defined above. $sth1->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname ) = $sth1->fetchrow; my $name = qq{$firstname $lastname ($studnum)}; $text =~ s/\<\@studnum\@\>/$name $wd/; # Get their record, if any. $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $recref = $sth->fetchrow_hashref; my %fieldvals = %{ $recref }; # get replacement values for fields foreach my $fieldid ( @fields ) { $values{$fieldid} = metaInputField('student_inac', $fieldid, $fieldvals{$fieldid}, $dbh, $studnum ); } # now put field values back into $text variable... $text =~ s{ \<\@(.*?)\@\> } { exists($values{$1}) ? $values{$1} : "$values{$1}-$1" }gsex; if ( $field eq 'all' ) { print qq{
\n}; print qq{$text\n
\n}; } else { print qq{$text\n}; } } if ( $field ne 'all' ) { # we're creating a table print qq{
$lex{Name}$fieldnames{$field}
\n}; } print qq{\n}; print qq{
\n}; exit; } #---------------- sub updateRecords { #---------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $sth1 = $dbh->prepare("select count(*) from student_inac where studnum = ?"); foreach my $key ( sort keys %arr ) { my ( $studnum, $fieldid ) = split(/:/, $key); # Check for existing record $sth1->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth1->fetchrow; if ( not $count ) { # Error! print qq{
$lex{Error}: No Nominal Roll record for: $studnum
\n}; next; } # Update Record if ( $arr{$key} ) { # if we have a value my $sth = $dbh->prepare("update student_inac set $fieldid = ? where studnum = ?"); $sth->execute( $arr{$key}, $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } else { # no value for field; set to NULL my $sth = $dbh->prepare("update student_inac set $fieldid = NULL where studnum = ?"); $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } } print qq{

$lex{'Record(s)'} $lex{Updated}

\n}; print qq{

$lex{Edit}/$lex{Delete} $lex{'Nominal Roll'}}; print qq{ | $lex{Main} ]

\n}; print qq{\n}; exit; } #---------------- sub confirmDelete { #---------------- delete $arr{field}; # not useful, here, only for edit updates # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $sth = $dbh->prepare("select lastname, firstname, grade from studentall where studnum = ?"); my $sth1 = $dbh->prepare("select count(*) from student where studnum = ?"); print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; foreach my $studnum ( sort keys %arr ) { $sth->execute( $studnum ); my ( $lastname, $firstname, $grade ) = $sth->fetchrow; # Check for current student $sth1->execute( $studnum ); my $scount = $sth1->fetchrow; print qq{\n}; if ( $scount ) { # Warn he/she is current, turn off checkbox print qq{\n}; } print qq{\n}; print qq{
\n}; print qq{\n}; print qq{
$lex{Student}$lex{Grade}$lex{Select}
$lastname, $firstname ($studnum)$gradeCurrent Student!}; print qq{ \n}; } else { print qq{\n}; } print qq{
\n}; print qq{\n}; print qq{
\n}; print qq{\n}; exit; } #---------------- sub deleteRecords { #---------------- #foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); my $sth1 = $dbh->prepare("select * from student_inac where studnum = ?"); print qq{\n}; print qq{\n}; foreach my $studnum ( sort keys %arr ) { # print qq{Student: $studnum
\n}; # Get Name $sth->execute( $studnum ); my ( $lastname, $firstname ) = $sth->fetchrow; # print qq{$firstname $lastname
\n}; # Get and Move Record $sth1->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my @rec = $sth1->fetchrow; if ( not @rec ) { #Error! print qq{

$lex{Error}: $lex{Record} $lex{'Not Found'}: $studnum

\n}; next; } $rec[0] = $sql{default}; # reset the id. foreach my $field ( @rec ){ if ( $field ne $sql{default} ) { $field = $dbh->quote( $field ); } } my $recordstring = join(', ', @rec); # Insert New Record my $sth2 = $dbh->prepare("insert into student_nomrollwd values ( $recordstring )"); $sth2->execute; if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } # Delete Original my $sth3 = $dbh->prepare("delete from student_inac where studnum = ?"); $sth3->execute( $studnum ); if ( not $DBI::errstr ) { print qq{\n}; } else { print qq{\n}; } } print qq{
$lex{'Nominal Roll'} $lex{'Record(s)'} $lex{Moved}
$firstname $lastname $lex{'Nominal Roll'} }; print qq{$lex{Record} $lex{'Moved'}
$lex{Error}: $DBI::errstr
\n}; print qq{

[ $lex{Edit}/$lex{Delete} $lex{'Nominal Roll'} $lex{Record}}; print qq{ | $lex{Main} ]

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