--- loncom/interface/Attic/lonchart.pm 2001/10/19 22:03:05 1.8 +++ loncom/interface/Attic/lonchart.pm 2002/03/02 02:03:47 1.37 @@ -1,4 +1,30 @@ # The LearningOnline Network with CAPA +# (Publication Handler +# +# $Id: lonchart.pm,v 1.37 2002/03/02 02:03:47 minaeibi Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA 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. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# # Homework Performance Chart # # (Navigate Maps Handler @@ -6,33 +32,38 @@ # (Page Handler # # (TeX Content Handler -# +# YEAR=2000 # 05/29/00,05/30 Gerd Kortemeyer) # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23, # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer) -# -# 3/1/1,6/1,17/1,29/1,30/1 Gerd Kortemeyer) -# -# 1/31 Gerd Kortemeyer -# +# YEAR=2001 +# 3/1/1,6/1,17/1,29/1,30/1,31/1 Gerd Kortemeyer) # 7/10/01 Behrouz Minaei # 9/8 Gerd Kortemeyer -# 10/18/01, 10/19/01 Behrouz Minaei +# 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei +# YEAR=2002 +# 2/1, 2/6, 2/19, 2/28 Behrouz Minaei +# +### package Apache::lonchart; use strict; use Apache::Constants qw(:common :http); use Apache::lonnet(); +use Apache::loncommon(); use HTML::TokeParser; use GDBM_File; # -------------------------------------------------------------- Module Globals my %hash; +my %CachData; my @cols; my @rowlabels; my @students; - +my @PreCol; +my $r; + # ------------------------------------------------------------- Find out status sub ExtractStudentData { @@ -47,21 +78,48 @@ sub ExtractStudentData { my $Wrongs; my %TempHash; my $Version; - my $LatestVersion; - + my $ProbNo; + my $ProbSolved; + my $ProbTotal; + my $LatestVersion; my $Str=substr($students[$index]. ' ',0,14).' ! '. substr($rowlabels[$index]. ' ',0,45).' ! '; - unless ($reply=~/^error\:/) { - map { + foreach (split(/\&/,$reply)) { my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_)); $result{$name}=$value; - } split(/\&/,$reply); + } + $ProbNo = 0; + $ProbTotal = 0; + $ProbSolved = 0; + my $IterationNo = 0; foreach $ResId (@cols) { - if ( !$ResId ) { $Str .= ' ! '; next; } + if ($IterationNo == 0) {$IterationNo++; next;} + if (!$ResId) { + my $PrNo = sprintf( "%3d", $ProbNo ); + $Str .= ' '.''.$PrNo.' '; + $ProbSolved += $ProbNo; + $ProbNo=0; + next; + } $ResId=~/(\d+)\.(\d+)/; + my $meta=$hash{'src_'.$ResId}; + my $PartNo = 0; + undef %TempHash; + foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { + if ($_=~/^stores\_(\d+)\_tries$/) { + my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); + if ( $TempHash{"$Part"} eq '' ) { + $TempHash{"$Part"} = $Part; + $TempHash{$PartNo}=$Part; + $TempHash{"$Part.Code"} = ' '; + $PartNo++; + } + } + } + my $Prob = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ). '___'.$2.'___'. &Apache::lonnet::declutter( $hash{'src_'.$ResId} ); @@ -69,48 +127,56 @@ sub ExtractStudentData { $Tries = 0; $LatestVersion = $result{"version:$Prob"}; - undef %TempHash; - my $PartNo = 0; - if ( $LatestVersion ) { - for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) { my $vkeys = $result{"$Version:keys:$Prob"}; my @keys = split(/\:/,$vkeys); + foreach my $Key (@keys) { if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) { my $Part = $1; - if ( $TempHash{"$Part"} eq '' ) { - $TempHash{"$Part"} = $Part; - $TempHash{$PartNo}=$Part; - $PartNo++; - } - $TempHash{"$Part.Tries"} = $result{"$Version:$Prob:resource.$Part.tries"}; $Tries = $result{"$Version:$Prob:resource.$Part.tries"}; - my $Val = $result{"$Version:$Prob:$Key"}; + $TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0; + my $Val = $result{"$Version:$Prob:resource.$Part.solved"}; if ($Val eq 'correct_by_student'){$Code='*';} elsif ($Val eq 'correct_by_override'){$Code = '+';} elsif ($Val eq 'incorrect_attempted'){$Code = '.';} elsif ($Val eq 'incorrect_by_override'){$Code = '-';} elsif ($Val eq 'excused'){$Code = 'x';} + elsif ($Val eq 'ungraded_attempted'){$Code = '#';} + else {$Code = ' ';} $TempHash{"$Part.Code"} = $Code; } } } - for ( my $n = 0; $n < $PartNo; $n++ ) { my $part = $TempHash{$n}; - if (($TempHash{$part.'.Code'} eq '*')&& - ($TempHash{$part.'.Tries'}<10)) { - $TempHash{$part.'.Code'}=$Tries; + my $Code = $TempHash{"$part.Code"}; + if ( $Code eq '*') { + $ProbNo++; + if (($TempHash{"$part.Tries"}<10) || + ($TempHash{"$part.Tries"} eq '')) { + $TempHash{"$part.Code"}=$TempHash{"$part.Tries"}; + } } - $Str .= $TempHash{$part.'.Code'}; + elsif ( $Code eq '+' ) {$ProbNo++;} + $Str .= $TempHash{"$part.Code"}; + if ( $Code ne 'x' ) {$ProbTotal++;} } } - else { $Str .= ' '; } + else { + for(my $n=0; $n<$PartNo; $n++) { + $Str.=' '; + $ProbTotal++; + } + } } } - return $Str; + my $PrTot = sprintf( "%5d", $ProbTotal ); + my $PrSvd = sprintf( "%5d", $ProbSolved ); + $Str .= ' '.''.$PrSvd.' /'.$PrTot.' '; + + return $Str ; } @@ -150,189 +216,299 @@ sub tracetable { } } if (defined($hash{'to_'.$rid})) { - map { + foreach (split(/\,/,$hash{'to_'.$rid})){ &tracetable($hash{'goesto_'.$_},$beenhere); - } split(/\,/,$hash{'to_'.$rid}); + } } } } -# ================================================================ Main Handler - -sub handler { - my $r=shift; - - if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { -# ------------------------------------------- Set document type for header only - - if ($r->header_only) { - if ($ENV{'browser.mathml'}) { - $r->content_type('text/xml'); - } else { - $r->content_type('text/html'); - } - $r->send_http_header; - return OK; - } - - my $requrl=$r->uri; -# ----------------------------------------------------------------- Tie db file - if ($ENV{'request.course.fn'}) { - my $fn=$ENV{'request.course.fn'}; - if (-e "$fn.db") { - if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) { -# ------------------------------------------------------------------- Hash tied - - -# ------------------------------------------------------------------ Build page - -# ---------------------------------------------------------------- Send headers - - $r->content_type('text/html'); - $r->send_http_header; - $r->print( - 'LON-CAPA Assessment Chart'); - - $r->print(''. - ''. - ''. - '

Assessment Chart

'); - -# ---------------------------------------------------------------- Course title - - $r->print('

'. - $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'

'. - localtime()."

1..9: correct by student in 1..9 tries\n".
-                            "   *: correct by student in more than 9 tries\n".
-	                    "   +: correct by override\n".
-                            "   -: incorrect by override\n".
-	                    "   .: incorrect attempted\n".
-                            "    : not attempted\n".
-	                    "   x: excused

"); - -# ------------------------------- This is going to take a while, produce output - - $r->rflush(); +sub usection { + my ($udom,$unam,$courseid,$ActiveFlag)=@_; + $courseid=~s/\_/\//g; + $courseid=~s/^(\w)/\/$1/; + foreach (split(/\&/,&Apache::lonnet::reply('dump:'. + $udom.':'.$unam.':roles', + &Apache::lonnet::homeserver($unam,$udom)))){ + my ($key,$value)=split(/\=/,$_); + $key=&Apache::lonnet::unescape($key); + if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) { + my $section=$1; + if ($key eq $courseid.'_st') { $section=''; } + my ($dummy,$end,$start)=split(/\_/,&Apache::lonnet::unescape($value)); + if ( $ActiveFlag ne 'Any' ) { + my $now=time; + my $notactive=0; + if ($start) { + if ($now<$start) { $notactive=1; } + } + if ($end) { + if ($now>$end) { $notactive=1; } + } + if ((($ActiveFlag eq 'Expired') && $notactive == 1) || + (($ActiveFlag eq 'Active') && $notactive == 0 ) ) { + return $section; + } + else { return '-1'; } + } + return $section; + } + } + return '-1'; +} +sub BuildChart { # ----------------------- Get first and last resource, see if there is anything - - - my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}}; - my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}}; - if (($firstres) && ($lastres)) { + my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}}; + my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}}; + if (($firstres) && ($lastres)) { # ----------------------------------------------------------------- Render page - - my $cid=$ENV{'request.course.id'}; - my $chome=$ENV{'course.'.$cid.'.home'}; - my ($cdom,$cnum)=split(/\_/,$cid); - + my $cid=$ENV{'request.course.id'}; + my $chome=$ENV{'course.'.$cid.'.home'}; + my ($cdom,$cnum)=split(/\_/,$cid); # ---------------------------------------------- Read class list and row labels + my $classlst=&Apache::lonnet::reply + ('dump:'.$cdom.':'.$cnum.':classlist',$chome); + my $now=time; + unless ($classlst=~/^error\:/) { + foreach my $KeyPoint(sort split(/\&/,$classlst)) { + my ($name,$value)=split(/\=/,$KeyPoint); + my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); + my $active=1; + my $Status=$ENV{'form.status'}; + $Status = ($Status) ? $Status : 'Active'; + if ( ( ($end) && $now > $end ) && + ( ($Status eq 'Active') ) ) { $active=0; } + + if ( ($Status eq 'Expired') && + ($end == 0 || $now < $end) ) { $active=0; } + + if ($active) { + my $thisindex=$#students+1; + $name=&Apache::lonnet::unescape($name); + $students[$thisindex]=$name; + my ($sname,$sdom)=split(/\:/,$name); + $PreCol[$thisindex]=$sname.':'; + my $ssec=&usection($sdom,$sname,$cid,$Status); + if ($ssec==-1) { + $rowlabels[$thisindex]= + 'Data not available: '.$name; + } + else { + my %reply=&Apache::lonnet::idrget($sdom,$sname); + my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname. + ':environment:lastname&generation&firstname&middlename', + &Apache::lonnet::homeserver($sname,$sdom)); + #$ssec=(int($ssec)) ? int($ssec) : $ssec; + my $sec=sprintf('%3s',$ssec); + $rowlabels[$thisindex]=$sec.' '.$reply{$sname}.' '; + $PreCol[$thisindex] .= $reply.':'.$sec; + my $i=0; + foreach (split(/\&/,$reply)) { + $i++; + if ( $_ ne '') { + $rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' '; + } + if ($i == 2) { + chop($rowlabels[$thisindex]); + $rowlabels[$thisindex].=', '; + } + } + } + } + } - undef @rowlabels; - undef @students; - - my $classlst=&Apache::lonnet::reply - ('dump:'.$cdom.':'.$cnum.':classlist',$chome); - my $now=time; - unless ($classlst=~/^error\:/) { - map { - my ($name,$value)=split(/\=/,$_); - my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); - my $active=1; - if (($end) && ($now>$end)) { $active=0; } - if ($active) { - my $thisindex=$#students+1; - $name=&Apache::lonnet::unescape($name); - $students[$thisindex]=$name; - my ($sname,$sdom)=split(/\:/,$name); - my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid); - if ($ssec==-1) { - $rowlabels[$thisindex]= - 'Data not available: '.$name; - } else { - my %reply=&Apache::lonnet::idrget($sdom,$sname); - my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname. - ':environment:lastname&generation&firstname&middlename', - &Apache::lonnet::homeserver($sname,$sdom)); - $rowlabels[$thisindex]= - sprintf('%3s',$ssec).' '.$reply{$sname}.' '; - my $i=0; - map { - $i++; - if ( $_ ne '') { - $rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' '; - } - if ($i == 2) { - chop($rowlabels[$thisindex]); - $rowlabels[$thisindex].=', '; - } - } split(/\&/,$reply); + } else { + $r->print('

Could not access course data

'); + } + + my $allstudents=$#students+1; + $r->print('

'.$allstudents.' students

'); + &CreateForm(); + $r->rflush(); - } - } - } sort split(/\&/,$classlst); +# --------------- Find all assessments and put them into some linear-like order + &tracetable($firstres,'&'.$lastres.'&'); +# ----------------------------------------------------------------- Start table + $r->print('

');
+ 	my $index;
+        for ($index=0;$index<=$#students;$index++) {
+	    my $Str=&ExtractStudentData($index,$cid);
+	    $r->print($Str.'
');
+            $r->rflush();
+	    $CachData{$PreCol[$index]}=$Str;
+        }
+        $r->print('
'); } else { - $r->print('

Could not access course data

'); + $r->print('

Undefined course sequence

'); + } +} + +sub CreateForm { + my $OpSel1=''; + my $OpSel2=''; + my $OpSel3=''; + my $Status = $ENV{'form.status'}; + if ( $Status eq 'Any' ) { $OpSel3='selected'; } + elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; } + else { $OpSel1 = 'selected'; } + + my $Ptr = '
'."\n"; + $Ptr .= ' Sort by:   '."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '

'; + $Ptr .= ' Student Status:   '."\n". + ' '."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '
'."\n"; + $r->print( $Ptr ); +} + +sub CacheChart { + my %list = (); + my $count=0; + + my $Pos = $ENV{'form.sort'}; + if ( $Pos eq 'Last Name' ) {$Pos=1;} + elsif ( $Pos eq 'Section' ) {$Pos=2;} + else {$Pos=0;} + + foreach my $key( keys %CachData) { + my @Temp=split(/\:/,$key); + my $Use = $Temp[$Pos]; + $list{$Use.$key}=$key; + $count++; } - my $allstudents=$#students+1; - $r->print('

'.$allstudents.' students

'); + my @order = sort(keys(%list)); + + $r->print('

'.$count.' students

'); + &CreateForm(); $r->rflush(); + + $r->print('

');
+    for ( my $n; $n < $count; $n++) {
+	$r->print($CachData{$list{$order[$n]}}.'
');
+    }	
+    $r->print('
'); +} -# --------------- Find all assessments and put them into some linear-like order +sub Start { + undef %hash; + undef %CachData; + undef @students; + undef @cols; + undef @rowlabels; + undef @PreCol; - &tracetable($firstres,'&'.$lastres.'&'); + $r->print(''. + 'LON-CAPA Assessment Chart'); + $r->print(''. + ''. + ''. + '

Assessment Chart

'); +# ---------------------------------------------------------------- Course title + $r->print('

'.$ENV{'course.'.$ENV{'request.course.id'}. + '.description'}.'

'.localtime(). + "

1..9: correct by student in 1..9 tries\n".
+              "   *: correct by student in more than 9 tries\n".
+	      "   +: correct by override\n".
+              "   -: incorrect by override\n".
+	      "   .: incorrect attempted\n".
+	      "   #: ungraded attempted\n".
+              "    : not attempted\n".
+	      "   x: excused

"); +# ------------------------------- This is going to take a while, produce output + $r->rflush(); -# ----------------------------------------------------------------- Start table + my $cid=$ENV{'request.course.id'}; + my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". + "_$ENV{'user.domain'}_$cid\_chart.db"; + + if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) { + if (tie(%CachData,'GDBM_File',"$ChartDB",&GDBM_READER,0640)) { + &CacheChart(); + } + else { + $r->print("Unable to tie hash to db file"); + } + } + else { + if (tie(%CachData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) { + foreach (keys %CachData) {delete $CachData{$_};} + &BuildChart(); + } + else { + $r->print("Unable to tie hash to db file"); + } + } + untie(%CachData); +} - $r->print('

');
- 			  my $index;
-                           for ($index=0;$index<=$#students;$index++) {
-                              $r->print(&ExtractStudentData($index,$cid).'
');
-                              $r->rflush();
-                          }
-                          $r->print('
'); +# ================================================================ Main Handler - } else { - $r->print('

Undefined course sequence

'); - } +sub handler { + $r=shift; + if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { +# ------------------------------------------- Set document type for header only + if ($r->header_only) { + if ($ENV{'browser.mathml'}) { + $r->content_type('text/xml'); + } else { + $r->content_type('text/html'); + } + &Apache::loncommon::no_cache($r); + $r->send_http_header; + return OK; + } - $r->print(''); - + my $requrl=$r->uri; +# ----------------------------------------------------------------- Tie db file + if ($ENV{'request.course.fn'}) { + my $fn=$ENV{'request.course.fn'}; + if (-e "$fn.db") { + if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) { +# ------------------------------------------------------------------- Hash tied +# ---------------------------------------------------------------- Send headers + $r->content_type('text/html'); + $r->send_http_header; + &Start(); + $r->print(''); # ------------------------------------------------------------- End render page - } else { - $r->content_type('text/html'); - $r->send_http_header; - $r->print('Coursemap undefined.'); - } + } else { + $r->content_type('text/html'); + $r->send_http_header; + $r->print('Coursemap undefined.'); + } # ------------------------------------------------------------------ Untie hash - unless (untie(%hash)) { - &Apache::lonnet::logthis("WARNING: ". - "Could not untie coursemap $fn (browse)."); - } + unless (untie(%hash)) { + &Apache::lonnet::logthis("WARNING: ". + "Could not untie coursemap $fn (browse)."); + } # -------------------------------------------------------------------- All done - return OK; + return OK; # ----------------------------------------------- Errors, hash could no be tied - } - } else { - $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; - return HTTP_NOT_ACCEPTABLE; -} -} else { - $ENV{'user.error.msg'}= + } + } else { + $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; + return HTTP_NOT_ACCEPTABLE; + } + } else { + $ENV{'user.error.msg'}= $r->uri.":vgr:0:0:Cannot view grades for complete course"; - return HTTP_NOT_ACCEPTABLE; - -} + return HTTP_NOT_ACCEPTABLE; + } } 1; __END__ - - - - - - - 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.