#!/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. %lex = ( 'Nominal Roll' => 'Nominal Roll', 'Main' => 'Main', 'Unable to open template file:' => 'Unable to open template file:', 'Select' => 'Select', 'Students' => 'Students', 'Homeroom' => 'Homeroom', 'Grade' => 'Grade', 'Blank=All' => 'Blank=All', 'Check' => 'Check', 'Next Page' => 'Next Page', 'Continue' => 'Continue', 'Error' => 'Error', 'Save' => 'Save', 'Record(s) Stored' => 'Record(s) Stored', 'Record Exists' => 'Record Exists', 'Red' => 'Red', 'Withdrawn Students' => 'Withdrawn Students', 'Show' => 'Show', 'Add' => 'Add', 'Withdrawn' => 'Withdrawn', ); use CGI; use DBI; use Data::Password qw(:all); # for password checking... my $self = 'nradd.pl'; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } eval require "../../lib/libmeta.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"; $dbh = DBI->connect($dsn,$user,$password); # Print Page Header my $title = "$lex{Add} $lex{'Nominal Roll'}"; print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n[ $lex{Main} ]}; #foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } print qq{

$title

\n}; if ( not $arr{page} ) { showStartPage(); } elsif ( $arr{page} == 1 ) { delete $arr{page}; selectStudents(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; addEditRecords(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; writeRecords(); } #---------------- 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{\n}; print qq{
$lex{Select} $lex{Students}\n}; print qq{ $lex{'Blank=All'}
$lex{'Check'} $lex{'Next Page'}\n}; print qq{
$lex{'Show'} $lex{'Withdrawn Students'}\n}; print qq{
\n
\n}; print qq{\n}; exit; } # end of showStartPage #---------------- sub selectStudents { #---------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $studtable = 'student'; if ( $arr{showwithdrawn} ) { $studtable = 'studentall'; } my $groupvalue = $arr{groupvalue}; delete $arr{groupvalue}; my $chk; if ( $arr{chk} ) { $chk = 'checked="checked"'; } delete $arr{chk}; my $select; if ( $groupvalue ) { # we're picking a group if ( $arr{groupname} eq 'grade' ) { $select = 'where grade = ?'; } else { $select = 'where homeroom = ?'; } } my $sth = $dbh->prepare("select lastname, firstname, studnum, grade from $studtable $select order by lastname, firstname"); if ( $select ) { $sth->execute( $groupvalue ); } else { $sth->execute; } if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Check if withdrawn; my $sth1 = $dbh->prepare("select count(*) from studentwd where studnum = ?"); # Get Transfer Info my $sth2 = $dbh->prepare("select date, type from transfer where studnum = ? order by date desc"); # Check if record already exists in NR. my $sth3 = $dbh->prepare("select count(*) from student_inac where studnum = ?"); # Form Header print qq{
\n}; print qq{\n}; print qq{
}; print qq{\n}; print qq{\n}; print qq{}; while ( my ( $lastname, $firstname, $studnum, $grade ) = $sth->fetchrow ) { my ($wd, $transfer); $sth1->execute( $studnum ); # check if withdrawn. if ( $DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $count = $sth1->fetchrow; if ( $count ) { # if withdrawn $wd = qq{WD}; } # Get Latest Transfer record. $sth2->execute( $studnum ); if ( $DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ($date,$type) = $sth2->fetchrow; if ( $type ) { $transfer = "$type ($date)"; } else { $transfer = "Not Found"; } # Check if record already exists in NR table $sth3->execute( $studnum ); if ( $DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $nrcount = $sth3->fetchrow; print qq{\n}; } print qq{
StudentGradeTransfer
NR = Nominal Roll Record Exists
}; if ( $nrcount ) { print qq{NR }; } else { print qq{ }; } print qq{$wd $lastname, $firstname ($studnum)$grade$transfer
\n}; print qq{
}; print qq{
\n}; exit; } # end of selectStudents #----------------- sub addEditRecords { #----------------- #foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # all of %arr will contain student numbers. # 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"; } my $formtext; { local $/; $formtext = ; close FH;} # 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 = ?"); 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; } # Prepare Withdrawn Check my $sth2 = $dbh->prepare("select count(*) from studentwd where studnum = ?"); # print top of form print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
$lex{Red}=$lex{Withdrawn}
\n}; # Prepare to get record values. $sth = $dbh->prepare("select * from student_inac where studnum = ?"); # now show students in name order. foreach my $key ( sort keys %sortedStudents ) { my $studnum = $sortedStudents{ $key }; my $text = $formtext; # formtext contains original form. # Get name; $sth1 defined above. $sth1->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname ) = $sth1->fetchrow; # Check if withdrawn; if so, show red. my $color; $sth2->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $count = $sth2->fetchrow; if ( $count > 0 ) { $color = q{color:red;}; } my $name = qq{$firstname $lastname ($studnum)}; $text =~ s/\<\@studnum\@\>/$name/; # Get their record, if any. my $hasrecord; # flag to indicate if record already exists. $sth->execute( $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $recref = $sth->fetchrow_hashref; if ( $recref ) { $hasrecord = 1; } 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; print qq{
\n}; if ( $hasrecord ) { print qq{
$lex{'Record Exists'}
\n}; } print $text,"\n"; print qq{
\n}; } print qq{\n}; print qq{
\n}; } #--------------- sub writeRecords { #--------------- #foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $currstudnum = -1; my $prevstudnum; my $sth = $dbh->prepare("select id from student_inac where studnum = ?"); my $sth1 = $dbh->prepare("insert into student_inac (studnum) values (?)"); foreach my $key ( sort keys %arr ) { my ( $studnum, $fieldid ) = split(/:/, $key); $prevstudnum = $currstudnum; $currstudnum = $studnum; my $id; if ( $currstudnum != $prevstudnum ) { # We need to check for a record and create one if not... $sth->execute( $currstudnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } $id = $sth->fetchrow; if ( not $id ) { # create a new record; $sth1->execute( $currstudnum ); # create the record if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } } my $sth2 = $dbh->prepare("update student_inac set $fieldid = ? where studnum = ?"); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } if ( defined $arr{$key} ) { $sth2->execute( $arr{$key}, $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } else { # no value for field. $sth2->execute( NULL, $studnum ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } } } print qq{

$lex{'Record(s) Stored'}

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