#!/usr/bin/perl # Copyright 2001-2025 Leslie Richardson # This file is part of Open Admin for Schools. my %lex = ('Main' => 'Main', 'Error' => 'Error', 'Add Reading Tests' => 'Add Reading Tests', 'Student' => 'Student', 'Reading Level' => 'Reading Level', 'Continue' => 'Continue', 'Category' => 'Category', 'Name' => 'Name', 'Save' => 'Save', 'Score' => 'Score', 'Test Date' => 'Test Date', 'Values must be from 1-4' => 'Values must be from 1-4', 'No User Id' => 'No User Id', 'No Password' => 'No Password', 'Please Log In' => 'Please Log In', 'Grade' => 'Grade', 'Homeroom' => 'Homeroom', 'Select' => 'Select', 'Blank=All' => 'Blank=All', 'Check' => 'Check', 'Record Exists' => 'Record Exists', 'Edit Record' => 'Edit Record', 'Required' => 'Required', 'Date and Reading Level' => 'Date and Reading Level', 'Only' => 'Only', 'No Blanks Allowed' => 'No Blanks Allowed', 'Skipping' => 'Skipping', 'Next Page' => 'Next Page', 'Absences' => 'Absences', 'Students' => 'Students', ); use DBI; use CGI; use Cwd; my $self = 'fpAdd.pl'; my $q = new CGI; my %arr = $q->Vars; my @time = localtime(time); my $year = $time[5] + 1900; my $month = $time[4] + 1; my $currdate = "$year-$month-$time[3]"; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $self: $@
\n"; die $lex{Error}. "$self: $@\n"; } my $dbtype = 'mysql'; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); my $userid = $ENV{'REMOTE_USER'}; print $q->header( -charset, $charset ); my $mycss = $css; if ( getcwd() =~ /tcgi/ ){ # we are in cgi $mycss = $tchcss; } # Page Header my $title = qq{Add F&P Reading Tests}; print qq{$doctype\n$title\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\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}; selectStudents(); } elsif ( $arr{page} == 2 ) { delete $arr{page}; enterData(); } elsif ( $arr{page} == 3 ) { delete $arr{page}; writeData(); } #---------------- sub showFPForm { # called by enterData #---------------- my ($studnum, $count) = @_; # Start Table print qq{\n}; # title print qq{}; print qq{\n}; # System: NOTE field is actually tsystem print qq{\n}; # Book type print qq{\n}; # Reading Level print qq{\n}; # Accuracy print qq{\n}; # Comprehension print qq{\n}; # Assistance print qq{\n}; # Self correction print qq{\n}; # Fluency print qq{\n}; # Rate (trate) print qq{\n}; # Write about Reading print qq{\n}; print qq{
$count Title
System 1 or 2
Type
Reading Level
Accuracy
Comprehension
Assistance
Self Correction
Fluency
Rate
Write About Reading
\n\n}; return; } #---------------- sub showStartPage { #---------------- # Get Grades, Homerooms my (%grades, %homerooms); my $sth = $dbh->prepare("select distinct grade from student where grade != '' and grade is not NULL"); $sth->execute; if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } while ( my $gr = $sth->fetchrow ) { $grades{$gr} = 1; } my @grades = sort { $a <=> $b } keys %grades; my $sth = $dbh->prepare("select distinct homeroom from student where homeroom != '' and homeroom is not NULL"); $sth->execute; if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } while ( my $hr = $sth->fetchrow ) { $homerooms{$hr} = 1; } my @homerooms = sort { $a <=> $b } keys %homerooms; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; # Students - Grade print qq{\n}; print qq{\n}; # Select Homeroom my $sth = $dbh->prepare("select lastname, firstname from staff s, staff_multi sm where s.userid = sm.userid and field_name = 'homeroom' and field_value = ?"); print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
Date\n}; print qq{\n}; print qq{(yyyy-mm-dd)
$lex{Select} $lex{Students}
Grade or
Homeroom}; print qq{\n}; print qq{ $lex{'Blank=All'}
$lex{Check} $lex{'Next Page'}\n}; print qq{
\n
\n}; print qq{
\n}; print qq{\n}; print qq{\n}; exit; } # end of showStartPage #---------------- sub selectStudents { #---------------- # foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $chk = $arr{chk}; delete $arr{chk}; # Check for any Blanks in date or reading level foreach my $key ('date') { if ( not $arr{$key} ) { print qq{

$lex{Date} $lex{Required}

\n}; print qq{\n}; exit; } } # Check for messed up Date Format my $errorflag; if ( $arr{date} =~ m/\// ) { # slashes rather than hyphens $errorflag = 1; } else { my ($y,$m,$d) = split('-', $arr{date}); if ( not $m or ( $m < 1 or $m > 12 )) { $errorflag = 1; } if ( not $d or ( $d < 1 or $d > 31 )) { $errorflag = 1; } } if ( $errorflag ) { # print qq{
Year:$y Month:$m Day:$d
\n}; print qq{

$lex{'Test Date'} $lex{Error}: $arr{date}

\n}; print qq{\n}; exit; } my ($sth, $groupname); if ( $arr{grade} ) { # we're picking a group $sth = $dbh->prepare("select lastname, firstname, studnum from student where grade = ? order by lastname, firstname"); $sth->execute( $arr{grade} ); $groupname = qq{Grade $arr{grade}}; } elsif ( $arr{homeroom} ) { $sth = $dbh->prepare("select lastname, firstname, studnum from student where homeroom = ? order by lastname, firstname"); $sth->execute( $arr{homeroom} ); $groupname = qq{Homeroom $arr{homeroom}}; } else { # everyone $sth = $dbh->prepare("select lastname, firstname, studnum from student order by lastname, firstname"); $sth->execute; } if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Form Header print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; while ( my ( $lastname, $firstname, $studnum ) = $sth->fetchrow ) { print qq{\n}; print qq{}; } print qq{
Max # of Books }; print qq{}; print qq{
Summary$groupname
$lastname, $firstname ($studnum)
\n}; print qq{
\n}; print qq{
\n}; exit; } # end of selectStudents #------------ sub enterData { #------------ #foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}
\n"; } my $date = $arr{date}; delete $arr{date}; my $books = $arr{books}; # number of book forms to produce delete $arr{books}; # Now only student numbers left in hash... # Print Form Heading print qq{
\n}; print qq{\n}; print qq{\n}; print qq{
\n}; my $sth = $dbh->prepare("select lastname, firstname, grade from studentall where studnum = ?"); my (%sort, %grade, %name); foreach my $studnum ( keys %arr ) { # Get Student Name $sth->execute( $studnum ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ( $lastname, $firstname, $grade ) = $sth->fetchrow; $sort{"$lastname$firstname$studnum"} = $studnum; $name{$studnum} = qq{$lastname, $firstname}; $grade{$studnum} = $grade; } foreach my $key ( sort keys %sort ) { my $studnum = $sort{$key}; print qq{

$name{$studnum} ($studnum)

\n}; foreach my $count (1..$books) { showFPForm($studnum, $count); } print qq{
\n}; } print qq{
\n}; print qq{
\n}; exit; } #------------ sub writeData { #------------ #foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } my $date = $arr{date}; delete $arr{date}; # also need grade and author my $author = $ENV{'REMOTE_USER'}; # Get Grade my $sth = $dbh->prepare("select lastname, firstname, grade from studentall where studnum = ?"); my %data; foreach my $key ( keys %arr ) { if ( not $arr{$key} ) { next; } # skip if no data my ($studnum, $idx, $field ) = split(':', $key); $data{$studnum}{$idx}{$field} = $arr{$key}; } =head # Test Only foreach my $studnum ( sort keys %data ) { foreach my $idx ( sort keys %{ $data{$studnum}} ) { foreach my $field ( sort keys %{ $data{$studnum}{$idx}} ) { print qq{SN:$studnum / $idx / $field / $data{$studnum}{$idx}{$field}
\n}; } } } =cut foreach my $studnum ( sort keys %data ) { $sth->execute($studnum); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname, $grade) = $sth->fetchrow; # now populate the rest of the arrays. foreach my $idx ( sort keys %{ $data{$studnum}} ) { my (@field, @qst, @value); push @field, 'studnum'; push @qst, '?'; push @value, $studnum; push @field, 'tdate'; push @qst, '?'; push @value, $date; push @field, 'tauthor'; push @qst, '?'; push @value, $author; push @field, 'tgrade'; push @qst, '?'; push @value, $grade; foreach my $field ( sort keys %{ $data{$studnum}{$idx}} ) { # print qq{SN:$studnum / $idx / $field / $data{$studnum}{$idx}{$field}
\n}; push @field, $field; push @qst, '?'; push @value, $data{$studnum}{$idx}{$field}; } # show the array values; # print qq{FLD:@field
QST:@qst
VAL:@value

\n}; my $fields = join(',',@field); my $qst = join(',',@qst); my $sth = $dbh->prepare("insert into fp_book ($fields) values($qst)"); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } $sth->execute( @value); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } # Notify of the record added. print qq{

$firstname $lastname / $idx / Record Added: @value

\n}; } } # end of studnum loop print qq{

[ Add More |\n}; print qq{$lex{Main} ]

\n}; print qq{\n}; exit; }