File:  [LON-CAPA] / loncom / interface / lontrackstudent.pm
Revision 1.6: download - view: text, annotated - select for diffs
Sun Aug 29 19:58:32 2004 UTC (19 years, 8 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Removed 'orginating server' column.
Reduced number of lines requested to 500.
Better handling of tables.
Changed style of table to be much less colorful.
Reduced the number of useless pieces of information output to the user.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lontrackstudent.pm,v 1.6 2004/08/29 19:58:32 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:     my $query = &build_query($mode);
   59:     &Apache::lonnet::logthis('sending query '.$query);
   60:     ##
   61:     ## Send it along
   62:     my $home = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
   63:     my $reply=&Apache::lonnet::metadata_query($query,undef,undef,[$home]);
   64:     if (ref($reply) ne 'HASH') {
   65:         $r->print('<h2>'.
   66:                   &mt('Error contacting home server for course: [_1]',
   67:                       $reply).
   68:                   '</h2>');
   69:         return;
   70:     }
   71:     my $results_file = $r->dir_config('lonDaemons').'/tmp/'.$reply->{$home};
   72:     my $endfile = $results_file.'.end';
   73:     ##
   74:     ## Check for the results
   75:     &Apache::lonhtmlcommon::Update_PrgWin
   76:         ($r,$prog_state,&mt('Waiting for results'));
   77:     my $maxtime = 500;
   78:     my $starttime = time;
   79:     while (! -e $endfile && (time-$starttime < $maxtime)) {
   80:         &Apache::lonhtmlcommon::Update_PrgWin
   81:             ($r,$prog_state,&mt('Waiting up to [_1] seconds for results',
   82:                                 $starttime+$maxtime-time));
   83:         sleep(1);
   84:     }
   85:     if (! -e $endfile) {
   86:         $r->print('<h2>'.
   87:                   &mt('Unable to retrieve data.').'</h2>');
   88:         $r->print(&mt('Please try again in a few minutes.'));
   89:         return;
   90:     }
   91: #    $r->print('<h2>'.&mt('Elapsed Time = [_1] seconds',
   92: #                         time-$starttime).'</h2>');
   93:     $r->rflush();
   94:     &Apache::lonhtmlcommon::Update_PrgWin
   95:         ($r,$prog_state,&mt('Parsing results'));
   96: #    $r->print('<h2>'.
   97: #              &mt('Reloading this page may result in newer data').
   98: #              '</h2>');
   99:     &output_results($r,$results_file,$navmap,$mode);
  100:     &Apache::lonhtmlcommon::Update_PrgWin($r,$prog_state,&mt('Finished!'));
  101:     return;
  102: }
  103: 
  104: sub build_query {
  105:     my ($mode) = @_;
  106:     my $cid = $ENV{'request.course.id'};
  107:     my $domain = $ENV{'course.'.$cid.'.domain'};
  108:     my $home = $ENV{'course.'.$cid.'.home'};
  109:     my $course = $ENV{'course.'.$cid.'.num'};
  110:     my $prefix = $course.'_'.$domain.'_';
  111:     #
  112:     my $student_table  = $prefix.'students';
  113:     my $res_table      = $prefix.'resource';
  114:     my $action_table   = $prefix.'actions';
  115:     my $machine_table  = $prefix.'machine_table';
  116:     my $activity_table = $prefix.'activity';
  117:     #
  118:     my $query;
  119:     if ($mode eq 'full_class') {
  120:         $query = qq{
  121:         SELECT B.resource,A.time,C.student,A.action,E.machine,A.action_values 
  122:             FROM $activity_table AS A
  123:             LEFT JOIN $res_table      AS B ON B.res_id=A.res_id 
  124:             LEFT JOIN $student_table  AS C ON C.student_id=A.student_id 
  125:             LEFT JOIN $machine_table  AS E ON E.machine_id=A.machine_id
  126:             WHERE A.student_id>10
  127:             ORDER BY A.time DESC
  128:             LIMIT 500
  129:         };
  130:     } elsif ($mode =~ /^student:(.*):(.*)$/) {
  131:         my $student = $1.':'.$2;
  132:         $query = qq{
  133:             SELECT B.resource,A.time,A.action,E.machine,A.action_values 
  134:                 FROM $activity_table AS A
  135:                 LEFT JOIN $res_table      AS B ON B.res_id=A.res_id 
  136:                 LEFT JOIN $student_table  AS C ON C.student_id=A.student_id 
  137:                 LEFT JOIN $machine_table  AS E ON E.machine_id=A.machine_id
  138:                 WHERE C.student='$student'
  139:                 ORDER BY A.time DESC
  140:                 LIMIT 500
  141:             };
  142:     }
  143:     $query =~ s|$/||g;
  144:     return $query;
  145: }
  146: 
  147: ###################################################################
  148: ###################################################################
  149: sub output_results {
  150:     my ($r,$results_file,$navmap,$mode) = @_;
  151:     ##
  152:     ##
  153:     if (! open(ACTIVITYDATA,$results_file)) {
  154:         $r->print('<h2>'.&mt('Unable to read results file.').'</h2>'.
  155:                   '<p>'.
  156:                   &mt('This is a serious error and has been logged.  '.
  157:                       'You should contact your system administrator '.
  158:                       'to resolve this issue.').
  159:                   '</p>');
  160:         return;
  161:     }
  162:     ##
  163:     ##
  164:     my $tableheader;
  165:     if ($mode eq 'full_class') { 
  166:         $tableheader = 
  167:             '<table><tr>'.
  168:             '<th>'.&mt('Resource').'</th>'.
  169:             '<th>'.&mt('Time').'</th>'.
  170:             '<th>'.&mt('Student').'</th>'.
  171:             '<th>'.&mt('Action').'</th>'.
  172:  #           '<th>'.&mt('Originating Server').'</th>'.
  173:             '<th align="left">'.&mt('Data').'</th>'.
  174:             '</tr>'.$/;
  175:     } elsif ($mode =~ /^student:(.*):(.*)$/) {
  176:         $tableheader = 
  177:             '<table><tr>'.
  178:             '<th>'.&mt('Resource').'</th>'.
  179:             '<th>'.&mt('Time').'</th>'.
  180:             '<th>'.&mt('Action').'</th>'.
  181:  #           '<th>'.&mt('Originating Server').'</th>'.
  182:             '<th align="left">'.&mt('Data').'</th>'.
  183:             '</tr>'.$/;
  184:     }
  185:     my $count = -1;
  186:     $r->rflush();
  187:     ##
  188:     ##
  189:     while (my $line = <ACTIVITYDATA>) {
  190:         chomp($line);
  191:         $line = &Apache::lonnet::unescape($line);
  192:         if (++$count % 50 == 0) {
  193:             if ($count != 0) { 
  194:                 $r->print('</table>'.$/);
  195:                 $r->rflush();
  196:             }
  197:             $r->print($tableheader);
  198:         }
  199:         my ($symb,$timestamp,$student,$action,$machine,$values);
  200:         if ($mode eq 'full_class') {
  201:             ($symb,$timestamp,$student,$action,$machine,$values) =
  202:                 map { &Apache::lonnet::unescape($_); } split(',',$line,6);
  203:         } else {
  204:             ($symb,$timestamp,$action,$machine,$values) =
  205:                 map { &Apache::lonnet::unescape($_); } split(',',$line,5);
  206:         }
  207:         my ($title,$src);
  208:         if ($symb =~ m:^/adm/:) {
  209:             $title = $symb;
  210:             $src = $symb;
  211:         } else {
  212:             my $nav_res = $navmap->getBySymb($symb);
  213:             if (defined($nav_res)) {
  214:                 $title = $nav_res->title();
  215:                 $src   = $nav_res->src();
  216:             } else {
  217:                 if ($src =~ m|^/res|) {
  218:                     $title = $src;
  219:                 } elsif ($values =~ /^\s*$/ && 
  220:                          (! defined($src) || $src =~ /^\s*$/)) {
  221:                     next;
  222:                 } elsif ($values =~ /^\s*$/) {
  223:                     $values = $src;
  224:                 } else {
  225:                     $title = 'unable to retrieve title';
  226:                     $src   = '/dev/null';
  227:                 }
  228:             }
  229:         }
  230:         my %classes;
  231:         my $class_count=0;
  232:         if (! exists($classes{$symb})) {
  233:             $classes{$symb} = $class_count++;
  234:         }
  235:         my $class = 'a';#.$classes{$symb};
  236:         #
  237:         if ($symb eq '/prtspool/') {
  238:             $class = 'print';
  239:             $title = 'retrieve printout';
  240:         } elsif ($symb =~ m|^/adm/([^/]+)|) {
  241:             $class = $1;
  242:         } elsif ($symb =~ m|^/adm/|) {
  243:             $class = 'adm';
  244:         }
  245:         if ($title eq 'unable to retrieve title') {
  246:             $title =~ s/ /\&nbsp;/g;
  247:             $class = 'warning';
  248:         }
  249:         if (! defined($title) || $title eq '') {
  250:             $title = 'untitled';
  251:             $class = 'warning';
  252:         }
  253:         # Clean up the values
  254:         $values =~ s/counter=\d+$//;
  255:         #
  256:         # Build the row for output
  257:         my $tablerow = qq{<tr class="$class">};
  258:         if ($src =~ m|^/adm/|) {
  259:             $tablerow .= 
  260:                 '<td><nobr>'.$title.'</td>';
  261:         } else {
  262:             $tablerow .= 
  263:                 '<td><nobr>'.
  264:                 '<a href="'.$src.'">'.$title.'</a>'.
  265:                 '</nobr></td>';
  266:         }
  267:         $tablerow .= '<td><nobr>'.$timestamp.'</nobr></td>';
  268:         if ($mode eq 'full_class') {
  269:             $tablerow.='<td>'.$student.'</td>';
  270:         }
  271:         $tablerow .= 
  272:             '<td>'.$action.'</td>'.
  273: #            '<td>'.$machine.'</td>'.
  274:             '<td>'.$values.'</td>'.
  275:             '</tr>';
  276:         $r->print($tablerow.$/);
  277:     }
  278:     $r->print('</table>'.$/) if (! $count % 50);
  279:     close(ACTIVITYDATA);
  280:     return;
  281: }
  282: 
  283: ###################################################################
  284: ###################################################################
  285: sub request_data_update {
  286:     my $command = 'prepare activity log';
  287:     my $cid = $ENV{'request.course.id'};
  288:     my $domain = $ENV{'course.'.$cid.'.domain'};
  289:     my $home = $ENV{'course.'.$cid.'.home'};
  290:     my $course = $ENV{'course.'.$cid.'.num'};
  291: #    &Apache::lonnet::logthis($command.' '.$course.' '.$domain.' '.$home);
  292:     my $result = &Apache::lonnet::metadata_query($command,$course,$domain,
  293:                                                  [$home]);
  294:     return $result;
  295: }
  296: 
  297: ###################################################################
  298: ###################################################################
  299: sub pick_student {
  300:     my ($r) = @_;
  301:     $r->print("Sorry, cannot display classlist at this time.  Come back another time.");
  302:     return;
  303: }
  304: 
  305: ###################################################################
  306: ###################################################################
  307: sub styles {
  308:     return <<END;
  309: <style type="text/css">
  310:     tr.warning   { background-color: \#CCCCCC; }
  311:     tr.chat      { background-color: \#CCCCCC; }
  312:     tr.chatfetch { background-color: \#CCCCCC; }
  313:     tr.navmaps   { background-color: \#CCCCCC; }
  314:     tr.roles     { background-color: \#CCCCCC; }
  315:     tr.flip      { background-color: \#CCCCCC; }
  316:     tr.adm       { background-color: \#CCCCCC; }
  317:     tr.print     { background-color: \#CCCCCC; }
  318:     tr.printout  { background-color: \#CCCCCC; }
  319:     tr.parmset   { background-color: \#CCCCCC; }
  320:     tr.grades    { background-color: \#CCCCCC; }
  321: </style>
  322: END
  323: } 
  324: 
  325: sub developer_centric_styles {
  326:     return <<END;
  327: <style type="text/css">
  328:     tr.warning   { background-color: red; }
  329:     tr.chat      { background-color: yellow; }
  330:     tr.chatfetch { background-color: yellow; }
  331:     tr.navmaps   { background-color: \#777777; }
  332:     tr.roles     { background-color: \#999999; }
  333:     tr.flip      { background-color: \#BBBBBB; }
  334:     tr.adm       { background-color: green; }
  335:     tr.print     { background-color: blue; }
  336:     tr.parmset   { background-color: \#000088; }
  337:     tr.printout  { background-color: blue; }
  338:     tr.grades    { background-color: \#CCCCCC; }
  339: </style>
  340: END
  341: }
  342: 
  343: ###################################################################
  344: ###################################################################
  345: sub handler {
  346:     my $r=shift;
  347:     my $c = $r->connection();
  348:     #
  349:     # Check for overloading here and on the course home server
  350:     my $loaderror=&Apache::lonnet::overloaderror($r);
  351:     if ($loaderror) { return $loaderror; }
  352:     $loaderror=
  353:         &Apache::lonnet::overloaderror
  354:         ($r,
  355:          $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
  356:     if ($loaderror) { return $loaderror; }
  357:     #
  358:     # Check for access
  359:     if (! &Apache::lonnet::allowed('vsa',$ENV{'request.course.id'})) {
  360:         $ENV{'user.error.msg'}=
  361:             $r->uri.":vsa:0:0:Cannot student activity for complete course";
  362:         if (! 
  363:             &Apache::lonnet::allowed('vsa',
  364:                                      $ENV{'request.course.id'}.'/'.
  365:                                      $ENV{'request.course.sec'})) {
  366:             $ENV{'user.error.msg'}=
  367:                 $r->uri.":vsa:0:0:Cannot view student activity with given role";
  368:             return HTTP_NOT_ACCEPTABLE;
  369:         }
  370:     }
  371:     #
  372:     # Send the header
  373:     &Apache::loncommon::no_cache($r);
  374:     &Apache::loncommon::content_type($r,'text/html');
  375:     $r->send_http_header;
  376:     if ($r->header_only) { return OK; }
  377:     #
  378:     # Extract form elements from query string
  379:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  380:                                             ['selected_student']);
  381:     #
  382:     # We will almost always need this...
  383:     my $navmap = Apache::lonnavmaps::navmap->new();
  384:     # 
  385:     &Apache::lonhtmlcommon::clear_breadcrumbs();
  386:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/studentactivity',
  387:                                             title=>'Student Activity',
  388:                                             text =>'Student Activity',
  389:                                             faq=>139,
  390:                                             bug=>'instructor interface'});
  391:     #
  392:     # Give the LON-CAPA page header
  393:     $r->print('<html><head>'.&styles.'<title>'.
  394:               &mt('Student Activity').
  395:               "</title></head>\n".
  396:               &Apache::loncommon::bodytag('Student Activity').
  397:               &Apache::lonhtmlcommon::breadcrumbs(undef,'Student Activity'));
  398:     $r->rflush();
  399:     #
  400:     # Begin form output
  401:     $r->print('<form name="trackstudent" method="post" action="/adm/trackstudent">');
  402:     $r->print('<br />');
  403:     $r->print('<div name="statusline">'.
  404:               &mt('Status:[_1]',
  405:                   '<input type="text" name="status" size="60" value="" />').
  406:               '</div>');
  407:     $r->rflush();
  408:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
  409:         ($r,&mt('Student Activity Retrieval'),
  410:          &mt('Student Activity Retrieval'),undef,'inline',undef,
  411:          'trackstudent','status');
  412:     &Apache::lonhtmlcommon::Update_PrgWin
  413:         ($r,\%prog_state,&mt('Contacting course home server'));
  414:     #
  415:     my $result = &request_data_update();
  416:     if (ref($result) eq 'HASH') {
  417:         $result = join(' ',map { $_.'=>'.$result->{$_}; } keys(%$result));
  418:     }
  419:     #
  420:     if (exists($ENV{'form.selected_student'})) {
  421:         # For now, just show all the data, in the future allow selection of
  422:         # a student
  423:         my ($sname,$sdom) = split(':',$ENV{'form.selected_student'});
  424:         if ($sname =~ /^\w*$/ && $sdom =~ /^\w*$/) {
  425:             $r->print('<h2>'.
  426:                       &mt('Recent activity of [_1]@[_2]',$sname,$sdom).
  427:                       '</h2>');
  428:             &get_data($r,\%prog_state,$navmap,
  429:                       'student:'.$ENV{'form.selected_student'});
  430:         } else {
  431:             $r->print('<h2>'.&mt('Unable to process for [_1]@[_2]',
  432:                                  $sname,$sdom).'</h2>');
  433:         }
  434:     } else {
  435:         # For now, just show all the data instead of limiting it to one student
  436:         &get_data($r,\%prog_state,$navmap,'full_class');
  437:     }
  438:     #
  439:     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Done'));
  440:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
  441:     #
  442:     $r->print("</form>\n");
  443:     $r->print("</body>\n</html>\n");
  444:     $r->rflush();
  445:     #
  446:     return OK;
  447: }
  448: 
  449: 1;
  450: 
  451: #######################################################
  452: #######################################################
  453: 
  454: =pod
  455: 
  456: =back
  457: 
  458: =cut
  459: 
  460: #######################################################
  461: #######################################################
  462: 
  463: __END__
  464: 

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