--- loncom/interface/Attic/lonchart.pm 2002/06/05 05:05:38 1.43 +++ loncom/interface/Attic/lonchart.pm 2002/06/28 18:06:14 1.44 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # (Publication Handler # -# $Id: lonchart.pm,v 1.43 2002/06/05 05:05:38 stredwic Exp $ +# $Id: lonchart.pm,v 1.44 2002/06/28 18:06:14 stredwic Exp $ # # Copyright Michigan State University Board of Trustees # @@ -55,167 +55,191 @@ use Apache::loncommon(); use HTML::TokeParser; use GDBM_File; -# -------------------------------------------------------------- Module Globals -my %hash; -my %CachData; -my @cols; -my $r; -my $c; - -# ------------------------------------------------------------- Find out status +#my $jr; +# ----- FORMAT PRINT DATA ---------------------------------------------- -sub ExtractStudentData { - my ($name,$coid)=@_; +sub FormatStudentInformation { + my ($cache,$name,$studentInformation,$spacePadding)=@_; + my $Str='
';
+
+    foreach (@$studentInformation) {
+	my $data=$cache->{$name.':'.$_};
+	$Str .= $data;
+
+	my @dataLength=split(//,$data);
+	my $length=scalar @dataLength;
+	$Str .= (' 'x($cache->{$_.'Length'}-$length));
+	$Str .= $spacePadding;
+    }
+
+    return $Str;
+}
+
+sub FormatStudentData {
+    my ($name,$coid,$studentInformation,$spacePadding,$ChartDB)=@_;
     my ($sname,$sdom) = split(/\:/,$name);
-    my $ResId;
-    my $Code;
-    my $Tries;
-    my $Wrongs;
-    my %TempHash;
-    my $Version;
-    my $problemsCorrect;
-    my $problemsSolved;
-    my $totalProblems;
-    my $LatestVersion;
     my $Str;
+    my %CacheData;
 
+    unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
+        return '';
+    }
     # Handle Student information ------------------------------------------
+    # Handle user data
+    $Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation, 
+                                   $spacePadding);
+
     # Handle errors
-#    if($CachData{$name.':error'} =~ /environment/) {
-#	my $errorMessage = $CachData{$name.':error'};
+    if($CacheData{$name.':error'} =~ /environment/) {
+        untie(%CacheData);
+        $Str .= '
'; + return $Str; +# my $errorMessage = $CacheData{$name.':error'}; # return ''.$sname.''.$sdom. # ''.$errorMessage.''; -# } - - # Handle user data - $Str = '
'.$sname.'
'.$sdom;
-    $Str .= '
'.$CachData{$name.':section'};
-    $Str .= '
'.$CachData{$name.':id'};
-    $Str .= '
'.$CachData{$name.':fullname'};
-    $Str .= '
'; + } - if($CachData{$name.':error'} =~ /course/) { + if($CacheData{$name.':error'} =~ /course/) { + untie(%CacheData); + $Str .= ''; return $Str; # my $errorMessage = 'May have no course data or '. -# $CachData{$name.':error'}; +# $CacheData{$name.':error'}; # return ''.$sname.''.$sdom. # ''.$errorMessage.''; } # Handle problem data ------------------------------------------------ - $Str .= '
';
-    $problemsCorrect = 0;
-    $totalProblems = 0;
-    $problemsSolved = 0;
-    my $IterationNo = 0;
-    foreach $ResId (@cols) {
-	if ($IterationNo == 0) {
-	    # Looks to be skipping start resource
-	    $IterationNo++; 
-	    next;
-	}
-
-	# ResId is 0 for sequences and pages, 
-	# please check tracetable for changes
-	if (!$ResId) {
-	    my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
-	    $Str .= ''.$outputProblemsCorrect.
-		    '
'; - $Str .= '
';
-	    $problemsSolved += $problemsCorrect;
-	    $problemsCorrect=0;
-	    next; 
-	}
-
-	# Set $1 and $2
-	$ResId=~/(\d+)\.(\d+)/;
-	my $meta=$hash{'src_'.$ResId};
-	my $numberOfParts = 0;
-	undef %TempHash;
-	foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
-#----------- Overwrite $1 in next statement ---------------------------------
-	    if ($_=~/^stores\_(\d+)\_tries$/) {
-		my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
-		if ( $TempHash{"$Part"} eq '' ) { 
-		    $TempHash{"$Part"} = $Part;
-		    $TempHash{$numberOfParts}=$Part;
-		    $TempHash{"$Part.Code"} = ' ';  
-		    $numberOfParts++;
-		}
-	    }
-	}
-
-#----------- Using $1 and $2 -----------------------------------------------
-	my $Prob = &Apache::lonnet::symbclean(
-		       &Apache::lonnet::declutter($hash{'map_id_'.$1} ).
-                       '___'.$2.'___'.
-                       &Apache::lonnet::declutter( $hash{'src_'.$ResId} ));
-	$Code=' ';
-	$Tries = 0;
-	$LatestVersion = $CachData{$name.":version:$Prob"};
-
-	if ( $LatestVersion ) {
-	    for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
-		my $vkeys = $CachData{$name.":$Version:keys:$Prob"};
-		my @keys = split(/\:/,$vkeys);		  
-
-		foreach my $Key (@keys) {
-#---------------------- Changing $1 -------------------------------------------
-		    if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
-#---------------------- Using $1 -----------------------------------------------
-			my $Part = $1;
-			$Tries = $CachData{$name.":$Version:$Prob".
-					   ":resource.$Part.tries"};
-			$TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;
-			my $Val = $CachData{$name.":$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 = ' ';}
+    my $Version;
+    my $problemsCorrect = 0;
+    my $totalProblems   = 0;
+    my $problemsSolved  = 0;
+    my $numberOfParts   = 0;
+    foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
+	my $characterCount=0;
+	foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) {
+	    my $problem = $CacheData{$problemID.':problem'};
+	    my $LatestVersion = $CacheData{$name.":version:$problem"};
+
+            if(!$LatestVersion) {
+                foreach my $part (split(/\:/,$CacheData{$sequence.':'.
+                                                        $problemID.
+                                                        ':parts'})) {
+                    $Str .= ' ';
+                    $totalProblems++;
+                    $characterCount++;
+                }
+                next;
+            }
+
+            my %partData=undef;
+            #initialize data, displays skips correctly
+            foreach my $part (split(/\:/,$CacheData{$sequence.':'.
+                                                    $problemID.
+                                                    ':parts'})) {
+                $partData{$part.':tries'}=0;
+                $partData{$part.':code'}=' ';
+            }
+	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
+                foreach my $part (split(/\:/,$CacheData{$sequence.':'.
+                                                        $problemID.
+                                                        ':parts'})) {
+
+                    if(!defined($CacheData{$name.":$Version:$problem".
+                                               ":resource.$part.solved"})) {
+                        next;
+                    }
+
+                    my $tries=0;
+                    my $code=' ';
+
+                    $tries = $CacheData{$name.":$Version:$problem".
+                                        ":resource.$part.tries"};
+                    $partData{$part.':tries'}=($tries) ? $tries : 0;
+
+                    my $val = $CacheData{$name.":$Version:$problem".
+                                         ":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 = ' ';}
+                    $partData{$part.':code'}=$code;
+                }
+            }
 
-			$TempHash{"$Part.Code"} = $Code;
-		    }
-		}
-	    }
-# Actually append problem to output (all parts)
-	    $Str.=''; 
-	    for(my $n = 0; $n < $numberOfParts; $n++) {		  
-		my $part = $TempHash{$n};
-		my $code2 = $TempHash{"$part.Code"};
-		if($code2 eq '*') {
-		    $problemsCorrect++;
-# !!!!!!!!!!!------------------------- Should 10 not be maxtries? ------------
-		    if (($TempHash{"$part.Tries"}<10) ||
-			($TempHash{"$part.Tries"} eq '')) {
-			$TempHash{"$part.Code"}=$TempHash{"$part.Tries"};
-		    }
-		} elsif($code2 eq '+') {
-		    $problemsCorrect++;
-		}
+            foreach(split(/\:/,$CacheData{$sequence.':'.$problemID.
+                                          ':parts'})) {
+                if($partData{$_.':code'} eq '*') {
+                    $problemsCorrect++;
+                    if (($partData{$_.':tries'}<10) &&
+                        ($partData{$_.':tries'} ne '')) {
+                        $partData{$_.':code'}=$partData{$_.':tries'};
+                    }
+                } elsif($partData{$_.':code'} eq '+') {
+                    $problemsCorrect++;
+                }
+
+                $Str .= $partData{$_.':code'};
+                $characterCount++;
+
+                if($partData{$_.':code'} ne 'x') {
+                    $totalProblems++;
+                }
+            }
+            $Str.='';
+        }
+
+        my $spacesNeeded=$CacheData{$sequence.':columnWidth'}-$characterCount;
+        $spacesNeeded -= 3;
+        $Str .= (' 'x$spacesNeeded);
+
+	my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
+	$Str .= ''.$outputProblemsCorrect.'';
+	$problemsSolved += $problemsCorrect;
+	$problemsCorrect=0;
+
+        $Str .= $spacePadding;
+    }
 
-		$Str .= $TempHash{"$part.Code"};
+    $Str .= ''.$problemsSolved.
+	    ' / '.$totalProblems.'
'; - if($code2 ne 'x') { - $totalProblems++; - } - } - $Str.=''; - } else { - for(my $n=0; $n<$numberOfParts; $n++) { - $Str.=' '; - $totalProblems++; - } - } + untie(%CacheData); + return $Str; +} + +sub CreateTableHeadings { + my ($CacheData,$studentInformation,$headings,$spacePadding)=@_; + my $Str='
';
+
+    for(my $index=0; $index<(scalar @$headings); $index++) {
+	my $data=$$headings[$index];
+	$Str .= $data;
+
+	my @dataLength=split(//,$data);
+	my $length=scalar @dataLength;
+	$Str .= (' 'x($CacheData->{$$studentInformation[$index].'Length'}-
+                      $length));
+	$Str .= $spacePadding;
+    }
+
+    foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
+	$Str .= $CacheData->{$sequence.':title'};
+	my @titleLength=split(//,$CacheData->{$sequence.':title'});
+	my $leftover=$CacheData->{$sequence.':columnWidth'}-
+                     (scalar @titleLength);
+	$Str .= (' 'x$leftover);
+	$Str .= $spacePadding;
     }
 
-    $Str .= '
'.$problemsSolved.
-	    ' / '.$totalProblems.'
'; + $Str .= 'Total Solved/Total Problems'; + $Str .= '
'; return $Str; } @@ -229,14 +253,14 @@ sub CreateForm { elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; } else { $OpSel1 = 'selected'; } - my $Ptr = '
'."\n"; + my $Ptr = ''."\n"; $Ptr .= ' Sort by:   '."\n"; $Ptr .= '   '; - $Ptr .= ''."\n"; + $Ptr .= ''."\n"; $Ptr .= '   '; - $Ptr .= ''."\n"; + $Ptr .= ''."\n"; $Ptr .= '   '; - $Ptr .= ''."\n"; + $Ptr .= ''."\n"; $Ptr .= '

'; $Ptr .= ' Student Status:   '."\n". ' '."\n"; $Ptr .= '   '; - $Ptr .= ''."\n"; + $Ptr .= ''; + $Ptr .= "\n"; $Ptr .= '
'."\n"; - $r->print( $Ptr ); + + return $Ptr; } -sub CreateTableHeadings { - $r->print(''); - $r->print('User Name'); - $r->print('Domain'); - $r->print('Section'); - $r->print('PID'); - $r->print('Full Name'); - - my $ResId; - my $IterationNo = 0; - foreach $ResId (@cols) { - if ($IterationNo == 0) {$IterationNo++; next;} - if (!$ResId) { -# my $PrNo = sprintf( "%3d", $ProbNo ); -# $Str .= 'Chapter '.$PrNo.''; - $r->print('Chapter '.'0'.''); - } - } +sub CreateLegend { + my $Str = '

'.$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

"; + return $Str; +} - $r->print(''); - $r->rflush(); +sub StartDocument { + my $Str = ''; + $Str .= ''; + $Str .= ''; + $Str .= 'LON-CAPA Assessment Chart'; + $Str .= ''; + $Str .= ''; + $Str .= ''; + $Str .= '

Assessment Chart

'; - return; + return $Str; } -# ------------------------------------------------------------ Build page table +# ----- END FORMAT PRINT DATA ------------------------------------------ + +# ----- DOWNLOAD INFORMATION ------------------------------------------- + +sub DownloadPrerequisiteData { + my ($courseID, $c)=@_; + my ($courseDomain,$courseNumber)=split(/\_/,$courseID); + + my %classlist=&Apache::lonnet::dump('classlist',$courseDomain, + $courseNumber); + my ($checkForError)=keys (%classlist); + if($checkForError =~ /^(con_lost|error|no_such_host)/i) { + return \%classlist; + } + + foreach my $name (keys(%classlist)) { + if($c->aborted()) { + $classlist{'error'}='aborted'; + return \%classlist; + } + + my ($studentName,$studentDomain) = split(/\:/,$name); + # Download student environment data, specifically the full name and id. + my %studentInformation=&Apache::lonnet::get('environment', + ['lastname','generation', + 'firstname','middlename', + 'id'], + $studentDomain, + $studentName); + $classlist{$name.':studentInformation'}=\%studentInformation; -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); - } - } + if($c->aborted()) { + $classlist{'error'}='aborted'; + return \%classlist; + } + + #Section + my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName); + $classlist{$name.':section'}=\%section; } + + return \%classlist; } -sub usection { - my ($udom,$unam,$courseid,$ActiveFlag)=@_; - $courseid=~s/\_/\//g; - $courseid=~s/^(\w)/\/$1/; +sub DownloadStudentCourseInformation { + my ($name,$courseID)=@_; + my ($studentName,$studentDomain) = split(/\:/,$name); - my %result=&Apache::lonnet::dump('roles',$udom,$unam); + # Download student course data + my %courseData=&Apache::lonnet::dump($courseID,$studentDomain, + $studentName); + return \%courseData; +} - my($checkForError)=keys (%result); - if($checkForError =~ /^(con_lost|error|no_such_host)/i) { - return -1; +# ----- END DOWNLOAD INFORMATION --------------------------------------- + +# ----- END PROCESSING FUNCTIONS --------------------------------------- + +sub ProcessTopResourceMap { + my ($ChartDB,$c)=@_; + my %hash; + my $fn=$ENV{'request.course.fn'}; + if(-e "$fn.db") { + my $tieTries=0; + while($tieTries < 3) { + if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) { + last; + } + $tieTries++; + sleep 1; + } + if($tieTries >= 3) { + return 'Coursemap undefined.'; + } + } else { + return 'Can not open Coursemap.'; } + my %CacheData; + unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) { + untie(%hash); + return 'Could not tie cache hash.'; + } + + my (@sequences, @currentResource, @finishResource); + my ($currentSequence, $currentResourceID, $lastResourceID); + + $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}}; + $lastResourceID=-1; + $currentSequence=-1; + my $topLevelSequenceNumber = $currentSequence; + + while(1) { + if($c->aborted()) { + last; + } + # HANDLE NEW SEQUENCE! + #if page || sequence + if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) { + push(@sequences, $currentSequence); + push(@currentResource, $currentResourceID); + push(@finishResource, $lastResourceID); + + $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}}; + $lastResourceID=$hash{'map_finish_'. + $hash{'src_'.$currentResourceID}}; + $currentResourceID=$hash{'map_start_'. + $hash{'src_'.$currentResourceID}}; + + if(!($currentResourceID) || !($lastResourceID)) { + $currentSequence=pop(@sequences); + $currentResourceID=pop(@currentResource); + $lastResourceID=pop(@finishResource); + if($currentSequence eq $topLevelSequenceNumber) { + last; + } + } + } + + # Handle gradable resources: exams, problems, etc + $currentResourceID=~/(\d+)\.(\d+)/; + my $partA=$1; + my $partB=$2; + if($hash{'src_'.$currentResourceID}=~ + /\.(problem|exam|quiz|assess|survey|form)$/ && + $partA eq $currentSequence) { + my $Problem = &Apache::lonnet::symbclean( + &Apache::lonnet::declutter($hash{'map_id_'.$partA}). + '___'.$partB.'___'. + &Apache::lonnet::declutter($hash{'src_'. + $currentResourceID})); + + $CacheData{$currentResourceID.':problem'}=$Problem; + if(!defined($CacheData{$currentSequence.':problems'})) { + $CacheData{$currentSequence.':problems'}=$currentResourceID; + } else { + $CacheData{$currentSequence.':problems'}.= + ':'.$currentResourceID; + } + + #Get Parts for problem + my $meta=$hash{'src_'.$currentResourceID}; + foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { + if($_=~/^stores\_(\d+)\_tries$/) { + my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); + if(!defined($CacheData{$currentSequence.':'. + $currentResourceID.':parts'})) { + $CacheData{$currentSequence.':'.$currentResourceID. + ':parts'}=$Part; + } else { + $CacheData{$currentSequence.':'.$currentResourceID. + ':parts'}.=':'.$Part; + } + } + } + } + + #if resource == finish resource + if($currentResourceID eq $lastResourceID) { + #pop off last resource of sequence + $currentResourceID=pop(@currentResource); + #pop to get last resource in previous sequence + $currentResourceID=pop(@currentResource); + $lastResourceID=pop(@finishResource); + + if(defined($CacheData{$currentSequence.':problems'})) { + # Capture sequence information here + if(!defined($CacheData{'orderedSequences'})) { + $CacheData{'orderedSequences'}=$currentSequence; + } else { + $CacheData{'orderedSequences'}.=':'.$currentSequence; + } + + $CacheData{$currentSequence.':title'}= + $hash{'title_'.$currentResourceID}; + + my $totalProblems=0; + foreach (split(/\:/,$CacheData{$currentSequence. + ':problems'})) { + foreach ($CacheData{$currentSequence.':'.$_.':parts'}) { + $totalProblems++; + } + } + my @titleLength=split(//,$CacheData{$currentSequence. + ':title'}); + # $extra is 3 for problems correct and 3 for space + # between problems correct and problem output + my $extra = 6; + if(($totalProblems + $extra) > (scalar @titleLength)) { + $CacheData{$currentSequence.':columnWidth'}= + $totalProblems + $extra; + } else { + $CacheData{$currentSequence.':columnWidth'}= + (scalar @titleLength); + } + } + + $currentSequence=pop(@sequences); + if($currentSequence eq $topLevelSequenceNumber) { + last; + } + #else + } + + # MOVE!!! + #move to next resource + unless(defined($hash{'to_'.$currentResourceID})) { + # big problem, need to handle. Next is probably wrong + last; + } + my @nextResources=(); + foreach (split(/\,/,$hash{'to_'.$currentResourceID})) { + push(@nextResources, $hash{'goesto_'.$_}); + } + pop(@currentResource); + push(@currentResource, @nextResources); + # Set the next resource to be popped(processed) + $currentResourceID=$currentResource[-1]; + } + + unless (untie(%hash)) { + &Apache::lonnet::logthis("WARNING: ". + "Could not untie coursemap $fn (browse)". + "."); + } + + unless (untie(%CacheData)) { + &Apache::lonnet::logthis("WARNING: ". + "Could not untie Cache Hash (browse)". + "."); + } + + return 'OK'; +} + +sub ProcessSection { + my ($sectionData, $courseid,$ActiveFlag)=@_; + $courseid=~s/\_/\//g; + $courseid=~s/^(\w)/\/$1/; + my $cursection='-1'; my $oldsection='-1'; my $status='Expired'; - foreach my $key (keys (%result)) { - my $value = $result{$key}; + my $section=''; + foreach my $key (keys (%$sectionData)) { + my $value = $sectionData->{$key}; if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) { - my $section=$1; - if ($key eq $courseid.'_st') { $section=''; } + $section=$1; + if($key eq $courseid.'_st') { + $section=''; + } my ($dummy,$end,$start)=split(/\_/,$value); my $now=time; my $notactive=0; @@ -353,6 +569,7 @@ sub usection { if($notactive == 0) { $status='Active'; $cursection=$section; + last; } if($notactive == 1) { $oldsection=$section; @@ -374,38 +591,133 @@ sub usection { return '-1'; } +sub ProcessStudentInformation { + my ($CacheData,$studentInformation,$section,$date,$name,$courseID,$c)=@_; + my ($studentName,$studentDomain) = split(/\:/,$name); + + $CacheData->{$name.':username'}=$studentName; + $CacheData->{$name.':domain'}=$studentDomain; + $CacheData->{$name.':date'}=$date; + + my ($checkForError)=keys(%$studentInformation); + if($checkForError =~ /^(con_lost|error|no_such_host)/i) { + $CacheData->{$name.':error'}= + 'Could not download student environment data.'; + $CacheData->{$name.':fullname'}=''; + $CacheData->{$name.':id'}=''; + } else { + $CacheData->{$name.':fullname'}=&ProcessFullName( + $studentInformation->{'lastname'}, + $studentInformation->{'generation'}, + $studentInformation->{'firstname'}, + $studentInformation->{'middlename'}); + $CacheData->{$name.':id'}=$studentInformation->{'id'}; + } + + # Get student's section number + my $sec=&ProcessSection($section, $courseID, $ENV{'form.status'}); + if($sec != -1) { + $CacheData->{$name.':section'}=$sec; + } else { + $CacheData->{$name.':section'}=''; + } + + return 0; +} + +sub ProcessClassList { + my ($classlist,$courseID,$ChartDB,$c)=@_; + my @names=(); + + my %CacheData; + if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) { + foreach my $name (keys(%$classlist)) { + if($name =~ /\:section/ || $name =~ /\:studentInformation/) { + next; + } + if($c->aborted()) { + last; + } + push(@names,$name); + &ProcessStudentInformation( + \%CacheData, + $classlist->{$name.':studentInformation'}, + $classlist->{$name.':section'}, + $classlist->{$name}, + $name,$courseID,$c); + } + + $CacheData{'NamesOfStudents'}=join(":::",@names); +# $CacheData{'NamesOfStudents'}=&Apache::lonnet::arrayref2str(\@names); + untie(%CacheData); + } + + return @names; +} + +# ----- END PROCESSING FUNCTIONS --------------------------------------- + +# ----- HELPER FUNCTIONS ----------------------------------------------- + +sub SpaceColumns { + my ($students,$studentInformation,$headings,$ChartDB)=@_; + + my %CacheData; + if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) { + # Initialize Lengths + for(my $index=0; $index<(scalar @$headings); $index++) { + my @titleLength=split(//,$$headings[$index]); + $CacheData{$$studentInformation[$index].'Length'}= + scalar @titleLength; + } + + foreach my $name (@$students) { + foreach (@$studentInformation) { + my @dataLength=split(//,$CacheData{$name.':'.$_}); + my $length=scalar @dataLength; + if($length > $CacheData{$_.'Length'}) { + $CacheData{$_.'Length'}=$length; + } + } + } + untie(%CacheData); + } + + return; +} + sub ProcessFullName { - my ($name)=@_; + my ($lastname, $generation, $firstname, $middlename)=@_; my $Str = ''; - if($CachData{$name.':lastname'} ne '') { - $Str .= $CachData{$name.':lastname'}.' '; - if($CachData{$name.':generation'} ne '') { - $Str .= $CachData{$name.':generation'}; + if($lastname ne '') { + $Str .= $lastname.' '; + if($generation ne '') { + $Str .= $generation; } else { chop($Str); } $Str .= ', '; - if($CachData{$name.':firstname'} ne '') { - $Str .= $CachData{$name.':firstname'}.' '; + if($firstname ne '') { + $Str .= $firstname.' '; } - if($CachData{$name.':middlename'} ne '') { - $Str .= $CachData{$name.':middlename'}; + if($middlename ne '') { + $Str .= $middlename; } else { chop($Str); - if($CachData{$name.'firstname'} eq '') { + if($firstname eq '') { chop($Str); } } } else { - if($CachData{$name.':firstname'} ne '') { - $Str .= $CachData{$name.':firstname'}.' '; + if($firstname ne '') { + $Str .= $firstname.' '; } - if($CachData{$name.':middlename'} ne '') { - $Str .= $CachData{$name.':middlename'}.' '; + if($middlename ne '') { + $Str .= $middlename.' '; } - if($CachData{$name.':generation'} ne '') { - $Str .= $CachData{$name.':generation'}; + if($generation ne '') { + $Str .= $generation; } else { chop($Str); } @@ -414,90 +726,45 @@ sub ProcessFullName { return $Str; } -sub DownloadStudentInformation { - my ($name,$courseID)=@_; - my ($studentName,$studentDomain) = split(/\:/,$name); - my $checkForError; - my $key; - my $Status=$CachData{$name.':Status'}; - -#----------------------------------------------------------------- - # Download student environment data, specifically the full name and id. - my %studentInformation=&Apache::lonnet::get('environment', - ['lastname','generation', - 'firstname','middlename', - 'id'], - $studentDomain,$studentName); - if($c->aborted()) { - return; - } - ($checkForError)=keys (%studentInformation); - if($checkForError =~ /^(con_lost|error|no_such_host)/i) { - $CachData{$name.':error'}= - 'Could not download student environment data.'; -# return; - $CachData{$name.':lastname'}=''; - $CachData{$name.':generation'}=''; - $CachData{$name.':firstname'}=''; - $CachData{$name.':middlename'}=''; - $CachData{$name.':fullname'}=''; - $CachData{$name.':id'}=''; - } else { - $CachData{$name.':lastname'}=$studentInformation{'lastname'}; - $CachData{$name.':generation'}=$studentInformation{'generation'}; - $CachData{$name.':firstname'}=$studentInformation{'firstname'}; - $CachData{$name.':middlename'}=$studentInformation{'middlename'}; - $CachData{$name.':fullname'}=&ProcessFullName($name); - $CachData{$name.':id'}=$studentInformation{'id'}; - } - - # Download student course data - my %courseData=&Apache::lonnet::dump($courseID,$studentDomain, - $studentName); - if($c->aborted()) { - return; - } - ($checkForError)=keys (%courseData); - if($checkForError =~ /^(con_lost|error|no_such_host)/i) { - $CachData{$name.':error'}='Could not download course data.'; -# return; - } else { - foreach $key (keys (%courseData)) { - $CachData{$name.':'.$key}=$courseData{$key}; - } - } - - # Get student's section number - my $sec=&usection($studentDomain, $studentName, $courseID, $Status); - if($sec != -1) { - $CachData{$name.':section'}=sprintf('%3s',$sec); - } else { - $CachData{$name.':section'}=''; +sub SortStudents { + my ($CacheData)=@_; + my @students = split(/:::/,$CacheData->{'NamesOfStudents'}); +# my @students=&Apache::lonnet::str2array($CacheData->{'NamesOfStudents'}); + + my @sorted1Students=(); + foreach (@students) { + my ($end,$start)=split(/\:/,$CacheData->{$_.':date'}); + my $active=1; + my $now=time; + 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) { + push(@sorted1Students, $_); + } } - return; -} - -sub SortStudents { -# --------------------------------------------------------------- Sort Students my $Pos = $ENV{'form.sort'}; - my @students = split(/:::/,$CachData{'NamesOfStudents'}); my %sortData; - if($Pos eq 'Last Name') { - for(my $index=0; $index<$#students+1; $index++) { - $sortData{$CachData{$students[$index].':fullname'}}= - $students[$index]; + for(my $index=0; $index{$sorted1Students[$index].':fullname'}}= + $sorted1Students[$index]; } } elsif($Pos eq 'Section') { - for(my $index=0; $index<$#students+1; $index++) { - $sortData{$CachData{$students[$index].':section'}. - $students[$index]}=$students[$index]; + for(my $index=0; $index{$sorted1Students[$index].':section'}. + $sorted1Students[$index]}=$sorted1Students[$index]; } } else { # Sort by user name - for(my $index=0; $index<$#students+1; $index++) { - $sortData{$students[$index]}=$students[$index]; + for(my $index=0; $indexprint('

Could not access course data

'); - push (@names, 'error'); - return @names; + if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) { + $isCached = 1; + } else { + $isCached = 0; } -# ------------------------------------- Calculate Status and number of students - my $now=time; - foreach my $name (sort(keys(%classlist))) { - my $value=$classlist{$name}; - my ($end,$start)=split(/\:/,$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) { - push(@names,$name); - $CachData{$name.':Status'}=$Status; - } + while($tieTries < 3) { + my $result=0; + if($isCached) { + $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640); + } else { + $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640); + } + if($result) { + last; + } + $tieTries++; + sleep 1; + } + if($tieTries >= 3) { + return -1; } - $CachData{'NamesOfStudents'}=join(":::",@names); + untie(%testData); - return @names; + return $isCached; } -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)) { - $r->print('

Undefined course sequence

'); - return; +sub ExtractStudentData { + my ($courseData, $name, $ChartDB)=@_; + + my %CacheData; + if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) { + my ($checkForError) = keys(%$courseData); + if($checkForError =~ /^(con_lost|error|no_such_host)/i) { + $CacheData{$name.':error'}='Could not download course data.'; + } else { + foreach my $key (keys (%$courseData)) { + $CacheData{$name.':'.$key}=$courseData->{$key}; + } + } + untie(%CacheData); } -# --------------- Find all assessments and put them into some linear-like order - &tracetable($firstres,'&'.$lastres.'&'); + return; +} + +# ----- END HELPER FUNCTIONS -------------------------------------------- + +sub BuildChart { + my ($r)=@_; + my $c = $r->connection; -# ----------------------------------------------------------------- Render page - &CreateForm(); + # Start the lonchart document + $r->content_type('text/html'); + $r->send_http_header; + $r->print(&StartDocument()); + $r->rflush(); + # Test for access to the CacheData + my $isCached=0; my $cid=$ENV{'request.course.id'}; my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}". "_$ENV{'user.domain'}_$cid\_chart.db"; - my $isCached = 0; - my @students; - if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) { - if (tie(%CachData,'GDBM_File',"$ChartDB",&GDBM_READER,0640)) { - $isCached = 1; - @students=&SortStudents(); - } else { - $r->print("Unable to tie hash to db file"); - $r->rflush(); - return; - } + + $isCached=&TestCacheData($ChartDB); + if($isCached < 0) { + $r->print("Unable to tie hash to db file"); + $r->rflush(); + return; + } + + # Download class list information if not using cached data + my @students=(); + my @studentInformation=('username','domain','section','id','fullname'); + my @headings=('User Name','Domain','Section','PID','Full Name'); + my $spacePadding=' '; + if(!$isCached) { + my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c); + if($processTopResourceMapReturn ne 'OK') { + $r->print($processTopResourceMapReturn); + return; + } + if($c->aborted()) { return; } + my $classlist=&DownloadPrerequisiteData($cid, $c); + my ($checkForError)=keys(%$classlist); + if($checkForError =~ /^(con_lost|error|no_such_host)/i || + defined($classlist->{'error'})) { + return; + } + if($c->aborted()) { return; } + @students=&ProcessClassList($classlist,$cid,$ChartDB,$c); + if($c->aborted()) { return; } + &SpaceColumns(\@students,\@studentInformation,\@headings, + $ChartDB); + if($c->aborted()) { return; } + } + + # Sort students and print out table desciptive data + my %CacheData; + if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) { + if(!$c->aborted()) { @students=&SortStudents(\%CacheData); } + if(!$c->aborted()) { $r->print(&CreateLegend()); } + if(!$c->aborted()) { $r->print(&CreateForm()); } + if(!$c->aborted()) { $r->print('

'.(scalar @students). + ' students

'); } + if(!$c->aborted()) { $r->rflush(); } + if(!$c->aborted()) { $r->print(&CreateTableHeadings( + \%CacheData, + \@studentInformation, + \@headings, + $spacePadding)); } + untie(%CacheData); } else { - if (tie(%CachData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640)) { - $isCached = 0; - @students=&CollectClasslist(); - if($students[0] eq 'error') { - return; - } - } else { - $r->print("Unable to tie hash to db file"); - return; - } + $r->print("Init2: Unable to tie hash to db file"); + return; } - $r->print('

'.($#students+1).' students

'); - $r->rflush(); - -# ----------------------------------------------------------------- Start table - $r->print(''); -# &CreateTableHeadings(); my @updateStudentList = (); - foreach my $student (@students) { - if($c->aborted()) { - if($isCached == 0) { - $CachData{'NamesOfStudents'}=join(":::",@updateStudentList); - } - last; - } - if($isCached == 0) { - &DownloadStudentInformation($student,$cid); - push (@updateStudentList, $student); - } - my $Str=&ExtractStudentData($student,$cid); - $r->print(''.$Str.''); + my $courseData; + foreach (@students) { + if($c->aborted()) { + if(!$isCached && + tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) { + $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList); +# $CacheData{'NamesOfStudents'}= +# &Apache::lonnet::arrayref2str(\@updateStudentList); + untie(%CacheData); + } + last; + } + + if(!$isCached) { + $courseData=&DownloadStudentCourseInformation($_, $cid); + if($c->aborted()) { next; } + push(@updateStudentList, $_); + &ExtractStudentData($courseData, $_, $ChartDB); + } + $r->print(&FormatStudentData($_, $cid, \@studentInformation, + $spacePadding, $ChartDB)); + $r->rflush(); } - $r->print('
'); - - untie(%CachData); - return; -} - -sub Start { - $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->print(''); $r->rflush(); - &BuildChart(); - - $r->print(''); - return; } # ================================================================ Main Handler sub handler { - undef %hash; - undef %CachData; - undef @cols; - - $r=shift; - $c = $r->connection; - 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; - $r->print(''); - &Start(); - $r->print(''); - $r->rflush(); -# ------------------------------------------------------------- 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 { + my $r=shift; +# $jr=$r; + unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { $ENV{'user.error.msg'}= $r->uri.":vgr:0:0:Cannot view grades for complete course"; return HTTP_NOT_ACCEPTABLE; } + + # 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; + } + + unless($ENV{'request.course.fn'}) { + my $requrl=$r->uri; + $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; + return HTTP_NOT_ACCEPTABLE; + } + + &BuildChart($r); + + return OK; } 1; __END__