File:  [LON-CAPA] / loncom / interface / lontrackstudent.pm
Revision 1.12: download - view: text, annotated - select for diffs
Thu Dec 30 16:34:05 2004 UTC (19 years, 5 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
&get_max_time_in_db: use lonmysql::unsqltime to convert time.
&output_results: Tell the user when no data was returned.

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

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