--- loncom/interface/Attic/lonchart.pm 2002/02/19 18:58:10 1.30 +++ loncom/interface/Attic/lonchart.pm 2002/06/03 19:28:17 1.41 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # (Publication Handler # -# $Id: lonchart.pm,v 1.30 2002/02/19 18:58:10 minaeibi Exp $ +# $Id: lonchart.pm,v 1.41 2002/06/03 19:28:17 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,7 +25,6 @@ # # http://www.lon-capa.org/ # -# # Homework Performance Chart # # (Navigate Maps Handler @@ -43,7 +42,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, 2/6, 2/19 Behrouz Minaei +# 2/1, 2/6, 2/19, 2/28 Behrouz Minaei # ### @@ -64,15 +63,13 @@ my @rowlabels; my @students; my @PreCol; my $r; - + # ------------------------------------------------------------- Find out status 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; @@ -87,92 +84,102 @@ sub ExtractStudentData { ' ',0,14).' ! '. substr($rowlabels[$index]. ' ',0,45).' ! '; - unless ($reply=~/^error\:/) { - map { - my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_)); - $result{$name}=$value; - } split(/\&/,$reply); - $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; - map { - 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($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++; } - } split(/\,/,&Apache::lonnet::metadata($meta,'keys')); + } + } - my $Prob = &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; - } - } - } - 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++;} + &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; + } } - } - else { - for(my $n=0; $n<$PartNo; $n++) { - $Str.=' '; - $ProbTotal++; + } +# 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.' '; @@ -217,13 +224,51 @@ sub tracetable { } } if (defined($hash{'to_'.$rid})) { - map { + foreach (split(/\,/,$hash{'to_'.$rid})){ &tracetable($hash{'goesto_'.$_},$beenhere); - } split(/\,/,$hash{'to_'.$rid}); + } } } } +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; + } + my $cursection='-1'; + my $oldsection='-1'; + my $status='Expired'; + 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); + my $now=time; + my $notactive=0; + if ($start) { if ($now<$start) { $notactive=1; } } + if ($end) { if ($now>$end) { $notactive=1; } } + if ($notactive == 0) { $status='Active';$cursection=$section;} + if ($notactive == 1) { $oldsection=$section;} + } + } + if ($status eq $ActiveFlag) { + if ($cursection eq '-1') { return $oldsection; } + return $cursection; + } + if ($ActiveFlag eq 'Any') { + if ($cursection eq '-1') { return $oldsection; } + return $cursection; + } + return '-1'; +} sub BuildChart { # ----------------------- Get first and last resource, see if there is anything @@ -235,51 +280,53 @@ sub BuildChart { 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\:/) { - map { - my ($name,$value)=split(/\=/,$_); - my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); + my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum); + + my($checkForError)=keys (%classlist); + if($checkForError =~ /^(con_lost|error|no_such_host)/i) { + $r->print('

Could not access course data

'); + } else { + my $now=time; + foreach my $name (sort(keys(%classlist))) { + my $value=$classlist{$name}; + my ($end,$start)=split(/\:/,$value); my $active=1; - if (($end) && ($now>$end)) { $active=0; } + 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=&Apache::lonnet::usection($sdom,$sname,$cid); + 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)); + my %name=&Apache::lonnet::get('environment', + ['lastname','generation' + ,'firstname' + ,'middlename'], + $sdom,$sname); + my $name=$name{lastname}; + if ($name{generation}) {$name.=" $name{generation}";} + $name.=','; + if ($name{firstname}) {$name.=" $name{firstname}";} + if ($name{middlename}) {$name.=" $name{middlename}";} + if ($name eq ',') {$name='';} #$ssec=(int($ssec)) ? int($ssec) : $ssec; - $rowlabels[$thisindex]= - sprintf('%3s',$ssec).' '.$reply{$sname}.' '; - $PreCol[$thisindex] .= $reply.':'.$ssec; - my $i=0; - map { - $i++; - if ( $_ ne '') { - $rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' '; - } - if ($i == 2) { - chop($rowlabels[$thisindex]); - $rowlabels[$thisindex].=', '; - } - } split(/\&/,$reply); + my $sec=sprintf('%3s',$ssec); + $rowlabels[$thisindex]=$sec.' '.$reply{$sname}.' '; + $PreCol[$thisindex] .= $name.':'.$sec; + $rowlabels[$thisindex].=$name.' '; } } - } sort split(/\&/,$classlst); - - } else { - $r->print('

Could not access course data

'); + } } my $allstudents=$#students+1; @@ -306,22 +353,36 @@ sub BuildChart { } sub CreateForm { + my $OpSel1=''; + my $OpSel2=''; + my $OpSel3=''; + my $Status = $ENV{'form.status'}; + if ( $Status eq 'Any' ) { $OpSel3='selected'; } + elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; } + else { $OpSel1 = 'selected'; } + my $Ptr = '
'."\n"; $Ptr .= ' Sort by:   '."\n"; $Ptr .= '   '; - $Ptr .= ''."\n"; + $Ptr .= ''."\n"; $Ptr .= '   '; $Ptr .= ''."\n"; $Ptr .= '   '; $Ptr .= ''."\n"; - $Ptr .= '
'; + $Ptr .= '

'; + $Ptr .= ' Student Status:   '."\n". + ' '."\n"; + $Ptr .= '   '; $Ptr .= ''."\n"; $Ptr .= '
'."\n"; $r->print( $Ptr ); } sub CacheChart { - my @list = (); + my %list = (); my $count=0; my $Pos = $ENV{'form.sort'}; @@ -332,11 +393,11 @@ sub CacheChart { foreach my $key( keys %CachData) { my @Temp=split(/\:/,$key); my $Use = $Temp[$Pos]; - $list[$count]=$Use.$key.'*'.$CachData{$key}; + $list{$Use.$key}=$key; $count++; } - @list = sort (@list); + my @order = sort(keys(%list)); $r->print('

'.$count.' students

'); &CreateForm(); @@ -344,8 +405,7 @@ sub CacheChart { $r->print('

');
     for ( my $n; $n < $count; $n++) {
-	my ($dummy, $Line) = split(/\*/,$list[$n]);
-	$r->print($Line.'
');
+	$r->print($CachData{$list{$order[$n]}}.'
');
     }	
     $r->print('
'); } @@ -459,10 +519,3 @@ sub handler { } 1; __END__ - - - - - - -