--- loncom/interface/Attic/lonchart.pm 2001/11/28 16:36:08 1.16 +++ loncom/interface/Attic/lonchart.pm 2002/02/28 23:14:57 1.33 @@ -1,4 +1,31 @@ # The LearningOnline Network with CAPA +# (Publication Handler +# +# $Id: lonchart.pm,v 1.33 2002/02/28 23:14:57 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,32 +33,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) -# +# 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 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,30 +80,28 @@ sub ExtractStudentData { my %TempHash; my $Version; my $ProbNo; - my $PrTotal; - my $LatestVersion; - - my $test = $ENV{'request.course.fn'}; - my $comp = '/home/httpd/perl/tmp/minaeibi_msu_12679c3ed543a25msul1'; - + 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; - $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; } @@ -78,7 +109,7 @@ sub ExtractStudentData { my $meta=$hash{'src_'.$ResId}; my $PartNo = 0; undef %TempHash; - map { + foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { if ($_=~/^stores\_(\d+)\_tries$/) { my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); if ( $TempHash{"$Part"} eq '' ) { @@ -88,7 +119,7 @@ sub ExtractStudentData { $PartNo++; } } - } split(/\,/,&Apache::lonnet::metadata($meta,'keys')); + } my $Prob = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ). '___'.$2.'___'. @@ -106,39 +137,45 @@ sub ExtractStudentData { if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) { my $Part = $1; $Tries = $result{"$Version:$Prob:resource.$Part.tries"}; - if ($Tries) {$TempHash{"$Part.Tries"}=$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; -# if ($test=~/*minaeibi*/) { -# $r->print($Key." ,,, ".$Val."
$Version:$Prob:resource.$Part.tries".' = '.$result{"$Version:$Prob:resource.$Part.tries"}." $Val "."($Code)".'
'); -# } } } } - for ( my $n = 0; $n < $PartNo; $n++ ) { my $part = $TempHash{$n}; - if ($TempHash{$part.'.Code'} eq '*') { + my $Code = $TempHash{"$part.Code"}; + if ( $Code eq '*') { $ProbNo++; - if ($TempHash{$part.'.Tries'}<10) { - $TempHash{$part.'.Code'}=$Tries; + 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 {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 ; } @@ -180,182 +217,308 @@ 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 { - $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

'); +sub usection2 { + my ($udom,$unam,$courseid,$ActiveFlag)=@_; + $courseid=~s/\_/\//g; + $courseid=~s/^(\w)/\/$1/; + foreach my $elem(split(/\&/,&Apache::lonnet::reply('dump:'.$udom.':'.$unam.':roles', + &Apache::lonnet::homeserver($unam,$udom)))) { + my ($key,$value)=split(/\=/,$elem); + $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)); + my $now=time; + my $notactive=0; + if ($start) { + if ($now<$start) { $notactive=1; } + } + if ($end) { + if ($now>$end) { $notactive=1; } + } + if ($ActiveFlag == 1) { $notactive=0; } + unless ($notactive) { return $section; } + } + } + return '-1'; +} -# ---------------------------------------------------------------- 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)=@_; + $courseid=~s/\_/\//g; + $courseid=~s/^(\w)/\/$1/; + map { + 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)); +# $section=($section) ? $section : '(none)'; +# $section=(int($section)) ? int($section) : $section; +# $r->print($unam.'...'.$section.'
'); + return $section; + } + } split(/\&/,&Apache::lonnet::reply('dump:'.$udom.':'.$unam.':roles', + &Apache::lonnet::homeserver($unam,$udom))); + return ''; +} +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; + if (($end) && ($now>$end)) { $active=0; } + + if ($ENV{'form.active'} eq 'All Students') { $active=1; } + + 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);#,$active); + + 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=''; + if ( $ENV{'form.active'} eq 'All Students' ) { $OpSel2='selected'; } + else { $OpSel1 = 'selected'; } + + my $Ptr = '
'."\n"; + $Ptr .= ' Sort by:   '."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '   '; + $Ptr .= ''."\n"; + $Ptr .= '

'; + $Ptr .= ' Activation Area:   '."\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[$count]=$Use.$key.'*'.$CachData{$key}; + $count++; + } + + @list = sort (@list); - my $allstudents=$#students+1; - $r->print('

'.$allstudents.' students

'); + $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('
'); +} -# --------------- 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__