#! /usr/bin/perl # Copyright 2001-2020 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 = ('Main' => 'Main', 'No Student(s) Found' => 'No Student(s) Found', 'Parent' => 'Parent', 'Access Control' => 'Access Control', 'Continue' => 'Continue', 'Homeroom' => 'Homeroom', 'Grade' => 'Grade', 'Blank=All' => 'Blank=All', 'Students' => 'Students', 'Select by' => 'Select by', 'Not Found' => 'Not Found', 'Error' => 'Error', 'Single Value Only' => 'Single Value Only', 'Check' => 'Check', 'Next Page' => 'Next Page', 'Report Card' => 'Report Card', 'Gradebook' => 'Gradebook', 'Disable' => 'Disable', 'Student' => 'Student', 'Lockout' => 'Lockout', 'Save' => 'Save', 'Records' => 'Records', 'Updated' => 'Updated', ); my $self = 'setlockout.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); my $title = "$lex{Parent} $lex{'Access Control'}"; print qq{$doctype\n$title\n}; print qq{\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}; showStudents(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; setLockout(); } #--------------- sub showStudents { #--------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # passed either grade or homeroom my @students; my %students; if ( $arr{grade} ) { $sth = $dbh->prepare("select lastname, firstname, studnum, parent_lockout from student where grade = ? order by lastname, firstname"); $sth->execute( $arr{grade} ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my ( $lastname, $firstname, $studnum, $lockout ) = $sth->fetchrow ) { push @students, $studnum; $students{$studnum} = { 'lastname' => $lastname, 'firstname' => $firstname, 'lockout' => $lockout }; } } elsif ( $arr{homeroom} ) { # homeroom my $sth = $dbh->prepare("select lastname, firstname, studnum, parent_lockout from student where homeroom = ? order by lastname, firstname"); $sth->execute( $arr{homeroom} ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my ($lastname, $firstname, $studnum, $lockout ) = $sth->fetchrow ) { push @students, $studnum; $students{$studnum} = { lastname => $lastname, firstname => $firstname, lockout => $lockout }; } } else { # all students $sth = $dbh->prepare("select lastname, firstname, studnum, parent_lockout from student order by lastname, firstname"); $sth->execute; if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my ($lastname, $firstname, $studnum, $lockout ) = $sth->fetchrow ) { push @students, $studnum; $students{$studnum} = { lastname => $lastname, firstname => $firstname, lockout => $lockout }; } } # Start Form print qq{

\n}; print qq{\n}; # Now Display Choices print qq{\n}; print qq{}; print qq{\n}; foreach my $studnum ( @students ) { my @vals = split(//, $students{$studnum}{lockout} ); my ( $rcheck, $gcheck ); foreach my $val ( @vals ) { if ( $val eq 'R' ) { $rcheck = 'checked="checked"';} if ( $val eq 'G' ) { $gcheck = 'checked="checked"';} } print qq{\n\n}; print qq{\n\n}; } print qq{\n}; print qq{

$lex{Student}	$lex{'Report Card'} $lex{Lockout}	$lex{Gradebook} $lex{Lockout}
$students{$studnum}{lastname}, }; print qq{$students{$studnum}{firstname} ($studnum)	}; # for legal html if ( $rcheck ) { print qq{\n}; }; if ( $gcheck ) { print qq{\n}; }; print qq{

\n}; print qq{\n}; exit; } #------------- sub setLockout { #------------- foreach my $key ( sort keys %arr ) { if ( $arr{$key} =~ m/\0/ ) { $arr{$key} = 1; } # Anything showing up will not be hidden by a value in the # field, so this value should be deleted. A 0 means existing key was unchecked. } # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } # Prepare to Update my $sth = $dbh->prepare("update student set parent_lockout = ? where studnum = ?"); my %students; # put in student hash foreach my $key ( keys %arr ) { my ( $type, $studnum ) = split(':', $key); $students{$studnum}{$type} = $arr{$key}; # could be zero or one value } # combine and update foreach my $studnum ( keys %students ) { my %locks = %{ $students{$studnum} }; foreach my $key ( keys %locks ) { if ( not $locks{$key} ) { delete $locks{$key}; } } my $string = join('', sort keys %locks ); # print qq{$studnum - $string
\n}; $sth->execute( $string, $studnum ); if ($DBI::errstr) { print $DBI::errstr; } } if ( $DBI::errstr ) { print qq{

$lex{Error}: $DBI::errstr

\n}; } else { print qq{

$lex{Records} $lex{Updated}

\n}; } print qq{

[ $lex{Main} | }; print qq{Set More Lockouts ]

\n}; print qq{\n}; exit; } # end of setLockout; #---------------- sub showStartPage { #---------------- # Get the grades my @grades; my $sth = $dbh->prepare("select distinct grade from student where grade is not NULL and grade != ''"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth->fetchrow ) { push @grades, $gr; } @grades = sort {$a <=> $b} @grades; # Get the homerooms. my @homerooms; my $sth = $dbh->prepare("select distinct homeroom from student where homeroom is not NULL and homeroom != ''"); $sth->execute; if ( DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } while ( my $hr = $sth->fetchrow ) { push @homerooms, $hr; } print qq{\n}; exit; }

Select Grade
OR
Select Homeroom
}; print qq{