[LON-CAPA-cvs] cvs: loncom /interface lonchart.pm
stredwic
lon-capa-cvs@mail.lon-capa.org
Wed, 29 May 2002 17:57:53 -0000
This is a MIME encoded message
--stredwic1022695073
Content-Type: text/plain
stredwic Wed May 29 13:57:53 2002 EDT
Modified files:
/loncom/interface lonchart.pm
Log:
Updated code to use lonnet::get and lonnet:dump instead of using lonnet::reply to gather the information. See bug report 480.
--stredwic1022695073
Content-Type: text/plain
Content-Disposition: attachment; filename="stredwic-20020529135753.txt"
Index: loncom/interface/lonchart.pm
diff -u loncom/interface/lonchart.pm:1.38 loncom/interface/lonchart.pm:1.39
--- loncom/interface/lonchart.pm:1.38 Thu May 9 13:06:09 2002
+++ loncom/interface/lonchart.pm Wed May 29 13:57:52 2002
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# (Publication Handler
#
-# $Id: lonchart.pm,v 1.38 2002/05/09 17:06:09 www Exp $
+# $Id: lonchart.pm,v 1.39 2002/05/29 17:57:52 stredwic Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -69,9 +69,7 @@
sub ExtractStudentData {
my ($index,$coid)=@_;
my ($sname,$sdom) = split( /\:/, $students[$index] );
- my $shome=&Apache::lonnet::homeserver( $sname,$sdom );
- my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$coid,$shome );
- my %result=();
+ my %result=&Apache::lonnet::dump($coid,$sdom,$sname);
my $ResId;
my $Code;
my $Tries;
@@ -86,98 +84,94 @@
' ',0,14).' ! '.
substr($rowlabels[$index].
' ',0,45).' ! ';
- unless ($reply=~/^error\:/) {
- foreach (split(/\&/,$reply)) {
- my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_));
- $result{$name}=$value;
- }
- $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 .= ' '.'<font color="#007700">'.$PrNo.'</font> ';
- $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++;
- }
+
+ $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 .= ' '.'<font color="#007700">'.$PrNo.'</font> ';
+ $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} ).
+ 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;
- }
- }
- }
+ $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.='<a href="/adm/grades?symb='.
+ $Str.='<a href="/adm/grades?symb='.
&Apache::lonnet::escape($Prob).
'&student='.$sname.'&domain='.$sdom.'&command=submission">';
- 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.='</a>';
- }
- else {
- for(my $n=0; $n<$PartNo; $n++) {
- $Str.=' ';
- $ProbTotal++;
+ 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.='</a>';
+ } else {
+ for(my $n=0; $n<$PartNo; $n++) {
+ $Str.=' ';
+ $ProbTotal++;
}
- }
+ }
}
+
my $PrTot = sprintf( "%5d", $ProbTotal );
my $PrSvd = sprintf( "%5d", $ProbSolved );
$Str .= ' '.'<font color="#000088">'.$PrSvd.' /'.$PrTot.'</font> ';
@@ -233,15 +227,14 @@
my ($udom,$unam,$courseid,$ActiveFlag)=@_;
$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);
+
+ my %result=&Apache::lonnet::dump('roles',$udom,$unam);
+ 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(/\_/,&Apache::lonnet::unescape($value));
+ my ($dummy,$end,$start)=split(/\_/,$value);
if ( $ActiveFlag ne 'Any' ) {
my $now=time;
my $notactive=0;
@@ -273,59 +266,49 @@
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 %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);
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;
- 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) {
- 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,$Status);
- 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].=', ';
- }
+ foreach my $name (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) {
+ my $thisindex=$#students+1;
+ $students[$thisindex]=$name;
+ my ($sname,$sdom)=split(/\:/,$name);
+ $PreCol[$thisindex]=$sname.':';
+ my $ssec=&usection($sdom,$sname,$cid,$Status);
+ if ($ssec==-1) {
+ $rowlabels[$thisindex]=
+ 'Data not available: '.$name;
+ } else {
+ my %reply=&Apache::lonnet::idrget($sdom,$sname);
+ my $reply=&Apache::lonnet::get('environment',
+ ['lastname','generation','firstname','middlename'],
+ $sdom,$sname);
+ #$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].=', ';
}
}
}
}
-
- } else {
- $r->print('<h1>Could not access course data</h1>');
}
my $allstudents=$#students+1;
--stredwic1022695073--