#! /usr/bin/perl # Copyright 2001-2024 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 = ('Assessment Entry' => 'Assessment Entry', 'No Course Enrollments' => 'No Course Enrollments', 'Main' => 'Main', 'Mark' => 'Mark', 'Move between fields using the Tab and Shift-Tab keys' => 'Move between fields using the Tab and Shift-Tab keys', 'It is faster!' => 'It is faster!', 'Save' => 'Save', 'Objective' => 'Objective', 'Comment' => 'Comment', 'Record(s) Stored' => 'Record(s) Stored', 'Contact' => 'Contact', 'Assessments' => 'Assessments', 'Please Log In' => 'Please Log In', 'Error' => 'Error', 'Current Evaluation' => 'Current Evaluation', 'Missing' => 'Missing', 'Add' => 'Add', 'Term' => 'Term', ); # Configured values my $default_AssessKeyCols = 4; my $self = 'markadd1.pl'; use DBI; use CGI; use CGI::Session; eval require "../../etc/admin.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } eval require "../../etc/repcard.conf"; if ( $@ ) { print $lex{Error}. " $@
\n"; die $lex{Error}. " $@\n"; } if ( not $r_AssessKeyCols ) { # in case not set yet. $r_AssessKeyCols = $default_AssessKeyCols; } my $q = new CGI; my %arr = $q->Vars; # Passed values from 0 script. my $subjsec = $arr{subjsec}; # passed in... my $term = $arr{entryterm}; my $track = $arr{track}; my $dsn = "DBI:$dbtype:dbname=$dbase"; my $dbh = DBI->connect($dsn,$user,$password); # Get Session Information... my $session = new CGI::Session("driver:mysql;serializer:FreezeThaw", undef,{Handle => $dbh}) or die CGI::Session->errstr; my $userid; if ( not $session->param('logged_in') ){ $userid = $session->param('userid'); print $q->header( -charset, $charset ); print qq{$doctype\n$lex{'Assessment Entry'}\n}; print qq{\n}; print qq{[ $lex{Main} ]\n}; if ( $userid and $arr{writeflag} ) { # update records if user exists and writeflag set. delete $arr{writeflag}; updateRecords(); print qq{

$lex{'Please Log In'}

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

$lex{'Please Log In'}

\n}; print qq{\n}; exit; } } # Ok, we have a login. Values below we have in environment. $userid = $session->param('userid'); $duration = $session->param('duration'); if (not ($duration =~ m/\+/)) { $duration = '+'. $duration. 'm'; } $session->expire('logged_in',$duration); print $session->header( -charset, $charset ); my $title = $lex{'Assessment Entry'}; print qq{$doctype\n$title\n}; print qq{\n}; print qq{\n}; # Some Javascript here for resizing... print "\n"; print qq{$chartype\n\n}; # End of HTML Head section. # Load the AdditionalComments value, to test if subject is a comment only subject. $sth = $dbh->prepare("select datavalue from conf_system where dataname = ?"); $sth->execute('r_AdditionalComments'); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } my $dv = $sth->fetchrow; eval $dv; # Get Course Info: Subjcode, Description, Grade my $sth = $dbh->prepare("select subjcode, description, grade from subject where subjsec = ?"); $sth->execute( $subjsec ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my ($subjcode, $description, $grade) = $sth->fetchrow; my $acMode; # Additional Comments don't have any values but a comment... if ( $r_AdditionalComments{ $subjsec } or $r_AdditionalComments{ $subjcode } ) { $acMode = 1; } my $subjectname; if ($description =~ m/$grade/) { $subjectname = $description; } else { $subjectname = "$description $grade"; } # Get Subject Objectives and Put in @qstarray my @subject = (); $sth = $dbh->prepare("select * from subject where subjsec = ?"); $sth->execute($subjsec); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} @subject = $sth->fetchrow; my @qstarray = (); # Stuff questions into the array. foreach my $a (10..29) { if ($subject[$a]) { push @qstarray, $subject[$a]; } } if ( not $subject[10] ) { # blank qstarray # We must put in one question. push @qstarray, $lex{Mark}; } # Update Records if ( $arr{writeflag} ) { delete $arr{writeflag}; updateRecords(); } # Get the students in this course, in name order. $sth = $dbh->prepare("select distinct e.studnum from eval e, student s where e.subjcode = ? and e.studnum = s.studnum and e.term = ? order by s.lastname, s.firstname "); $sth->execute($subjsec, $term); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my @students; while (my $studnum = $sth->fetchrow ) { push @students, $studnum; } if ( not @students ) { print qq{

$lex{'No Course Enrollments'}

\n}; print qq{\n}; exit; } # Print Evaluation Keys my @evalkey; my @evalkeyAlt1; if ( $r_Personal_Growth eq $description ) { # if the subject is personal development # figure out the key scheme...used to print eval schemes $r_PDEval{$scheme}{arrayidx} my $scheme = $r_PDEvalGrp{$grade}; @evalkey = @{ $r_PDEval{$scheme} }; } else { my $scheme = $r_EvalSch{$grade}; my $schemeAlt1 = $r_EvalSchAlt1{$grade}; @evalkey = @{ $r_Eval{$scheme} };# OR $r_Eval{scheme}[arrayidx] @evalkeyAlt1 = @{ $r_EvalAlt1{$schemeAlt1} }; } # Print Assessment Table at top print qq{
\n}; print qq{\n}; # Print the Hint. my $cols = $r_AssessKeyCols + 1; print qq{\n}; print qq{}; print qq{\n}; my $itemcount; print ''; foreach my $item ( @evalkey ){ my ($key,$val) = split(/::/, $item); if ( $val ) { # we have 2 items print qq{}; } else { # just use item since it doesn't split with :: print qq{\n}; } $itemcount++; if ( $itemcount % $r_AssessKeyCols == 0 ){ # 4-3 one less (3-2 works) print qq{\n}; } } $remainder = $r_AssessKeyCols - ( $itemcount % $r_AssessKeyCols ); if ( $remainder == $r_AssessKeyCols ) { $remainder = 0; } for ( 1..$remainder ){ print qq{\n};} print qq{\n}; if ( @evalkeyAlt1 ) { my $itemcount; print qq{}; print qq{\n}; print ''; foreach my $item ( @evalkeyAlt1 ){ my ($key,$val) = split(/::/, $item); if ( $val ) { # we have 2 items print qq{}; } else { # just use item since it doesn't split with :: print qq{\n}; } $itemcount++; if ( $itemcount % $r_AssessKeyCols == 0 ){ # 4-3 one less (3-2 works) print qq{\n}; } } $remainder = $r_AssessKeyCols - ( $itemcount % $r_AssessKeyCols ); if ( $remainder == $r_AssessKeyCols ) { $remainder = 0; } for ( 1..$remainder ){ print qq{\n};} print qq{\n}; } print qq{
\n}; print qq{ | $lex{'Main'} | \n}; print $lex{'Move between fields using the Tab and Shift-Tab keys'}; print qq{ $lex{'It is faster!'}
Evaluation Key
$key - $val$item
$r_EvalAlt1Title
$key - $val$item
\n\n}; # print Spacer div behind absolutely positioned assessment key div print qq{
\n}; # Print Top Section / Start of Form #$lex{'Assessment Entry'} print qq{

$subjectname - $lex{Term} $term

\n}; print qq{
\n}; print qq{\n}; print qq{\n}; my $sth = $dbh->prepare("select * from eval where studnum = ? and subjcode = ? order by term"); my $sth1 = $dbh->prepare("select lastname, firstname from studentall where studnum = ?"); foreach my $studnum ( @students ) { # Loop through all students in this class. # Get Student Name $sth1->execute($studnum); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my ($lastname, $firstname) = $sth1->fetchrow; # Load all eval records for this student in this subject (ie. all terms) # structure is a hash pointing to an array. (full eval record) my %evals = (); $sth->execute($studnum, $subjsec); if ( $DBI::errstr ){ print $DBI::errstr; die $DBI::errstr; } while ( my @eval = $sth->fetchrow ) { # put into %evals hash $evals{$eval[4]} = [ @eval ]; } print qq{\n\n}; print qq{\n}; print qq{
$firstname $lastname}; print qq{}; print qq{$lex{'Current Evaluation'}
\n}; my $id = $evals{$term}->[0]; # print qq{Term:$term|ID:$id
\n}; if ( not $acMode ) { print qq{\n}; print qq{\n}; # Print Terms row... foreach my $trm ( sort keys %evals ) { if ( $trm <= $term ) { print qq{\n}; } else { last; # just out if hit current term } } print qq{\n}; my $count = 1; my $qst = 7; foreach my $question ( @qstarray ){ print qq{}; # print previous term values foreach my $trm ( sort keys %evals ) { if ( $trm < $term ) { print qq{\n}; } else { last; # just out if hit current term } } # print current term. print qq{\n}; $count++; $qst++; } print qq{\n}; print qq{
}; print qq{$lex{Objective}$g_TermDisplay{$track}{$trm}
$count. $question$evals{$trm}->[$qst]}; print qq{
\n}; } print qq{
\n}; # Print Previous Comments... foreach my $trm ( sort keys %evals ) { if ( $trm < $term and $evals{$trm}->[6] ) { print qq{$g_TermDisplay{$track}{$trm} $lex{Comment}: }. $evals{$trm}->[6]. qq{
\n}; } } print qq{$g_TermDisplay{$track}{$term} $lex{Comment}:
\n}; print qq{
\n}; print qq{
\n}; } print qq{\n}; print qq{
\n}; #---------------- sub updateRecords { #---------------- # foreach my $key ( sort keys %arr ) { print qq{K:$key V:$arr{$key}
\n}; } foreach my $key ( keys %arr ) { my ( $evalrec, $studnum, $qst) = split(/:/, $key); if ( not $evalrec ) { print qq{$lex{Error}: $lex{Missing} ID: $arr{$key}
\n}; next; } elsif ( not $qst ) { print qq{$lex{Error}: $lex{Missing} QST# : $arr{$key}
\n}; next; } # Strip any backspaces, since these are LaTeX control ocdes. $arr{$key} =~ s/\\//g; # check field type and quote. if ($qst eq "comment"){ my $s = $arr{$key}; =head if ( $s ) { my @temp = split(//,$s); foreach my $val ( @temp ) { print qq{$val:",ord($val)," | }; } print qq{

\n}; } =cut # Filter the comments. # Convert newlines to spaces $s =~ s/\r\n|\n|\r|\t/ /g; # Convert Smart Quotes. # Do multibyte characters first! $s =~ s/\xE2\x80\x9C|\xE2\x80\x9D/"/g; # double quotes $s =~ s/\xE2\x80\x98|\xE2\x80\x99/'/g; # Single Quotes $s =~ s/\xE2\x80\x93/-/g; # ndash $s =~ s/\xE2\x80\xA2/*/g; # replace bullet. $s =~ s/\xE2\x80\x94}/--/g; # mdash $s =~ s/\xE2\x80\xA6/.../g; # ellipsis # print "Comment:$arr{$key}
\n"; # Single Byte Replacements $s =~ s/\x93|\x94/"/g; # double quotes $s =~ s/\x91|\x92/'/g; # single quote $s =~ s/\x95/*/g; # replace bullet. $s =~ s/\x96/-/g; # ndash $s =~ s/\x97/--/g; # mdash $s =~ s/\x85/.../g; # ellipsis # Strip control codes $s =~ s/[\x80-\x9F]//g; # strip upper control codes area $s =~ s/[\x00-\x1F]//g; # strip lower control codes area $fieldid = "comment"; $arr{$key} = $s; } else { $fieldid = "a$qst"; $arr{$key} = "\U$arr{$key}"; } # print "Comment:$arr{$key}
\n"; $sth = $dbh->prepare("update eval set $fieldid = ? where id = ? "); $sth->execute( $arr{$key},$evalrec ); if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; } } if ( not $DBI::errstr ) { print qq{
}; print qq{$lex{'Record(s) Stored'}
\n}; } else { print qq{

$lex{Error}: $DBI::errstr

$lex{Contact}:}; print qq{ $adminname $adminemail

\n}; } print qq{
}; print qq{$lex{Main} | \n}; print qq{$lex{Add} More $lex{Assessments}\n}; print qq{\n}; exit; } # End of Update Record.