#!/usr/bin/perl
# Copyright 2001-2022 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 = ( 'Student #' => 'Student #',
'Associate Pictures and Students' => 'Associate Pictures and Students',
'Associate' => 'Associate',
'No Pictures Found' => 'No Pictures Found',
'No Student(s) Found' => 'No Student(s) Found',
'Main' => 'Main',
'Export' => 'Export',
'Error' => 'Error',
'Delete Failed' => 'Delete Failed',
'File already exists' => 'File already exists',
'Deleted' => 'Deleted',
'Renaming' => 'Renaming',
);
use CGI;
use DBI;
my $tempimage = "temp$$.jpg";
my $self = 'associate.pl';
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
eval require "../../etc/image.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my $q = new CGI;
my %arr= $q->Vars;
print $q->header( -charset, $charset );
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $iddst) =
localtime(time);
$year = $year + 1900;
$mon++;
my $currdate = "$year-$mon-$mday";
$year = $year - 2; # go back 2 years to find withdrawn students for association in withdrawn
my $startdate = "$year-$mon-$mday";
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
my $title = $lex{'Associate Pictures and Students'};
print qq{$doctype\n$title\n};
print qq{\n};
print qq{\n};
print qq{$chartype\n\n};
print qq{[ $lex{Main} | \n};
print qq{$lex{Export} ]\n};
print qq{
$title
\n};
if ( $arr{associateflag} ) {
delete $arr{associateflag};
associate(); # do associate function.
}
# Read Files in bigpic folder
my $largemode = '1';
opendir (DH,"$picdir") || die "Cannot open $picdir directory!\n";
my @files = grep !/^\./, readdir DH;
close DH;
if ( not @files ) { # Try the Thumbnail folder instead.
opendir (DH,"$tndir") || die "Cannot open $tndir directory!\n";
@files = grep !/^\./, readdir DH;
close DH;
$largemode = 0;
}
if ( not @files ) { # Still no files... fail.
print qq{
$lex{'No Pictures Found'}
\n};
exit;
}
# Now find those files with and without numeric value. Numerics values
# are student numbers and those that are still text need to be
# associated. The files become numeric and the pic field gets set to 'Y'.
my (@doneFiles, @undoneFiles, @doneStudents); # undone still are text; done are studentnumber.jpg.
foreach my $file ( @files ) {
my ($fn,$ext) = split /\./,$file;
if ( $fn =~ m/\d+/ ) { # match one or more digits
push @doneFiles, $file;
push @doneStudents, $fn;
} else {
push @undoneFiles, $file;
}
}
# Verify all DONE files that we have the 'pic' field set.
my $sth = $dbh->prepare("select studid, pic from student where studnum = ?");
my $sth1 = $dbh->prepare("select studid, pic from studentwd where studnum = ?");
my $sth2 = $dbh->prepare("update student set pic = 'Y' where studid = ?");
my $sth3 = $dbh->prepare("update studentwd set pic = 'Y' where studid = ?");
my $verifyflag = 1;
foreach my $studnum ( @doneStudents ) { # matches @doneFiles
$sth->execute($studnum);
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
my ($studid, $pic) = $sth->fetchrow;
if ( not $studid ) { # must be in withdrawn student table.
$sth1->execute($studnum);
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
my ($studid, $pic) = $sth1->fetchrow;
if ( not $studid ) {
print qq{
Student not found for $studnum
\n};
next;
} else { # we have a studid value
if ( not $pic ) { # we must set pic field in wd student table.
$sth3->execute($studid);
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
$verifyflag = 0;
print qq{
Picture field set in withdrawn student table: $studnum
\n};
} # otherwise ok.
}
} else { #studid in the main student table.
if ( not $pic ) { # we must set pic field in wd student table.
$sth2->execute($studid);
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
print qq{
Picture field set in student table: $studnum
\n};
$verifyflag = 0;
} # otherwise ok.
}
}
if ( $verifyflag ) { #
print qq{
All associated student pictures have a matched pic field. All OK
\n};
}
# Populate Hash with student numbers, studentname for students w/o pic field set
my (%studnum, %studname);
my $sth = $dbh->prepare("select lastname, firstname, studnum from student where pic != 'Y'");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
while ( my ( $lastname, $firstname, $studnum ) = $sth->fetchrow ){
$lastname = lc $lastname;
$firstname = lc $firstname;
$studname{"$firstname$lastname"} = $studnum;
$studnum{$studnum} = '1';
# print qq{
$firstname $lastname $studnum
\n};
}
# now do withdrawn students in this school year.
my $sth = $dbh->prepare("select s.lastname, s.firstname, s.studnum from studentwd s, transfer t
where t.studnum = s.studnum and t.type = 'withdraw' and
to_days(date) > to_days('$startdate')");
$sth->execute;
if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;}
while ( my ( $lastname, $firstname, $studnum ) = $sth->fetchrow ){
$lastname = lc $lastname;
$firstname = lc $firstname;
$studname{"$firstname$lastname"} = $studnum;
$studnum{$studnum} = '1';
# print qq{
\n};
#}
# These are the lookup values to match a massaged name key to a studnum value
#foreach my $key ( sort keys %studname ) {
# print qq{
K:$key VAL:$studname{$key}
\n};
#}
=head
# Go through @files (pictures) and remove those that exist in student
# hash (ie. already associated.)
my @newfiles;
foreach my $file ( @files ) {
my ($fn,$ext) = split /\./,$file;
if ( not $studnum{$fn} ){ # if NOT already associated...
push @newfiles, $file;
# print qq{
NEW:$file
\n};
}
}
=cut
@files = @undoneFiles;
if ( not @files ) {
print qq{