#!/usr/bin/perl
# Copyright Les Richardson 2001-2019
my %lex = ('Homeroom Assignment' => 'Homeroom Assignment',
'Update Homerooms' => 'Update Homerooms',
'Student' => 'Student',
'HRm' => 'HRm',
'Teacher' => 'Teacher',
'Not Found' => 'Not Found',
'Grade' => 'Grade',
'Main' => 'Main',
'Eoy' => 'Eoy',
'Contact' => 'Contact',
'Error' => 'Error',
'Record(s) Updated' => 'Record(s) Updated',
);
my $self = 'resethroom.pl';
use DBI;
use CGI;
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);
# Start Page Head
my $title = $lex{'Homeroom Assignment'};
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};
# update records if necessary.
if ( $arr{flag} ) {
delete $arr{flag};
resetRecords();
}
# Read teachers into a data structure
my $sth = $dbh->prepare("select lastname, firstname, userid
from staff order by lastname, firstname");
$sth->execute;
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
# Clone Query Functions.
my $sth1 = $dbh->prepare("select sm.field_value from staff as s, staff_multi as sm
where sm.userid = s.userid and sm.field_name = ? and s.userid = ?");
my $sth2 = $dbh->prepare("select sm.field_value from staff as s, staff_multi as sm
where sm.userid = s.userid and sm.field_name = ? and s.userid = ?");
# Put Teachers into Data Struct
while ( my ( $lastname, $firstname, $userid ) = $sth->fetchrow ){
$sth1->execute( 'grade', $userid );
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my $grade = $sth1->fetchrow ) {
$sth2->execute( 'homeroom', $userid );
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
while ( my $homeroom = $sth2->fetchrow ) {
if ( not $homeroom{ $grade } ) {
$homeroom{ $grade } = { }; # hash constructor
}
if ( not $homeroom{$grade}->{$homeroom} ) {
$homeroom{$grade}->{$homeroom} = [ ]; # array constructor
}
push @{ $homeroom{$grade}->{$homeroom} }, "$firstname $lastname";
}
}
}
# Now test construction
#foreach my $grade ( sort keys %homeroom ) {
# foreach my $hrm (sort keys %{ $homeroom{$grade} } ) {
# foreach my $name ( @{ $homeroom{$grade}->{$hrm} } ){
# print qq{Name: $name Hr:$hrm Gr:$grade
\n};
# }
# }
#}
my $sth = $dbh->prepare("select distinct grade from student
order by grade, lastname, firstname");
$sth->execute;
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
my $ref = $sth->fetchall_hashref(grade);
if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }
my @grades = sort {$a <=> $b} keys %$ref;
$sth = $dbh->prepare("select studid, lastname, firstname, homeroom from student
where grade = ? order by lastname, firstname");
print qq{\n};
#---------------
sub resetRecords {
#---------------
#foreach my $key ( keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; }
my $sth = $dbh->prepare("update student set homeroom = ? where studid = ?");
foreach my $key ( keys %arr ) {
my ($rmnum, $teacher) = split(/:/,$arr{$key});
$rmnum =~ s/://;
if ( not $teacher ) { $rmnum = undef; }
$sth->execute( $rmnum, $key );
if ($DBI::errstr ) { print $DBI::errstr; }
}
if ( not $DBI::errstr ) {
print qq{$lex{'Record(s) Updated'}
};
} else {
print qq{$lex{Error}: $DBI::errstr
\n};
print qq{$lex{Contact} $adminname };
print qq{$adminemail
\n};
}
print qq{[ $lex{Main} |};
print qq{$lex{Eoy} ]