# The LearningOnline Network with CAPA # (Publication Handler # # $Id: lonchart.pm,v 1.40 2002/05/30 13:08:34 stredwic 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 # # (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/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 { my ($index,$coid)=@_; my ($sname,$sdom) = split( /\:/, $students[$index] ); my %result=&Apache::lonnet::dump($coid,$sdom,$sname); my $ResId; my $Code; my $Tries; my $Wrongs; my %TempHash; my $Version; my $ProbNo; my $ProbSolved; my $ProbTotal; my $LatestVersion; my $Str=substr($students[$index]. ' ',0,14).' ! '. substr($rowlabels[$index]. ' ',0,45).' ! '; my($checkForError)=keys (%result); if($checkForError =~ /^(con_lost|error|no_such_host)/i) { my $PrTot = sprintf( "%5d", $ProbTotal ); my $PrSvd = sprintf( "%5d", $ProbSolved ); $Str .= ' '.''.$PrSvd.' /'.$PrTot.' '; return $Str; } $ProbNo = 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.' '; $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::symbclean( &Apache::lonnet::declutter($hash{'map_id_'.$1} ). '___'.$2.'___'. &Apache::lonnet::declutter( $hash{'src_'.$ResId} )); $Code=' '; $Tries = 0; $LatestVersion = $result{"version:$Prob"}; 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; $Tries = $result{"$Version:$Prob:resource.$Part.tries"}; $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; } } } # Actually append problem to output (all parts) $Str.=''; for ( my $n = 0; $n < $PartNo; $n++ ) { my $part = $TempHash{$n}; my $Code = $TempHash{"$part.Code"}; if ( $Code eq '*') { $ProbNo++; if (($TempHash{"$part.Tries"}<10) || ($TempHash{"$part.Tries"} eq '')) { $TempHash{"$part.Code"}=$TempHash{"$part.Tries"}; } } elsif ( $Code eq '+' ) {$ProbNo++;} $Str .= $TempHash{"$part.Code"}; if ( $Code ne 'x' ) {$ProbTotal++;} } $Str.=''; } else { for(my $n=0; $n<$PartNo; $n++) { $Str.=' '; $ProbTotal++; } } } my $PrTot = sprintf( "%5d", $ProbTotal ); my $PrSvd = sprintf( "%5d", $ProbSolved ); $Str .= ' '.''.$PrSvd.' /'.$PrTot.' '; return $Str ; } # ------------------------------------------------------------ Build page table sub tracetable { my ($rid,$beenhere)=@_; unless ($beenhere=~/\&$rid\&/) { $beenhere.=$rid.'&'; # new ... updating the map according to sequence and page if (defined($hash{'is_map_'.$rid})) { my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}; if ( $cmap eq 'sequence' || $cmap eq 'page' ) { $cols[$#cols+1]=0; } if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) && (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) { my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; &tracetable($hash{'map_start_'.$hash{'src_'.$rid}}, '&'.$frid.'&'); if ($hash{'src_'.$frid}) { if ($hash{'src_'.$frid}=~ /\.(problem|exam|quiz|assess|survey|form)$/) { $cols[$#cols+1]=$frid; } } } } else { if ($hash{'src_'.$rid}) { if ($hash{'src_'.$rid}=~ /\.(problem|exam|quiz|assess|survey|form)$/) { $cols[$#cols+1]=$rid; } } } if (defined($hash{'to_'.$rid})) { foreach (split(/\,/,$hash{'to_'.$rid})){ &tracetable($hash{'goesto_'.$_},$beenhere); } } } } sub usection { my ($udom,$unam,$courseid,$ActiveFlag)=@_; $courseid=~s/\_/\//g; $courseid=~s/^(\w)/\/$1/; my %result=&Apache::lonnet::dump('roles',$udom,$unam); my($checkForError)=keys (%result); if($checkForError =~ /^(con_lost|error|no_such_host)/i) { return -1; } foreach my $key (keys (%result)) { my $value = $result{$key}; if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) { my $section=$1; if ($key eq $courseid.'_st') { $section=''; } my ($dummy,$end,$start)=split(/\_/,$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)) { # ----------------------------------------------------------------- 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 %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum); my($checkForError)=keys (%classlist); if($checkForError =~ /^(con_lost|error|no_such_host)/i) { $r->print('
'); my $index; for ($index=0;$index<=$#students;$index++) { my $Str=&ExtractStudentData($index,$cid); $r->print($Str.''); } else { $r->print('
'); $r->rflush(); $CachData{$PreCol[$index]}=$Str; } $r->print('
'); for ( my $n; $n < $count; $n++) { $r->print($CachData{$list{$order[$n]}}.''); } sub Start { undef %hash; undef %CachData; undef @students; undef @cols; undef @rowlabels; undef @PreCol; $r->print('
'); } $r->print('
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(); 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); } # ================================================================ 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.'); } # ------------------------------------------------------------------ Untie hash unless (untie(%hash)) { &Apache::lonnet::logthis("WARNING: ". "Could not untie coursemap $fn (browse)."); } # -------------------------------------------------------------------- All done 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'}= $r->uri.":vgr:0:0:Cannot view grades for complete course"; return HTTP_NOT_ACCEPTABLE; } } 1; __END__