Annotation of loncom/interface/lonchart.pm, revision 1.4

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Homework Performance Chart
                      3: #
                      4: # (Navigate Maps Handler
                      5: #
                      6: # (Page Handler
                      7: #
                      8: # (TeX Content Handler
                      9: #
                     10: # 05/29/00,05/30 Gerd Kortemeyer)
                     11: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
                     12: # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
                     13: #
                     14: # 3/1/1,6/1,17/1,29/1,30/1 Gerd Kortemeyer)
                     15: #
                     16: # 1/31 Gerd Kortemeyer
                     17: 
                     18: package Apache::lonchart;
                     19: 
                     20: use strict;
                     21: use Apache::Constants qw(:common :http);
                     22: use Apache::lonnet();
                     23: use HTML::TokeParser;
                     24: use GDBM_File;
                     25: 
                     26: # -------------------------------------------------------------- Module Globals
                     27: my %hash;
                     28: my @cols;
                     29: my @rowlabels;
                     30: my @students;
                     31: 
                     32: # ------------------------------------------------------------- Find out status
                     33: 
                     34: sub astatus {
1.2       www        35:     my ($rid,$student)=@_;
                     36:     my ($uname,$udom)=split(/\:/,$student);
1.1       www        37:     my $code=' ';
                     38:     $rid=~/(\d+)\.(\d+)/;
                     39:     my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.
                     40: 	     &Apache::lonnet::declutter($hash{'src_'.$rid});
                     41:     my $answer=&Apache::lonnet::reply(
1.2       www        42:               "restore:$udom:$uname:".
1.1       www        43:               $ENV{'request.course.id'}.':'.
                     44:               &Apache::lonnet::escape($symb),
1.2       www        45:               &Apache::lonnet::homeserver($uname,$udom));
1.1       www        46:     my %returnhash=();
                     47:     map {
                     48: 	my ($name,$value)=split(/\=/,$_);
                     49:         $returnhash{&Apache::lonnet::unescape($name)}=
                     50:                     &Apache::lonnet::unescape($value);
                     51:     } split(/\&/,$answer);
                     52:     if ($returnhash{'version'}) {
                     53:        my $version;
                     54:        for ($version=1;$version<=$returnhash{'version'};$version++) {
                     55:           map {
                     56:              $returnhash{$_}=$returnhash{$version.':'.$_};
                     57:           } split(/\:/,$returnhash{$version.':keys'});
                     58:        }
                     59:        my $totaltries=0;
                     60:        map {
                     61:            if (($_=~/\.(\w+)\.solved$/) && ($_!~/^\d+\:/)) {
                     62:                my $part=$1;
                     63: 	       if ($returnhash{$_} eq 'correct_by_student') {
                     64:                    unless (($code eq '.') || ($code eq '-')) { $code='*'; }
                     65:                    $totaltries+=$returnhash{'resource.'.$part.'.tries'};
                     66:                } elsif ($returnhash{$_} eq 'correct_by_override') {
                     67:                    unless (($code eq '.') || ($code eq '-')) { $code='+'; }
                     68:                } elsif ($returnhash{$_} eq 'incorrect_attempted') {
                     69:                    $code='.';
                     70:                } elsif ($returnhash{$_} eq 'incorrect_by_override') {
                     71:                    $code='-';
                     72:                } elsif ($returnhash{$_} eq 'excused') {
                     73:                    unless (($code eq '.') || ($code eq '-')) { $code='x'; }
                     74:                }
                     75:            }
                     76:        } keys %returnhash;
                     77:        if (($code eq '*') && ($totaltries<10)) { $code="$totaltries"; }
                     78:     }
                     79:     return $code;
                     80: }
                     81: 
                     82: # ------------------------------------------------------------ Build page table
                     83: 
                     84: sub tracetable {
                     85:     my ($rid,$beenhere)=@_;
                     86:     unless ($beenhere=~/\&$rid\&/) {
                     87:        $beenhere.=$rid.'&';  
                     88:        if (defined($hash{'is_map_'.$rid})) {
                     89:            if ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}} 
                     90:             eq 'sequence') { 
                     91:                $cols[$#cols+1]=0; 
                     92:            }
                     93:            if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
                     94:                (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
                     95:               my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
                     96: 
                     97:                 &tracetable($hash{'map_start_'.$hash{'src_'.$rid}},
                     98:                 '&'.$frid.'&');
                     99: 
                    100:               if ($hash{'src_'.$frid}) {
                    101:                  if ($hash{'src_'.$frid}=~
                    102:                                  /\.(problem|exam|quiz|assess|survey|form)$/) {
                    103: 		     $cols[$#cols+1]=$frid;
                    104:                  }
                    105: 	      }
                    106: 
                    107: 	   }
                    108:        } else {
                    109:           if ($hash{'src_'.$rid}) {
                    110:              if ($hash{'src_'.$rid}=~
                    111:                                  /\.(problem|exam|quiz|assess|survey|form)$/) {
                    112: 	         $cols[$#cols+1]=$rid;
                    113:              }
                    114:           }
                    115:        }
                    116:        if (defined($hash{'to_'.$rid})) {
                    117:           map {
                    118:               &tracetable($hash{'goesto_'.$_},$beenhere);
                    119:           } split(/\,/,$hash{'to_'.$rid});
                    120:        }
                    121:     }
                    122: }
                    123: 
                    124: # ================================================================ Main Handler
                    125: 
                    126: sub handler {
                    127:   my $r=shift;
                    128: 
                    129:   if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
                    130: # ------------------------------------------- Set document type for header only
                    131: 
                    132:   if ($r->header_only) {
                    133:        if ($ENV{'browser.mathml'}) {
                    134:            $r->content_type('text/xml');
                    135:        } else {
                    136:            $r->content_type('text/html');
                    137:        }
                    138:        $r->send_http_header;
                    139:        return OK;
                    140:    }
                    141: 
                    142:   my $requrl=$r->uri;
                    143: # ----------------------------------------------------------------- Tie db file
                    144:   if ($ENV{'request.course.fn'}) {
                    145:       my $fn=$ENV{'request.course.fn'};
                    146:       if (-e "$fn.db") {
                    147:           if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
                    148: # ------------------------------------------------------------------- Hash tied
                    149: 
                    150: 
                    151: # ------------------------------------------------------------------ Build page
                    152: 
                    153: # ---------------------------------------------------------------- Send headers
                    154: 
                    155:              $r->content_type('text/html');
                    156:              $r->send_http_header;
                    157:              $r->print(
                    158:   '<html><head><title>LON-CAPA Assessment Chart</title></head>');
                    159: 
                    160: 	     $r->print('<body bgcolor="#FFFFFF">'.
                    161:                                     '<script>window.focus();</script>'.
                    162:                            '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
                    163:                                     '<h1>Assessment Chart</h1>');
                    164: 
                    165: # ---------------------------------------------------------------- Course title
                    166: 
                    167:     $r->print('<h1>'.
                    168:             $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'</h1>');
                    169: 
                    170: 
                    171: # ------------------------------- This is going to take a while, produce output
                    172: 
                    173:              $r->rflush();
                    174: 
                    175: # ----------------------- Get first and last resource, see if there is anything
                    176: 
                    177: 
                    178:               my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
                    179:               my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
                    180:               if (($firstres) && ($lastres)) {
                    181: # ----------------------------------------------------------------- Render page
                    182: 
                    183:                  my $cid=$ENV{'request.course.id'};
                    184:                  my $chome=$ENV{'course.'.$cid.'.home'};
                    185:                  my ($cdom,$cnum)=split(/\_/,$cid);
                    186: 
                    187: # ---------------------------------------------- Read class list and row labels
                    188: 
                    189:     undef @rowlabels;
                    190:     undef @students;
                    191: 
                    192:     my $classlst=&Apache::lonnet::reply
                    193:                                  ('dump:'.$cdom.':'.$cnum.':classlist',$chome);
                    194:     my $now=time;
                    195:     unless ($classlst=~/^error\:/) {
                    196:         map {
                    197:             my ($name,$value)=split(/\=/,$_);
                    198:             my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
                    199:             my $active=1;
                    200:             if (($end) && ($now>$end)) { $active=0; }
                    201:             if ($active) {
                    202:                 my $thisindex=$#students+1;
                    203:                 $name=&Apache::lonnet::unescape($name);
                    204:                 $students[$thisindex]=$name;
                    205:                 my ($sname,$sdom)=split(/\:/,$name);
                    206:                 my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
                    207:                 if ($ssec==-1) {
                    208:                     $rowlabels[$thisindex]=
                    209:                       'Data not available: '.$name;
                    210:                 } else {
                    211:                     my %reply=&Apache::lonnet::idrget($sdom,$sname);
1.3       albertel  212: 		    my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
                    213:                                                      ':environment:lastname&generation&firstname&middlename',
                    214:                                                      &Apache::lonnet::homeserver($sname,$sdom));
1.1       www       215:                     $rowlabels[$thisindex]=
1.3       albertel  216:                       sprintf('%3s',$ssec).' '.$reply{$sname}.' ';
                    217:                     my $i=0;
1.1       www       218:                     map {
1.3       albertel  219:                       $i++;
                    220:                       if ( $_ ne '') {
1.4     ! albertel  221:                         $rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' ';
1.3       albertel  222:                       }
                    223:                       if ($i == 2) {
                    224:                         chop($rowlabels[$thisindex]);
                    225:                         $rowlabels[$thisindex].=', ';
                    226:                       }
1.1       www       227:                     } split(/\&/,$reply);
1.4     ! albertel  228: 
        !           229:                 }
1.1       www       230:             }
                    231:         } sort split(/\&/,$classlst);
                    232: 
                    233:     } else {
                    234:         $r->print('<h1>Could not access course data</h1>');
                    235:     }
                    236: 
                    237:     my $allstudents=$#students+1;
                    238:     $r->print('<h3>'.$allstudents.' students</h3>');
                    239:     $r->rflush();
                    240: 
                    241: # --------------- Find all assessments and put them into some linear-like order
                    242: 
                    243:    &tracetable($firstres,'&'.$lastres.'&');
                    244: 
                    245: # ----------------------------------------------------------------- Start table
                    246: 
                    247:                           $r->print('<p><pre>');
                    248:  			  my $index;
                    249:                            for ($index=0;$index<=$#students;$index++) {
                    250:                               $r->print(
                    251:                                        substr($students[$index].
                    252:        '                                                        ',0,14).' ! '.
1.2       www       253:         			       substr($rowlabels[$index].
1.1       www       254:        '                                                        ',0,45).' ! ');
                    255:                               map {
                    256:                                   if ($_) {
                    257:                                      $r->print(&astatus($_,$students[$index]));
                    258:                                   } else {
                    259:                                      $r->print(' ! ');
                    260:                                   }
                    261:                               } @cols;
                    262:                               $r->print("\n");
                    263:                               $r->rflush();
                    264:                           }
                    265:                           $r->print('</pre>');
                    266: 
                    267: 	     } else {
                    268:                  $r->print('<h3>Undefined course sequence</h3>');
                    269:              }
                    270: 
                    271:                       $r->print('</body></html>');
                    272:                                      
                    273: # ------------------------------------------------------------- End render page
                    274:               } else {
                    275:                   $r->content_type('text/html');
                    276:                   $r->send_http_header;
                    277: 		  $r->print('<html><body>Coursemap undefined.</body></html>');
                    278:               }
                    279: # ------------------------------------------------------------------ Untie hash
                    280:               unless (untie(%hash)) {
                    281:                    &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                    282:                        "Could not untie coursemap $fn (browse).</font>"); 
                    283:               }
                    284: 
                    285: # -------------------------------------------------------------------- All done
                    286: 	      return OK;
                    287: # ----------------------------------------------- Errors, hash could no be tied
                    288:       }
                    289:   } else {
                    290:   $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
                    291:   return HTTP_NOT_ACCEPTABLE; 
                    292: }
                    293: } else {
                    294:       $ENV{'user.error.msg'}=
                    295:         $r->uri.":vgr:0:0:Cannot view grades for complete course";
                    296:       return HTTP_NOT_ACCEPTABLE; 
                    297: 
                    298: }
                    299: }
                    300: 1;
                    301: __END__
                    302: 
                    303: 
                    304: 
                    305: 
                    306: 
                    307: 
                    308: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>