--- loncom/interface/Attic/lonchart.pm 2002/02/06 16:59:50 1.29 +++ loncom/interface/Attic/lonchart.pm 2002/02/28 23:25:50 1.34 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # (Publication Handler # -# $Id: lonchart.pm,v 1.29 2002/02/06 16:59:50 minaeibi Exp $ +# $Id: lonchart.pm,v 1.34 2002/02/28 23:25:50 minaeibi Exp $ # # Copyright Michigan State University Board of Trustees # @@ -43,7 +43,7 @@ # 9/8 Gerd Kortemeyer # 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei # YEAR=2002 -# 2/1 Behrouz Minaei +# 2/1, 2/6, 2/19, 2/28 Behrouz Minaei # ### @@ -58,10 +58,13 @@ use GDBM_File; # -------------------------------------------------------------- Module Globals my %hash; +my %CachData; my @cols; my @rowlabels; my @students; - +my @PreCol; +my $r; + # ------------------------------------------------------------- Find out status sub ExtractStudentData { @@ -85,10 +88,10 @@ sub ExtractStudentData { 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; @@ -106,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 '' ) { @@ -116,7 +119,7 @@ sub ExtractStudentData { $PartNo++; } } - } split(/\,/,&Apache::lonnet::metadata($meta,'keys')); + } my $Prob = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ). '___'.$2.'___'. @@ -214,190 +217,311 @@ 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 { - - undef %hash; - undef @students; - undef @cols; - undef @rowlabels; - - 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'); - } - &Apache::loncommon::no_cache($r); - $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 +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'; +} - $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(); +sub usection { + my ($udom,$unam,$courseid)=@_; + $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)); +# $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].=', '; + } + } + } + } + } - 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)); - - #$ssec=(int($ssec)) ? int($ssec) : $ssec; - - $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

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

'.$allstudents.' students

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

');
- 			  my $index;
-                           for ($index=0;$index<=$#students;$index++) {
-                              $r->print(&ExtractStudentData($index,$cid).'
');
-                              $r->rflush();
-                          }
-                          $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

"); +# ------------------------------- This is going to take a while, produce output + $r->rflush(); - } else { - $r->print('

Undefined course sequence

'); - } + 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(''); - +# ================================================================ 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'); + } + &Apache::loncommon::no_cache($r); + $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 +# ---------------------------------------------------------------- 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__