#!/usr/bin/perl # Copyright 2001-2018 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 = ('Family List' => 'Family List', 'Main' => 'Main', 'Family' => 'Family', 'Name' => 'Name', 'Homeroom' => 'Homeroom', 'Grade' => 'Grade', 'Error' => 'Error', 'SE = Special Ed' => 'SE = Special Ed', 'SE' => 'SE', 'Students Without Phones' => 'Students Without Phones', 'Students With Phones' => 'Students With Phones', 'Sorted by Family Size & Name' => 'Sorted by Family Size & Name', ); my $self = 'rptfamily.pl'; use DBI; use CGI; use Cwd; # Read config variables eval require "../etc/admin.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++; $wday++; my $currdate = "$dow[$wday], $month[$mon] $mday, $year"; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); $dbh->{mysql_enable_utf8} = 1; #--- Now do the IEP Database ------- my $schooldbase = $dbase; # just in case... # don't move this up... eval require "$iepdir/cgi/ppp.conf" || die "Cannot read the ppp.conf file!"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } $dsniep = "DBI:$dbtype:dbname=$dbase"; $dbhiep = DBI->connect($dsniep,$user,$password); # use to find if student is in special ed. my $sthiep = $dbhiep->prepare("select count(*) from special where studnum = ?"); if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } #-------------- # Find all homephone1 groups. my $sth = $dbh->prepare("select distinct hphone1 from student where hphone1 != '' and hphone1 is not null"); $sth->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } my @phones; while ( my $hphone = $sth->fetchrow ) { push @phones, $hphone; } # Find all blank/null hphone1 students. $sth = $dbh->prepare("select studnum from student where hphone1 = '' or hphone1 is null order by grade, homeroom,lastname, firstname"); $sth->execute; if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } my @nophone; while ( my $sn = $sth->fetchrow ) { push @nophone, $sn; } # Now get family groupings by hphone1 # family groupings are in %family hash with {hphone1} -> @studnum array. my (@family, @familysize,%familyname); $sth = $dbh->prepare("select lastname, firstname, studnum, contact from student where hphone1 = ? order by lastname, firstname"); foreach my $phone ( @phones ) { $sth->execute( $phone ); if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } my ($famname, $prevname); while ( my ( $lastname, $firstname, $studnum, $contact ) = $sth->fetchrow ) { $prevname = $lastname; if ( index($contact,$lastname) != -1 ) { # if lastname in contact name $famname = $lastname; } if ( @{$family{$phone}} ) { push @{$family{$phone}}, $studnum; } else { $family{$phone} = [ $studnum ]; } } if ( not $famname ) { $famname = $prevname; } # last chance bailout to get famname my $famsize = $#{$family{$phone}}; if ( not defined $familysize[$famsize] ) { $familysize[$famsize] = { }; } $familysize[$famsize]->{"$famname:$phone"} = $phone; $familyname{$phone} = $famname; } my $title = $lex{'Family List'}; # print page head print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Main} ]\n}; print qq{ $currdate ($lex{'SE = Special Ed'})\n}; print qq{

$title

\n}; print qq{

$lex{'Sorted by Family Size & Name'}

\n}; # No Phone List if ( @nophone ) { print qq{

$lex{'Students Without Phones'}

\n}; print qq{\n}; print qq{}; print qq{\n}; my $sth = $dbh->prepare("select lastname, firstname, homeroom, grade from student where studnum = ?"); for my $studnum ( @nophone ) { $sth->execute( $studnum ); if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname, $homeroom, $grade ) = $sth->fetchrow; print qq{\n}; print qq{\n}; } print qq{
$lex{Family}$lex{Name}$lex{Homeroom}$lex{Grade}
$firstname $lastname ($studnum)$homeroom$grade
\n}; print qq{

$lex{'Students With Phones'}

\n}; } print qq{\n}; print qq{}; print qq{\n}; my $sth = $dbh->prepare("select lastname, firstname, homeroom, grade from student where studnum = ?"); while ( my $familyHashRef = pop( @familysize ) ) { foreach my $key (sort keys %{ $familyHashRef } ) { my $phone = $familyHashRef->{$key}; print qq{\n}; foreach my $studnum ( @{ $family{$phone} } ) { $sth->execute($studnum); if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname, $homeroom, $grade ) = $sth->fetchrow; # Set $se for Special Ed. $sthiep->execute( $studnum ); # Is child in Special Ed? if ($DBI::errstr) {print $DBI::errstr; die $DBI::errstr; } my $iepcount = $sthiep->fetchrow; my $se; if ( $iepcount > 0 ) { $se = '*'. $lex{SE}. '*'; } print qq{\n}; print qq{\n}; } } } print qq{
$lex{Family}$lex{Name}$lex{Homeroom}$lex{Grade}
$familyname{$phone} - $phone
$se$firstname $lastname ($studnum)$homeroom$grade
\n};