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