#!/usr/bin/perl # Copyright 2001-2022 Leslie Richardson # This file is part of Open Admin for Schools. # Passed Values: Student Number and Password # Script: studentview.pl - show student marks from gradebook, from # report cards, and attendance. # Changes: Parse input password and name for correct character # classes. Also user is a read only user for the database. Cannot # write data. my %lex = ('Attendance' => 'Attendance', 'No Selection' => 'No Selection', 'Student' => 'Student', 'Average' => 'Average', 'Report Card' => 'Report Card', 'Gradebook' => 'Gradebook', 'NA' => 'NA', 'No Course Enrollments' => 'No Course Enrollments', 'Subject' => 'Subject', 'Objectives' => 'Objectives', 'Term' => 'Term', 'for' => 'for', 'Assessment' => 'Assessment', 'Group' => 'Group', 'Weight' => 'Weight', 'Score' => 'Score', 'Comment' => 'Comment', 'Grp Avg' => 'Grp Avg', 'Error' => 'Error', 'Current Year GPA' => 'Current Year GPA', 'GPA' => 'GPA', 'No Quality Score for' => 'No Quality Score for', 'Show' => 'Show', 'Continue' => 'Continue', 'Please Log In' => 'Please Log In', 'Parent' => 'Parent', 'Main' => 'Main', 'Homeroom' => 'Homeroom', 'Teacher' => 'Teacher', 'Disabled' => 'Disabled', 'View' => 'View', ); my $self = 'viewattgbook.pl'; # The location to load the config file from. my $configlocation = '../etc'; my $liblocation = '../lib'; my $specchar = '*'; # causes this test to be skipped in calculating avg. my $altcolor = '#3B7'; #1B6 Complement to the 063 green of teacher site. my $commentcolor = 'yellow'; use DBI; use CGI; use CGI::Session; eval require "$configlocation/admin.conf"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } eval require "$configlocation/gbook.conf"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } # get $defaultItemWeight from gbook.conf for the correct multiplier view eval require "$liblocation/libattend.pl"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $iddst) = localtime(time); $year = $year + 1900; $mon++; $wday++; $currdate = "$dow[$wday], $month[$mon] $mday, $year"; my $q = CGI->new; my %arr = $q->Vars; # Get passed values # Get Session my $session = new CGI::Session("driver:$dbtype;serializer:FreezeThaw", undef,{Handle => $dbh}) or die CGI::Session->errstr; my $title = "$lex{Student} $lex{Attendance}/$lex{'Report Card'}/$lex{Gradebook}"; if ( not $session->param('logged_in') ){ my $userid = $session->param('userid'); print $q->header( -charset, $charset ); print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{

$title

\n}; print qq{\n}; print qq{\n}; exit; } my $userid = $session->param('userid'); my $duration = $session->param('duration'); $session->expire('logged_in', $duration ); print $session->header( -charset, $charset ); $dbh->disconnect; # with RW version user. $dbh = DBI->connect($dsn,$rouser,$ropassword); # print page header print qq{$doctype\n$title\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{[ $lex{Parent} $lex{Main} ]\n}; # Check for parent lockout my $sth = $dbh->prepare("select parent_lockout from student where studnum = ?"); $sth->execute( $userid ); my $lockout = $sth->fetchrow; my %lockout; foreach my $val ( split(//,$lockout) ) { $lockout{$val} = 1; } if ( not $arr{page} ) { showStartPage(); } else { delete $arr{page}; showResults(); } #---------------- sub showStartPage { #---------------- print qq{\n}; exit; } # end of showStartPage #-------------- sub showResults { #-------------- if ( not $arr{attendance} and not $arr{reportcard} and not $arr{gradebook} ){ print qq{

$lex{'No Selection'}

\n}; print qq{\n}; exit; } if ( $arr{attendance} ){ # Show Child's Attendance print qq{

$lex{Attendance}

\n}; showAttendance( $userid ); } if ( $arr{reportcard} ){ # Show Report Card Marks if ( $lockout{'R'} ) { print qq{

$lex{'Report Card'} $lex{View} $lex{Disabled}

\n}; } else { # ok print qq{

$lex{'Report Card'}

\n}; showReportCard( $userid ); } } if ( $arr{gradebook} ){ # Show Gradebook Marks if ( $lockout{'G'} ) { print qq{

$lex{Gradebook} $lex{View} $lex{Disabled}

\n}; } else { # ok showGradebook( $userid ); } } print qq{\n}; exit; } #----------------- sub showAttendance { # Show student attendance #----------------- my $studnum = shift; # Set AM/PM Hash for use converting 2 period day to AM/PM %ampm = ( 1 =>'AM', 2 =>'PM'); # date variables: start and end dates for period of interest. # (start of year to date for this student.) my $startdate = $schoolstart; # global variable from admin.conf # current date @tim = localtime(time); my $eyear = @tim[5] + 1900; my $emonth = @tim[4] + 1; my $eday = @tim[3]; if (length($emonth) == 1){ $emonth = "0".$emonth;} if (length($eday) == 1){ $eday = "0".$eday;} $enddate = "$eyear-$emonth-$eday"; # Format Year End date and compare. my ( $yeyear, $yemonth, $yeday ) = split /-/, $schoolend; if (length($yemonth) == 1){ $yemonth = "0".$yemonth;} if (length($yeday) == 1){ $yeday = "0".$yeday;} my $yearenddate = "$yeyear-$yemonth-$yeday"; # Reset end date if past end of school year if ( $enddate > $yearenddate ) { $enddate = $yearenddate; } # Get student data; not needed until family groupings done. $sth = $dbh->prepare("select * from student where studnum = ?"); $sth->execute( $studnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $ref = $sth->fetchrow_hashref; my %s = %$ref; $tardyu = 0; $absentu = 0; $totalu = 0; $loopstartdate = $startdate; $loopenddate = $enddate; # Fetch Enrollment/Withdrawal Changes $sth3 = $dbh->prepare("select * from transfer where studnum = '$s{studnum}' and to_days(date) >= to_days('$loopstartdate') and to_days(date) <= to_days('$loopenddate') order by date desc"); $sth3->execute; if ($DBI::errstr) { print $DBI::errstr; die; } while ( @entryrecord = $sth3->fetchrow ) { foreach $rec (@entryrecord){ $rec =~ s/:/-/g; $rec =~ s/&/\\&/g; $rec =~ s/#//g; $rec =~ s/$//g; } push @entries, "$entryrecord[2]:$entryrecord[3]:$entryrecord[4]"; if ($entryrecord[3] eq "enrol" or $entryrecord[3] ne "withdraw"){ # Change the start date, format in YYYY-MM-DD ($year,$mo,$day) = split '-',$entryrecord[2]; if (length($day)<2) { $day = "0".$day;} if (length($mo)<2) { $mo = "0".$mo; } $loopstartdate = "$year$mo$day"; } } # End of Entry/Withdrawal Records my $schooldays = calcDaysOpen($loopstartdate, $loopenddate, $dbh); # Print School Days and Dates Info print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{

Start Date	$startdate
Ending Date	$enddate
School Days	$schooldays

\n}; # Print Any Enrollment Changes if ( @entries ) { print qq{\n}; print qq{\n}; print qq{\n}; foreach my $entry (@entries){ my ($date,$type,$desc) = split ':',$entry; print qq{\n}; } } print qq{

Enrollment Changes
Date	Type	Description
$date	$type	$desc

\n}; # Fetch Attendance Records by Days $sth1 = $dbh->prepare("select distinct absdate, count(absdate) from attend where studentid = '$s{studnum}' and to_days(absdate) >= to_days('$startdate') and to_days(absdate) <= to_days('$enddate') group by absdate order by absdate"); $sth1->execute; if ($DBI::errstr) { print $DBI::errstr; die; } print qq{\n}; print qq{\n}; print qq{\n}; while (my ($absdate,$count) = $sth1->fetchrow){ print qq{\n}; } print qq{

Attendance by Days
Date	Periods Missed
$absdate	$count

\n}; # Fetch Attendance Records by Subjects $sth1 = $dbh->prepare("select distinct subjsec, count(subjsec) from attend where studentid = '$studnum' and to_days(absdate) >= to_days('$startdate') and to_days(absdate) <= to_days('$enddate') group by subjsec order by subjsec"); $sth1->execute; if ($DBI::errstr) { print $DBI::errstr; die; } print qq{\n}; print qq{\n}; print qq{\n}; while (my ($subject,$count) = $sth1->fetchrow){ $sth2 = $dbh->prepare("select description from subject where subjsec = '$subject'"); $sth2->execute; if ($DBI::errstr) { print $DBI::errstr; die; } my $description = $sth2->fetchrow; print qq{\n}; } print qq{

Attendance by Subject
Subject	Periods Missed
$description ($subject)	$count

\n}; } # End of Show Attendance #---------------- sub showGradebook { #---------------- my $studnum = shift; # Get Student Name my $sth = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); $sth->execute($studnum); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname) = $sth->fetchrow; # Get the Subjects this student takes (in eval table); put in %subject array. $sth = $dbh->prepare("select distinct e.subjcode, s.description, s.teacher from eval e, subject s where e.subjcode = s.subjsec and e.studnum = ? and s.visible = 'Y'"); $sth->execute($studnum); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my $sth1 = $dbh->prepare("select sal, lastname, firstname from staff where userid = ?"); my %subject; my %teachername; while ( my ( $subjsec, $desc, $userid ) = $sth->fetchrow ) { $subject{$subjsec} = $desc; $sth1->execute($userid); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ( $sal, $lastname, $firstname ) = $sth1->fetchrow; $teachername{$subjsec} = "$firstname $lastname"; } print qq{

}; print qq{$lex{Gradebook} – $firstname $lastname

\n}; # loop through each subject foreach my $subjsec (keys %subject){ # Lookup tests for this subject-section. my (@test, %weight, %maxscore); $sth = $dbh->prepare("select name, id, score, weight, description, grp from gbtest where subjsec = ? order by grp, tdate desc"); $sth->execute( $subjsec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } while ( my ($name,$id,$score,$weight,$desc,$grp) = $sth->fetchrow ) { if ($name eq 'sortorder'){ next; } # skip the 'sortorder' test $name =~ s/://g; # strip colons, if any. $desc =~ s/://g; push @test, "$name:$id:$score:$desc:$grp"; $weight{$id} = $weight; # used for calculating averages. $maxscore{$id} = $score; } # Now done putting in the tests. # Skip to next subject if no tests. if ( not @test ){ next; } # Load the group weights from the current subject; define %groupweight my %groupweight; $sth = $dbh->prepare("select markscheme from subject where subjsec = ?"); $sth->execute( $subjsec ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $markscheme = $sth->fetchrow; # build a %groupweight hash from values in markscheme. my @fields = split (/[\n|\r]/, $markscheme); foreach my $fld (@fields) { if ($fld) { #print qq{F:$fld
\n}; my ($grp, $percent) = split /=/, $fld; $groupweight{$grp} = $percent; } } my $avg = calcAverage($studnum, $subjsec, \%maxscore, \%weight, \%groupweight); # Print the table header print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{}; #print '\n}; print qq{\n}; print qq{\n}; my ($totalweight,$totalscore); my $count = 1; my $currgroup = -1; my $first = 1; foreach my $test ( @test ){ my ($name, $id, $maxscore, $desc, $grp) = split /:/, $test; $oldgroup = $currgroup; $currgroup = $grp; if ( $currgroup ne $oldgroup and not $first) { print qq{\n}; print qq{\n}; print qq{\n}; } else { print qq{$lex{'Grp Avg'} $lex{NA}\n}; } $totalweight = 0; $totalscore = 0; print qq{\n}; } else { $first = 0; } my $color; if ($count % 2) { $color = qq{style="background-color:#EEE;"}; } $count++; # Calc the weight as multiplier... my $wtmult; if ($defaultItemWeight) { $wtmult = sprintf("%3.2f",($weight{$id} / $defaultItemWeight)); } print qq{\n}; $sth = $dbh->prepare("select score, comment from gbscore where testid = ? and studnum = ?"); $sth->execute( $id, $studnum ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } my ($score, $comment) = $sth->fetchrow; my $testaverage; if ( $score ne $specchar ){ #ie. skip calcs for specialchar $totalweight += $weight{$id}; $totalscore += ( $weight{$id} * $score / $maxscore ); $testaverage = $score / $maxscore * 100; print qq{}; } else { $testaverage = $lex{NA}; print qq{}; } print qq{\n}; if ($comment) { print qq{\n}; } } # End of test loop # Print the Last Group Values print qq{}; print qq{\n}; print qq{\n}; } else { print qq{$lex{'Grp Avg'} $lex{NA}\n}; } print qq{\n}; print qq{

$teachername{$subjsec}
$lex{Assessment}	'. $lex{Group}. "	$lex{Weight}	$lex{Score}
$subject{$subjsec} ($subjsec)	$lex{Average} $avg
$lex{Group} $oldgroup	$groupweight{$oldgroup}\%	\n}; if ( $totalweight ) { print $lex{'Grp Avg'}; #print $lex{Average}; my $groupavg = sprintf("%3.1f",100 * $totalscore / $totalweight); print qq{ $groupavg\%
$name - $desc	$wtmult\X	}; printf "%3.1f", $testaverage; print qq{% ($score/$maxscore)	$score (x/$maxscore)
}; print qq{$lex{Comment}: $comment
$lex{Group} $currgroup	$groupweight{$currgroup}\%	\n}; if ( $totalweight ) { print $lex{'Grp Avg'}; my $groupavg = sprintf("%3.1f",100 * $totalscore / $totalweight); print qq{ $groupavg\%

\n}; } # End of this subject. } # End of showGradebook #----------------- sub showReportCard { #----------------- my $studnum = shift; # Get Student Name my $sth = $dbh->prepare("select lastname,firstname, grade, homeroom from student where studnum = ?"); $sth->execute($studnum); if ($DBI::errstr){ print $DBI::errstr; die;} my ($lastname, $firstname, $grade, $homeroom ) = $sth->fetchrow; # Get homeroom teacher, if any $sth = $dbh->prepare("select s.sal, s.lastname, s.firstname from staff s, staff_multi sm where sm.field_name = 'homeroom' and sm.field_value = ? and s.userid = sm.userid"); $sth->execute( $homeroom ); my ($tsal, $tlastname, $tfirstname) = $sth->fetchrow; my $teachername; if ( $tlastname ) { # we have a homeroom teacher. if ( $tsal ) { # use salutation $teachername = "$tsal $tlastname"; } else { # use firstname $teachername = "$tfirstname $tlastname"; } } # Get All Subject Information and put into hash with key as subjsec # and value is pointer to the array. my %subject = (); $sth = $dbh->prepare("select * from subject"); $sth->execute; if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } while ( my $subjref = $sth->fetchrow_hashref ) { if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } $subject{ $subjref->{subjsec} } = $subjref; } # Load the SupressSubject, AdditionalComments data $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); foreach my $val ('r_SupressSubject', 'r_AdditionalComments', 'r_CalcGPA') { $sth->execute( $val ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } my $dv = $sth->fetchrow; eval $dv; } # TEST: Loop through and print each student #foreach my $key ( keys %subject ) { # print qq{K: $key V: ", $subject{$key}->{description},"
\n}; #} # Get the number of terms from the eval table $sth = $dbh->prepare("select max(term) from eval"); $sth->execute; if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } $maxterm = $sth->fetchrow; # Print Student Name and Homeroom Teacher print qq{

$firstname $lastname ($studnum)}; if ( $teachername ) { # homeroom teacher print qq{
$lex{Homeroom} $lex{Teacher} – $teachername\n}; } print qq{

\n}; # Print Table Header print qq{\n}; my %eval; # a)Find his/her subjects in order $sth = $dbh->prepare("select distinct e.subjcode, s.description, s.teacher, s.grade from eval as e, subject as s where e.subjcode = s.subjsec and e.studnum = ? order by s.sequence, s.description,e.subjcode"); $sth->execute( $studnum ); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } my $sth1 = $dbh->prepare("select * from eval where subjcode = ? and studnum = ? order by term"); # Get Teacher Name my $sth2 = $dbh->prepare("select sal, lastname, firstname from staff where userid = ?"); my $subjflag = 0; # flag in case of no subj enrollments. while ( my ($subjsec, $desc, $userid, $sgrade ) = $sth->fetchrow ) { # Loop through each subject. # Skip Additional Comments or Supressed Subjects my ($tsubjcode, $dud) = split(/-/, $subjsec ); if ( $r_SupressSubject{$tsubjcode} or $r_SupressSubject{$subjsec} or $r_AdditionalComments{$tsubjcode} or $r_AdditionalComments{$subjsec} ) { next; } $subjflag = 1; my @eval = (); my @gpa = (); # Get Objectives Count for this subject; also # of loops my $objcount; # objective count for my $i (1 .. 20){ my $idx = 'q'. $i; if ( $subject{$subjsec}->{$idx} ){ $objcount++; } else { last; } } # Get Teacher Name $sth2->execute( $userid ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; my ($tsal, $tlastname, $tfirstname) = $sth2->fetchrow; my $teachername; if ( $tsal ) { $teachername = "$tsal $tlastname"; } else { $teachername = "$tfirstname $tlastname"; } my $track = $g_MTrackTermType{ $sgrade }; # Loop through records for this course $sth1->execute( $subjsec, $studnum ); # Find the records for this course while ( my @evalrec = $sth1->fetchrow ){ # Loop through eval recs. # Code to Check for Term Errors $prevterm = $currterm; $currterm = $evalrec[4]; if ( $prevterm == $currterm ){ # We have an error! print qq{$lex{Error} $lex{for} $lastname, $firstname ($studnum) }; print qq{$lex{Subject} $desc ($subjsec) - $lex{Term} $currterm.
\n}; print qq{Multiple records for the same term in the same subject! Please Fix!
\n}; } $eval[ $evalrec[4] ] = [ @evalrec ]; # store record; evalrec[4] is term. $gpa[ $evalrec[4] ] = $evalrec[7]; # a1 field. } # End of Eval Creation Loop $eval{$subjsec} = [ @gpa ]; # store for GPA calcs. if ( @eval ) { # we have records... # Print Terms Line print qq{\n}; for my $t (1..$#eval){ print qq{};} print qq{\n}; # Subject (and possibly objectives) Lines print qq{}; print qq{}; if ( $objcount == 0 ){ # No objectives... just marks (1 line) for ( 1..$#eval ) { print qq{}; } print qq{\n}; } else { # We have objectives listed # blank line with subject for ( 1..$#eval ){ print qq{}; } print qq{\n}; for ( my $i = 1; $i <= $objcount; $i++){ # of lines/objectives my $subjindex = 'q'. $i; my $evalindex = $i + 6; print qq{}; for ( 1..$#eval ){ print qq{}; } print qq{\n}; } } # End of 'Objectives listed' - ie. not just marks. # Now Print Comments my $colcount = $#eval + 1; print qq{\n}; } # End of 'Do we have eval records?' } # Next Subject # Do GPA calcs and Display if ( %eval and $r_CalcGPA ) { calcGPA( \%eval, $maxterm ); } if ( not $subjflag ){ # No subject enrollments for this student. my $colcount = $maxterm + 1; print qq{\n}; } print qq{

$lex{Subject}/$lex{'Objectives'}	$g_TermDisplay{$track}{$t}
$subject{$subjsec}->{description} $teachername	$eval[$_]->[7]

$subject{$subjsec}->{$subjindex}	}; print qq{$eval[$_]->[$evalindex]
}; for my $trm ( 1..$#eval ){ if ($eval[$trm]->[6]){ print qq{$g_TermDisplay{$track}{$trm}: $eval[$trm]->[6] }; } } print qq{
$lex{'No Course Enrollments'}

\n}; } # End of showReportCard #---------- sub calcGPA { #---------- my $gpa_ref = shift; my $maxterm = shift; use Number::Format qw(:subs); eval require "$configlocation/transcript.conf"; if ( $@ ) { print $lex{Error}. ": $@
\n"; die $lex{Error}. ": $@\n"; } # Get credit and difficulty values for each subject. my $sth = $dbh->prepare("select credit, difficulty from subject where subjsec = ?"); my ($totalGPQuality, $totalGPCredits); # needed for overall at end. print qq{$lex{GPA}\n}; # Loop through each term calculating the GPA for each term... foreach my $term ( 1..$maxterm ) { #loop through all terms my ( $termCreditTotal, $termGPTotal ); my ( $termCredits, $termAttempts ); # not used, yet. TermCredits includes P/F courses. my ( $termGPCredits, $termGPQuality ); foreach my $subjsec ( keys %{$gpa_ref} ) { if ( $gpa_ref->{$subjsec}[$term] ) { # If we have a value for this term.. my $mark = $gpa_ref->{$subjsec}[$term]; # could be letter or number... # Get Subject Data $sth->execute( $subjsec ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; }; my ($credit, $difficulty) = $sth->fetchrow; $credit = 1 if not $credit; if ( not $difficulty ) { $difficulty = 0; } # Convert the mark to a letter (and then to a quality score below... my $letter; # letter grade. if ( $mark =~ /[a-zA-Z]/ ) { # We have a 'letter' mark, copy into $letter $letter = $mark; } else { # find the matching letter for this numeric value.. foreach my $threshold (reverse sort keys %markToLetter ) { # large to small if ($mark >= $threshold) { $letter = $markToLetter{$threshold}; # print qq{Mark: $mark Letter: $letter
\n}; last; } } } # Now convert $letter to a quality score. # letterToQual hash in transcript.conf; add up quality scores and credit counts. # Check for missing Quality value in transcript.conf if ( ( not defined $letterToQual{ $letter } ) and ( $letter ne $passletter ) ) { print qq{
$lex{'No Quality Score for'} $letter\n}; next; # skip to next subject. } my $quality = $letterToQual{ $letter } + $difficulty; $termGPQuality += $quality * $credit; $totalGPQuality += $quality * $credit; $termAttempts += $credit; if ( $letter ne $failletter ) { $termCredits += $credit; $totalCredits += $credit; } # If not a fail and also not a pass/fail course if ( $letter ne $passletter ) { $totalGPCredits += $credit; $termGPCredits += $credit; } #print qq{$subjsec $term ". $gpa_ref->{$subjsec}[$term]. "
\n}; } # End of If mark exists } # End of Subject Loop for this term. my $gpa; if ($termGPCredits) { $gpa = format_number( ($termGPQuality / $termGPCredits ), 2 ); } else { $gpa = 0; } print qq{$gpa}; # change to GPA value... } # End of terms loop print qq{\n}; my $cumgpa; if ($totalGPCredits) { $cumgpa = format_number( ($totalGPQuality / $totalGPCredits), 2 ); } else { $cumgpa = 0; } my $colspan = $maxterm + 1; print qq{$lex{'Current Year GPA'} $cumgpa\n}; } # end of calcGPA #----------------- sub calcAverage { # Latest method for Gradebook #----------------- require strict; # needed: $maxscore{$id}, $weight{$id}, $groupweight{$grp}, $specchar my $specchar = '*'; # Get Passed values. my ($studnum, $subjsec, $maxscore_ref, $weight_ref, $groupweight_ref) = @_; # Yes, this is ugly... but don't want to rewrite the rest... my %maxscore = %{$maxscore_ref}; my %weight = %{$weight_ref}; my %groupweight = %{$groupweight_ref}; #print qq{SN: $studnum SUB: $subjsec MScore:",%maxscore, " Weight: }; #print %weight, "GWt:",%groupweight,"
\n}; my $totalweight; my $totalscore; # Get test info and test score (of that item) at same time. my $sth = $dbh->prepare("select gs.id, gs.testid, gs.score, gt.grp from gbscore as gs, gbtest as gt where gs.testid = gt.id and gt.name != 'sortorder' and gs.studnum = ? and gt.subjsec = ? order by gt.grp"); $sth->execute( $studnum, $subjsec ); if ( $DBI::errstr ) { print $DBI::errstr; die $DBI::errstr; } my $currgrp = -1; my $oldgrp; my $first = 1; my $totalscore; # running total for score; zeroed for each new group. my $totalweight; # running total for weight; zeroed for each new group. my %groupscore; while (my ( $id, $testid, $score, $grp ) = $sth->fetchrow ) { $score =~ s/\s//g; # strip any spaces in score; if ($score eq $specchar or $score eq '' or not defined $score ) { next; } # skip $oldgrp = $currgrp; $currgrp = $grp; if ($currgrp ne $oldgrp and not $first) { # setup group values for the current group if ( $totalweight ) { $groupscore{$oldgrp} = $totalscore / $totalweight; } else { $groupscore{$oldgrp} = 0; } $totalscore = 0; $totalweight = 0; } if ($first) { $first = 0; } if ($score =~ /\d/) { # if score is a digit... do it. if ($maxscore{ $testid }) { $totalscore += $score / $maxscore{$testid} * $weight{$testid}; } else { $totalscore = 0; } $totalweight += $weight{$testid}; } else { # some sort of text score...count as zero... update total weight. $totalweight += $weight{$testid}; } #print qq{TS: $totalscore TW:$totalweight GP:$grp
\n}; } # End of Scores Loop # Get Last group, if any; if ($totalweight) { $groupscore{$currgrp} = $totalscore / $totalweight; } $totalscore = 0; # necessary? $totalweight = 0; # necessary? #foreach my $key (keys %groupscore) { print qq{K: $key GS: $groupscore{$key}
\n}; } # Add up the group scores and weight them for overall average foreach my $grp (keys %groupscore) { $totalscore += $groupscore{$grp} * $groupweight{$grp}; #print qq{GS: $groupscore{$grp} GW:$groupweight{$grp}
\n}; $totalweight += $groupweight{$grp}; } #print qq{TS:$totalscore TW:$totalweight

\n}; if ($totalweight) { return sprintf("%3.1f", 100 * $totalscore / $totalweight). '%'; } else { return 0; } } # End of CalcAverage (new version)

$lex{Show} $lex{Attendance}
$lex{Show} $lex{'Report Card'}
$lex{Disabled}
$lex{Show} $lex{Gradebook}
$lex{Disabled}