Return to lontrackstudent.pm CVS log

Up to [LON-CAPA] / loncom / interface

- can now see earlier records in track student

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lontrackstudent.pm,v 1.16 2005/06/30 17:56:28 albertel Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: ###
   28: 
   29: =pod
   30: 
   31: =head1 NAME
   32: 
   33: lontrackstudent
   34: 
   35: =head1 SYNOPSIS
   36: 
   37: Track student progress through course materials
   38: 
   39: =over 4
   40: 
   41: =cut
   42: 
   43: package Apache::lontrackstudent;
   44: 
   45: use strict;
   46: use Apache::Constants qw(:common :http);
   47: use Apache::lonmysql;
   48: use Apache::lonnet;
   49: use Apache::lonlocal;
   50: use Time::HiRes;
   51: 
   52: my $num_records=500;
   53: 
   54: sub get_data {
   55:     my ($r,$prog_state,$navmap,$mode) = @_;
   56:     ##
   57:     ## Compose the query
   58:     &Apache::lonhtmlcommon::Update_PrgWin
   59:         ($r,$prog_state,&mt('Composing Query'));
   60:     #
   61:     # Allow the other server to begin processing the data before we ask for it.
   62:     sleep(5);
   63:     #
   64:     my $max_time = &get_max_time_in_db($r,$prog_state);
   65:     if (defined($max_time)) {
   66:         $r->print('<h3>'.&mt('Activity data goes to [_1]',
   67:                              &Apache::lonlocal::locallocaltime($max_time)).
   68:                   '</h3>');
   69:         $r->rflush();
   70:     } else {
   71:         $r->print('<h3>'.&mt('Unable to retrieve any data.  Please reload this page and try again.').'</h3>');
   72:         return;
   73:     }
   74:     my $query = &build_query($mode);
   75:     ##
   76:     ## Send it along
   77:     my $home = $env{'course.'.$env{'request.course.id'}.'.home'};
   78:     my $reply=&Apache::lonnet::metadata_query($query,undef,undef,[$home]);
   79:     if (ref($reply) ne 'HASH') {
   80:         $r->print('<h2>'.
   81:                   &mt('Error contacting home server for course: [_1]',
   82:                       $reply).
   83:                   '</h2>');
   84:         return;
   85:     }
   86:     my $results_file = $r->dir_config('lonDaemons').'/tmp/'.$reply->{$home};
   87:     my $endfile = $results_file.'.end';
   88:     ##
   89:     ## Check for the results
   90:     &Apache::lonhtmlcommon::Update_PrgWin
   91:         ($r,$prog_state,&mt('Waiting for results'));
   92:     my $maxtime = 500;
   93:     my $starttime = time;
   94:     while (! -e $endfile && (time-$starttime < $maxtime)) {
   95:         &Apache::lonhtmlcommon::Update_PrgWin
   96:             ($r,$prog_state,&mt('Waiting up to [_1] seconds for results',
   97:                                 $starttime+$maxtime-time));
   98:         sleep(1);
   99:     }
  100:     if (! -e $endfile) {
  101:         $r->print('<h2>'.
  102:                   &mt('Unable to retrieve data.').'</h2>');
  103:         $r->print(&mt('Please try again in a few minutes.'));
  104:         return;
  105:     }
  106:     $r->rflush();
  107:     #
  108:     &Apache::lonhtmlcommon::Update_PrgWin
  109:         ($r,$prog_state,&mt('Parsing results'));
  110:     #
  111:     &output_results($r,$results_file,$navmap,$mode);
  112:     my ($sname,$sdom) = ($mode=~/^student:(.*):(.*)$/);
  113:     $r->print(&Apache::loncommon::track_student_link(
  114: 				  'View more activity by this student',
  115: 				  $sname,$sdom,undef,
  116: 				  ($env{'form.start'}+$num_records)));
  117: 
  118:     &Apache::lonhtmlcommon::Update_PrgWin($r,$prog_state,&mt('Finished!'));
  119:     return;
  120: }
  121: 
  122: sub table_names {
  123:     my $cid = $env{'request.course.id'};
  124:     my $domain = $env{'course.'.$cid.'.domain'};
  125:     my $home = $env{'course.'.$cid.'.home'};
  126:     my $course = $env{'course.'.$cid.'.num'};
  127:     my $prefix = $course.'_'.$domain.'_';
  128:     #
  129:     my %tables = 
  130:         ( student =>&Apache::lonmysql::fix_table_name($prefix.'students'),
  131:           res     =>&Apache::lonmysql::fix_table_name($prefix.'resource'),
  132:           machine =>&Apache::lonmysql::fix_table_name($prefix.'machine_table'),
  133:           activity=>&Apache::lonmysql::fix_table_name($prefix.'activity'),
  134:           );
  135:     return %tables;
  136: }
  137: 
  138: sub get_max_time_in_db {
  139:     my ($r,$prog_state) = @_;
  140:     my %table = &table_names();
  141:     my $query = qq{SELECT MAX(time) FROM $table{'activity'} };
  142:     #
  143:     my $home = $env{'course.'.$env{'request.course.id'}.'.home'};
  144:     my $reply=&Apache::lonnet::metadata_query($query,undef,undef,[$home]);
  145:     if (ref($reply) ne 'HASH') {
  146:         return undef;
  147:     }
  148:     my $results_file = $r->dir_config('lonDaemons').'/tmp/'.$reply->{$home};
  149:     my $endfile = $results_file.'.end';
  150:     ##
  151:     ## Check for the results
  152:     &Apache::lonhtmlcommon::Update_PrgWin
  153:         ($r,$prog_state,&mt('Waiting for results'));
  154:     my $maxtime = 500;
  155:     my $starttime = time;
  156:     while (! -e $endfile && (time-$starttime < $maxtime)) {
  157:         &Apache::lonhtmlcommon::Update_PrgWin
  158:             ($r,$prog_state,&mt('Waiting up to [_1] seconds for results',
  159:                                 $starttime+$maxtime-time));
  160:         sleep(1);
  161:     }
  162:     if (! -e $endfile) {
  163:         $r->print('<h2>'.
  164:                   &mt('Unable to retrieve data.').'</h2>');
  165:         $r->print(&mt('Please try again in a few minutes.'));
  166:         return undef;
  167:     }
  168:     $r->rflush();
  169:     #
  170:     &Apache::lonhtmlcommon::Update_PrgWin
  171:         ($r,$prog_state,&mt('Parsing results'));
  172:     #
  173:     if (! open(TIMEDATA,$results_file)) {
  174:         $r->print('<h2>'.&mt('Unable to read results file.').'</h2>'.
  175:                   '<p>'.
  176:                   &mt('This is a serious error and has been logged.  '.
  177:                       'You should contact your system administrator '.
  178:                       'to resolve this issue.').
  179:                   '</p>');
  180:         return;
  181:     }
  182:     #
  183:     my $timestr = '';
  184:     while (my $line = <TIMEDATA>) {
  185:         chomp($line);
  186:         $timestr = &Apache::lonnet::unescape($line);
  187:     }
  188:     close(TIMEDATA);
  189:     return &Apache::lonmysql::unsqltime($timestr);
  190: }
  191: 
  192: sub build_query {
  193:     my ($mode) = @_;
  194:     my $cid = $env{'request.course.id'};
  195:     my $domain = $env{'course.'.$cid.'.domain'};
  196:     my $home = $env{'course.'.$cid.'.home'};
  197:     my $course = $env{'course.'.$cid.'.num'};
  198:     my $prefix = $course.'_'.$domain.'_';
  199:     my $start = ($env{'form.start'}+0);
  200:     #
  201:     my %table = &table_names();
  202:     #
  203:     my $query;
  204:     if ($mode eq 'full_class') {
  205:         $query = qq{
  206:         SELECT B.resource,A.time,C.student,A.action,E.machine,A.action_values 
  207:             FROM $table{'activity'} AS A
  208:             LEFT JOIN $table{'res'}      AS B ON B.res_id=A.res_id 
  209:             LEFT JOIN $table{'student'}  AS C ON C.student_id=A.student_id 
  210:             LEFT JOIN $table{'machine'}  AS E ON E.machine_id=A.machine_id
  211:             ORDER BY A.time DESC
  212:             LIMIT $start, $num_records
  213:         };
  214:     } elsif ($mode =~ /^student:(.*):(.*)$/) {
  215:         my $student = $1.':'.$2;
  216:         $query = qq{
  217:             SELECT B.resource,A.time,A.action,E.machine,A.action_values 
  218:                 FROM $table{'activity'} AS A
  219:                 LEFT JOIN $table{'res'}      AS B ON B.res_id=A.res_id 
  220:                 LEFT JOIN $table{'student'}  AS C ON C.student_id=A.student_id 
  221:                 LEFT JOIN $table{'machine'}  AS E ON E.machine_id=A.machine_id
  222:                 WHERE C.student='$student'
  223:                 ORDER BY A.time DESC
  224:                 LIMIT $start, $num_records
  225:             };
  226:     }
  227:     $query =~ s|$/||g;
  228:     return $query;
  229: }
  230: 
  231: ###################################################################
  232: ###################################################################
  233: sub output_results {
  234:     my ($r,$results_file,$navmap,$mode) = @_;
  235:     ##
  236:     ##
  237:     if (! -s $results_file) {
  238:         # results file is empty, just let them know there is no data
  239:         $r->print('<h2>'.&mt('No data was returned for your request').'</h2>');
  240:         return;
  241:     }
  242:     if (! open(ACTIVITYDATA,$results_file)) {
  243:         $r->print('<h2>'.&mt('Unable to read results file.').'</h2>'.
  244:                   '<p>'.
  245:                   &mt('This is a serious error and has been logged.  '.
  246:                       'You should contact your system administrator '.
  247:                       'to resolve this issue.').
  248:                   '</p>');
  249:         return;
  250:     }
  251:     ##
  252:     ##
  253:     my $tableheader;
  254:     if ($mode eq 'full_class') { 
  255:         $tableheader = 
  256:             '<table><tr>'.
  257:             '<th>'.&mt('Resource').'</th>'.
  258:             '<th>'.&mt('Time').'</th>'.
  259:             '<th>'.&mt('Student').'</th>'.
  260:             '<th>'.&mt('Action').'</th>'.
  261:  #           '<th>'.&mt('Originating Server').'</th>'.
  262:             '<th align="left">'.&mt('Data').'</th>'.
  263:             '</tr>'.$/;
  264:     } elsif ($mode =~ /^student:(.*):(.*)$/) {
  265:         $tableheader = 
  266:             '<table><tr>'.
  267:             '<th>'.&mt('Resource').'</th>'.
  268:             '<th>'.&mt('Time').'</th>'.
  269:             '<th>'.&mt('Action').'</th>'.
  270:  #           '<th>'.&mt('Originating Server').'</th>'.
  271:             '<th align="left">'.&mt('Data').'</th>'.
  272:             '</tr>'.$/;
  273:     }
  274:     my $count = $env{'form.start'}-1;
  275:     $r->rflush();
  276:     ##
  277:     ##
  278:     while (my $line = <ACTIVITYDATA>) {
  279:         # FIXME: does not pass symbs along :(
  280:         chomp($line);
  281:         $line = &Apache::lonnet::unescape($line);
  282:         if (++$count % 50 == 0) {
  283:             if ($count != 0) { 
  284:                 $r->print('</table>'.$/);
  285:                 $r->rflush();
  286:             }
  287:             $r->print($tableheader);
  288:         }
  289:         my ($symb,$timestamp,$student,$action,$machine,$values);
  290:         if ($mode eq 'full_class') {
  291:             ($symb,$timestamp,$student,$action,$machine,$values) = split(',',$line,6);
  292:         } else {
  293:             ($symb,$timestamp,$action,$machine,$values) = split(',',$line,5);
  294:         }
  295: 	foreach ($symb,$timestamp,$student,$action,$machine) {
  296: 	    $_=&Apache::lonnet::unescape($_);
  297: 	}
  298:         my ($title,$src);
  299:         if ($symb =~ m:^/adm/:) {
  300:             $title = $symb;
  301:             $src = $symb;
  302:         } else {
  303:             my $nav_res = $navmap->getBySymb($symb);
  304:             if (defined($nav_res)) {
  305:                 $title = $nav_res->compTitle();
  306:                 $src   = $nav_res->src();
  307:             } else {
  308:                 if ($src =~ m|^/res|) {
  309:                     $title = $src;
  310:                 } elsif ($values =~ /^\s*$/ && 
  311:                          (! defined($src) || $src =~ /^\s*$/)) {
  312:                     next;
  313:                 } elsif ($values =~ /^\s*$/) {
  314:                     $values = $src;
  315:                 } else {
  316:                     $title = 'unable to retrieve title';
  317:                     $src   = '/dev/null';
  318:                 }
  319:             }
  320:         }
  321:         my %classes;
  322:         my $class_count=0;
  323:         if (! exists($classes{$symb})) {
  324:             $classes{$symb} = $class_count++;
  325:         }
  326:         my $class = 'a';#.$classes{$symb};
  327:         #
  328:         if ($symb eq '/prtspool/') {
  329:             $class = 'print';
  330:             $title = 'retrieve printout';
  331:         } elsif ($symb =~ m|^/adm/([^/]+)|) {
  332:             $class = $1;
  333:         } elsif ($symb =~ m|^/adm/|) {
  334:             $class = 'adm';
  335:         }
  336:         if ($title eq 'unable to retrieve title') {
  337:             $title =~ s/ /\&nbsp;/g;
  338:             $class = 'warning';
  339:         }
  340:         if (! defined($title) || $title eq '') {
  341:             $title = 'untitled';
  342:             $class = 'warning';
  343:         }
  344:         # Clean up the values
  345: 	$values = &display_values($action,$values);
  346:         #
  347:         # Build the row for output
  348:         my $tablerow = qq{<tr class="$class"><td>}.($count+1).qq{</td>};
  349:         if ($src =~ m|^/adm/|) {
  350:             $tablerow .= 
  351:                 '<td valign="top"><nobr>'.$title.'</nobr></td>';
  352:         } else {
  353:             $tablerow .= 
  354:                 '<td valign="top"><nobr>'.
  355:                 '<a href="'.$src.'">'.$title.'</a>'.
  356:                 '</nobr></td>';
  357:         }
  358:         $tablerow .= '<td valign="top"><nobr>'.$timestamp.'</nobr></td>';
  359:         if ($mode eq 'full_class') {
  360:             $tablerow.='<td valign="top">'.$student.'</td>';
  361:         }
  362:         $tablerow .= 
  363:             '<td valign="top">'.$action.'</td>'.
  364: #            '<td>'.$machine.'</td>'.
  365:             '<td valign="top">'.$values.'</td>'.
  366:             '</tr>';
  367:         $r->print($tablerow.$/);
  368:     }
  369:     $r->print('</table>'.$/);### if (! $count % 50);
  370:     close(ACTIVITYDATA);
  371:     return;
  372: }
  373: 
  374: ###################################################################
  375: ###################################################################
  376: sub display_values {
  377:     my ($action,$values)=@_;
  378:     my $result='<table>';
  379:     if ($action eq 'CSTORE') {
  380: 	my %values=map {split('=',$_,-1)} split(/\&/,$values);
  381: 	foreach my $key (sort(keys(%values))) {
  382: 	    $result.='<tr><td align="right">'.
  383: 		&Apache::lonnet::unescape($key).
  384: 		'</td><td>=</td><td align="left">'.
  385: 		&Apache::lonnet::unescape($values{$key}).'</td></tr>';
  386: 	}
  387: 	$result.='</table>';
  388:     } elsif ($action eq 'POST') {
  389: 	my %values=
  390: 	    map {split('=',&Apache::lonnet::unescape($_),-1)} split(/\&/,$values);
  391: 	foreach my $key (sort(keys(%values))) {
  392: 	    if ($key eq 'counter') { next; }
  393: 	    $result.='<tr><td align="right">'.$key.'</td>'.
  394: 		'<td>=</td><td align="left">'.$values{$key}.'</td></tr>';
  395: 	}
  396: 	$result.='</table>';
  397:     } else {
  398: 	$result=&Apache::lonnet::unescape($values)
  399:     }
  400:     return $result;
  401: }
  402: ###################################################################
  403: ###################################################################
  404: sub request_data_update {
  405:     my $command = 'prepare activity log';
  406:     my $cid = $env{'request.course.id'};
  407:     my $domain = $env{'course.'.$cid.'.domain'};
  408:     my $home = $env{'course.'.$cid.'.home'};
  409:     my $course = $env{'course.'.$cid.'.num'};
  410: #    &Apache::lonnet::logthis($command.' '.$course.' '.$domain.' '.$home);
  411:     my $result = &Apache::lonnet::metadata_query($command,$course,$domain,
  412:                                                  [$home]);
  413:     return $result;
  414: }
  415: 
  416: ###################################################################
  417: ###################################################################
  418: sub pick_student {
  419:     my ($r) = @_;
  420:     $r->print("Sorry, cannot display classlist at this time.  Come back another time.");
  421:     return;
  422: }
  423: 
  424: ###################################################################
  425: ###################################################################
  426: sub styles {
  427:     return <<END;
  428: <style type="text/css">
  429:     tr.warning   { background-color: \#CCCCCC; }
  430:     tr.chat      { background-color: \#CCCCCC; }
  431:     tr.chatfetch { background-color: \#CCCCCC; }
  432:     tr.navmaps   { background-color: \#CCCCCC; }
  433:     tr.roles     { background-color: \#CCCCCC; }
  434:     tr.flip      { background-color: \#CCCCCC; }
  435:     tr.adm       { background-color: \#CCCCCC; }
  436:     tr.print     { background-color: \#CCCCCC; }
  437:     tr.printout  { background-color: \#CCCCCC; }
  438:     tr.parmset   { background-color: \#CCCCCC; }
  439:     tr.grades    { background-color: \#CCCCCC; }
  440: </style>
  441: END
  442: } 
  443: 
  444: sub developer_centric_styles {
  445:     return <<END;
  446: <style type="text/css">
  447:     tr.warning   { background-color: red; }
  448:     tr.chat      { background-color: yellow; }
  449:     tr.chatfetch { background-color: yellow; }
  450:     tr.evaluate  { background-color: red; }
  451:     tr.navmaps   { background-color: \#777777; }
  452:     tr.roles     { background-color: \#999999; }
  453:     tr.flip      { background-color: \#BBBBBB; }
  454:     tr.adm       { background-color: green; }
  455:     tr.print     { background-color: blue; }
  456:     tr.parmset   { background-color: \#000088; }
  457:     tr.printout  { background-color: blue; }
  458:     tr.grades    { background-color: \#CCCCCC; }
  459: </style>
  460: END
  461: }
  462: 
  463: ###################################################################
  464: ###################################################################
  465: sub handler {
  466:     my $r=shift;
  467:     my $c = $r->connection();
  468:     #
  469:     # Check for overloading here and on the course home server
  470:     my $loaderror=&Apache::lonnet::overloaderror($r);
  471:     if ($loaderror) { return $loaderror; }
  472:     $loaderror=
  473:         &Apache::lonnet::overloaderror
  474:         ($r,
  475:          $env{'course.'.$env{'request.course.id'}.'.home'});
  476:     if ($loaderror) { return $loaderror; }
  477:     #
  478:     # Check for access
  479:     if (! &Apache::lonnet::allowed('vsa',$env{'request.course.id'})) {
  480:         $env{'user.error.msg'}=
  481:             $r->uri.":vsa:0:0:Cannot student activity for complete course";
  482:         if (! 
  483:             &Apache::lonnet::allowed('vsa',
  484:                                      $env{'request.course.id'}.'/'.
  485:                                      $env{'request.course.sec'})) {
  486:             $env{'user.error.msg'}=
  487:                 $r->uri.":vsa:0:0:Cannot view student activity with given role";
  488:             return HTTP_NOT_ACCEPTABLE;
  489:         }
  490:     }
  491:     #
  492:     # Send the header
  493:     &Apache::loncommon::no_cache($r);
  494:     &Apache::loncommon::content_type($r,'text/html');
  495:     $r->send_http_header;
  496:     if ($r->header_only) { return OK; }
  497:     #
  498:     # Extract form elements from query string
  499:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  500:                                             ['selected_student','start']);
  501:     #
  502:     # We will almost always need this...
  503:     my $navmap = Apache::lonnavmaps::navmap->new();
  504:     # 
  505:     &Apache::lonhtmlcommon::clear_breadcrumbs();
  506:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/studentactivity',
  507:                                             title=>'Student Activity',
  508:                                             text =>'Student Activity',
  509:                                             faq=>139,
  510:                                             bug=>'instructor interface'});
  511:     #
  512:     # Give the LON-CAPA page header
  513:     my $html=&Apache::lonxml::xmlbegin();
  514:     $r->print($html.'<head>'.&styles().'<title>'.
  515:               &mt('Student Activity').
  516:               "</title></head>\n".
  517:               &Apache::loncommon::bodytag('Student Activity').
  518:               &Apache::lonhtmlcommon::breadcrumbs(undef,'Student Activity'));
  519:     $r->rflush();
  520:     #
  521:     # Begin form output
  522:     $r->print('<form name="trackstudent" method="post" action="/adm/trackstudent">');
  523:     $r->print('<br />');
  524:     $r->print('<div name="statusline">'.
  525:               &mt('Status:[_1]',
  526:                   '<input type="text" name="status" size="60" value="" />').
  527:               '</div>');
  528:     $r->rflush();
  529:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
  530:         ($r,&mt('Student Activity Retrieval'),
  531:          &mt('Student Activity Retrieval'),undef,'inline',undef,
  532:          'trackstudent','status');
  533:     &Apache::lonhtmlcommon::Update_PrgWin
  534:         ($r,\%prog_state,&mt('Contacting course home server'));
  535:     #
  536:     my $result = &request_data_update();
  537:     #
  538:     if (exists($env{'form.selected_student'})) {
  539:         # For now, just show all the data, in the future allow selection of
  540:         # a student
  541:         my ($sname,$sdom) = split(':',$env{'form.selected_student'});
  542:         if ($sname =~ /^\w*$/ && $sdom =~ /^\w*$/) {
  543:             $r->print('<h2>'.
  544:                       &mt('Recent activity of [_1]@[_2]',$sname,$sdom).
  545:                       '</h2>');
  546:             $r->print('<p>'.&mt(<<END).'</p>');
  547: Compiling student activity data can take a long time.
  548: It may be necessary to reload this page to get the most current information.
  549: END
  550:             &get_data($r,\%prog_state,$navmap,
  551:                       'student:'.$env{'form.selected_student'});
  552:         } else {
  553:             $r->print('<h2>'.&mt('Unable to process for [_1]@[_2]',
  554:                                  $sname,$sdom).'</h2>');
  555:         }
  556:     } else {
  557:         # For now, just show all the data instead of limiting it to one student
  558:         &get_data($r,\%prog_state,$navmap,'full_class');
  559:     }
  560:     #
  561:     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Done'));
  562:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
  563:     #
  564:     $r->print("</form>\n");
  565:     $r->print("</body>\n</html>\n");
  566:     $r->rflush();
  567:     #
  568:     return OK;
  569: }
  570: 
  571: 1;
  572: 
  573: #######################################################
  574: #######################################################
  575: 
  576: =pod
  577: 
  578: =back
  579: 
  580: =cut
  581: 
  582: #######################################################
  583: #######################################################
  584: 
  585: __END__
  586: