--- loncom/interface/Attic/lonchart.pm 2001/12/18 22:22:13 1.25 +++ loncom/interface/Attic/lonchart.pm 2002/02/19 18:58:10 1.30 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # (Publication Handler # -# $Id: lonchart.pm,v 1.25 2001/12/18 22:22:13 minaeibi Exp $ +# $Id: lonchart.pm,v 1.30 2002/02/19 18:58:10 minaeibi Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,31 +33,37 @@ # (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) -# +# 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 -# 11/17/01, 11/22/01, 11/24/01, 11/28/01 Behrouz Minaei -# 12/18/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 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 @@ -74,7 +80,8 @@ sub ExtractStudentData { my %TempHash; my $Version; my $ProbNo; - my $PrTotal; + my $ProbSolved; + my $ProbTotal; my $LatestVersion; my $Str=substr($students[$index]. ' ',0,14).' ! '. @@ -86,14 +93,15 @@ sub ExtractStudentData { $result{$name}=$value; } split(/\&/,$reply); $ProbNo = 0; - $PrTotal = 0; + $ProbTotal = 0; + $ProbSolved = 0; my $IterationNo = 0; foreach $ResId (@cols) { if ($IterationNo == 0) {$IterationNo++; next;} if (!$ResId) { my $PrNo = sprintf( "%3d", $ProbNo ); $Str .= ' '.''.$PrNo.' '; - $PrTotal += $ProbNo; + $ProbSolved += $ProbNo; $ProbNo=0; next; } @@ -154,13 +162,20 @@ sub ExtractStudentData { } elsif ( $Code eq '+' ) {$ProbNo++;} $Str .= $TempHash{"$part.Code"}; + if ( $Code ne 'x' ) {$ProbTotal++;} } } - else {for(my $n=0; $n<$PartNo; $n++) {$Str.=' ';}} + else { + for(my $n=0; $n<$PartNo; $n++) { + $Str.=' '; + $ProbTotal++; + } + } } } - my $PrTot = sprintf( "%5d", $PrTotal ); - $Str .= ' '.''.$PrTot.' '; + my $PrTot = sprintf( "%5d", $ProbTotal ); + my $PrSvd = sprintf( "%5d", $ProbSolved ); + $Str .= ' '.''.$PrSvd.' /'.$PrTot.' '; return $Str ; } @@ -209,179 +224,238 @@ sub tracetable { } } -# ================================================================ Main Handler - -sub handler { - - undef %hash; - undef @students; - undef @cols; - undef @rowlabels; - my $r=shift; +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)) { +# ----------------------------------------------------------------- Render page + 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\:/) { + 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); + $PreCol[$thisindex]=$sname.':'; + 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)); + #$ssec=(int($ssec)) ? int($ssec) : $ssec; + $rowlabels[$thisindex]= + sprintf('%3s',$ssec).' '.$reply{$sname}.' '; + $PreCol[$thisindex] .= $reply.':'.$ssec; + my $i=0; + map { + $i++; + if ( $_ ne '') { + $rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' '; + } + if ($i == 2) { + chop($rowlabels[$thisindex]); + $rowlabels[$thisindex].=', '; + } + } split(/\&/,$reply); + } + } + } sort split(/\&/,$classlst); - if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { -# ------------------------------------------- Set document type for header only + } else { + $r->print('

Could not access course data

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

'.$allstudents.' students

'); + &CreateForm(); + $r->rflush(); - 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; - } +# --------------- Find all assessments and put them into some linear-like order + &tracetable($firstres,'&'.$lastres.'&'); +# ----------------------------------------------------------------- Start table - 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 + $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('

Undefined course sequence

'); + } +} +sub CreateForm { + my $Ptr = '
'."\n"; + $Ptr .= ' Sort by:   '."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '
'; + $Ptr .= ''."\n"; + $Ptr .= '
'."\n"; + $r->print( $Ptr ); +} -# ------------------------------------------------------------------ Build page +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[$count]=$Use.$key.'*'.$CachData{$key}; + $count++; + } -# ---------------------------------------------------------------- Send headers + @list = sort (@list); - $r->content_type('text/html'); - $r->send_http_header; - $r->print( - 'LON-CAPA Assessment Chart'); - - $r->print(''. - ''. - ''. - '

Assessment Chart

'); + $r->print('

'.$count.' students

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

');
+    for ( my $n; $n < $count; $n++) {
+	my ($dummy, $Line) = split(/\*/,$list[$n]);
+	$r->print($Line.'
');
+    }	
+    $r->print('
'); +} +sub Start { + undef %hash; + undef %CachData; + undef @students; + undef @cols; + undef @rowlabels; + undef @PreCol; + + $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

"); - + $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(); - -# ----------------------- 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)) { -# ----------------------------------------------------------------- Render page - - 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\:/) { - 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); - - } - } - } sort split(/\&/,$classlst); - - } else { - $r->print('

Could not access course data

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

'.$allstudents.' students

'); $r->rflush(); -# --------------- Find all assessments and put them into some linear-like order - - &tracetable($firstres,'&'.$lastres.'&'); - -# ----------------------------------------------------------------- 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__