#!/usr/bin/perl
# Copyright 2001-2024 Leslie Richardson
use DBI;
use CGI;
use Number::Format qw(:all);
use Cwd;
my %lex = ('Select' => 'Select',
'Lastname, Firstname' => 'Lastname, Firstname',
'Homeroom, Lastname, Firstname' => 'Homeroom, Lastname, Firstname',
'Grade, Lastname, Firstname' => 'Grade, Lastname, Firstname',
'Sort by' => 'Sort by',
'Grade' => 'Grade',
'Homeroom' => 'Homeroom',
'Continue' => 'Continue',
'Error' => 'Error',
'Separate with Spaces' => 'Separate with Spaces',
'Parent' => 'Parent',
'Student' => 'Student',
'Email' => 'Email',
'Next Page' => 'Next Page',
'Check' => 'Check',
);
my $self = 'rptemail.pl';
# Get current dir so know what path for config files.
my $teachermode;
if ( getcwd() =~ /tcgi/ ){ # we are in tcgi
$teachermode = 1;
}
eval require "../etc/admin.conf.root";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my $dbtype = 'mysql';
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
# Load configuration values of interest
my $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?");
foreach my $dv ('doctype','css','homepage','tchcss','tchpage','charset') {
$sth->execute($dv);
my $datavalue = $sth->fetchrow;
eval $datavalue;
if ( $@ ) {
print "Error: $@ \n";
die "Error: $@\n";
}
}
my $q = new CGI;
print $q->header( -charset, $charset );
my %arr = $q->Vars;
if ( $teachermode ) { # running on teacher site
$css = $tchcss;
$homepage = $tchpage;
}
# Page Header.
my $title = "Email Parents/Students";
print "$doctype\n$title\n";
print qq{\n};
print qq{\n};
print qq{[ Main ]\n};
print qq{
$title
\n};
if ( not $arr{page} ) {
showStartPage();
} elsif ( $arr{page} == 1 ) {
delete $arr{page};
selectRecipients();
} elsif ( $arr{page} == 2 ) {
delete $arr{page};
showReport();
}
#-------------------
sub selectRecipients { # Choose students/parents to email to and put in message
#-------------------
# foreach my $key (keys %arr) { print qq{K:$key V:$arr{$key} \n}; }
# passed 3 email selects, checked, and then all groups G: or H:
my $myemail = $arr{myemail};
if ( not $myemail ) {
print qq{
Missing Your Email Address
\n};
print qq{\n};
exit;
}
delete $arr{myemail};
my $selStudent = $arr{selStudent};
delete $arr{selStudent};
my $selPar1 = $arr{selPar1};
delete $arr{selPar1};
my $selPar2 = $arr{selPar2};
delete $arr{selPar2};
my $checked;
if ( $arr{checked} ) {
$checked = qq{checked="checked"};
delete $arr{checked};
}
# $checked is already defined at top, if selected in startpage.
# only groups left in %arr now.
my (%sort, %student, @grp);# list of the groups (homeroom or grade)
foreach my $key ( keys %arr ) {
my ($group, $val) = split(':', $key);
push @grp, $val;
my $sth;
if ( $group eq 'G' ) {
$sth = $dbh->prepare("select lastname, firstname, studnum, grade, homeroom,
email, par1_email, par2_email from student where grade = ?");
$sth->execute( $val );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
} else { # homeroom
$sth = $dbh->prepare("select lastname, firstname, studnum, grade, homeroom,
email, par1_email, par2_email from student where homeroom = ?");
$sth->execute( $val );
if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; }
}
# Loop through the students
while ( my $ref = $sth->fetchrow_hashref ) {
my %r = %$ref;
$sort{"$r{lastname}$r{firstname}$r{studnum}"} = $r{studnum};
$student{$r{studnum}} = $ref;
}
}
my $desc = join(',', sort @grp);
print qq{
Student Group $desc
\n};
# Setup the form and start of table.
print qq{