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