Annotation of loncom/interface/lontrackstudent.pm, revision 1.12
1.1 matthew 1: # The LearningOnline Network with CAPA
2: #
1.12 ! matthew 3: # $Id: lontrackstudent.pm,v 1.11 2004/12/22 22:54:59 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);
47: use Apache::lonnet();
48: use Apache::lonlocal;
49: use Time::HiRes;
50:
1.5 matthew 51: sub get_data {
52: my ($r,$prog_state,$navmap,$mode) = @_;
1.2 matthew 53: ##
54: ## Compose the query
55: &Apache::lonhtmlcommon::Update_PrgWin
56: ($r,$prog_state,&mt('Composing Query'));
57: #
1.9 matthew 58: # Allow the other server to begin processing the data before we ask for it.
59: sleep(5);
1.10 matthew 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);
1.2 matthew 72: ##
73: ## Send it along
1.5 matthew 74: my $home = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
1.2 matthew 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)) {
1.4 matthew 92: &Apache::lonhtmlcommon::Update_PrgWin
93: ($r,$prog_state,&mt('Waiting up to [_1] seconds for results',
94: $starttime+$maxtime-time));
1.2 matthew 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: }
1.5 matthew 103: $r->rflush();
1.10 matthew 104: #
1.2 matthew 105: &Apache::lonhtmlcommon::Update_PrgWin
106: ($r,$prog_state,&mt('Parsing results'));
1.10 matthew 107: #
1.5 matthew 108: &output_results($r,$results_file,$navmap,$mode);
109: &Apache::lonhtmlcommon::Update_PrgWin($r,$prog_state,&mt('Finished!'));
1.4 matthew 110: return;
111: }
112:
1.10 matthew 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);
1.12 ! matthew 180: return &Apache::lonmysql::unsqltime($timestr);
1.10 matthew 181: }
182:
1.5 matthew 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: #
1.10 matthew 191: my %table = &table_names();
1.5 matthew 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
1.10 matthew 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
1.5 matthew 201: ORDER BY A.time DESC
1.6 matthew 202: LIMIT 500
1.5 matthew 203: };
204: } elsif ($mode =~ /^student:(.*):(.*)$/) {
205: my $student = $1.':'.$2;
206: $query = qq{
1.6 matthew 207: SELECT B.resource,A.time,A.action,E.machine,A.action_values
1.10 matthew 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
1.6 matthew 212: WHERE C.student='$student'
213: ORDER BY A.time DESC
214: LIMIT 500
215: };
1.5 matthew 216: }
217: $query =~ s|$/||g;
218: return $query;
219: }
220:
221: ###################################################################
222: ###################################################################
1.4 matthew 223: sub output_results {
1.5 matthew 224: my ($r,$results_file,$navmap,$mode) = @_;
1.6 matthew 225: ##
226: ##
1.12 ! matthew 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: }
1.2 matthew 232: if (! open(ACTIVITYDATA,$results_file)) {
1.4 matthew 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>');
1.2 matthew 239: return;
240: }
1.6 matthew 241: ##
242: ##
1.5 matthew 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>'.
1.6 matthew 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>'.
1.5 matthew 262: '</tr>'.$/;
263: }
264: my $count = -1;
1.2 matthew 265: $r->rflush();
1.6 matthew 266: ##
267: ##
1.2 matthew 268: while (my $line = <ACTIVITYDATA>) {
1.10 matthew 269: # FIXME: does not pass symbs along :(
1.6 matthew 270: chomp($line);
1.2 matthew 271: $line = &Apache::lonnet::unescape($line);
272: if (++$count % 50 == 0) {
1.5 matthew 273: if ($count != 0) {
274: $r->print('</table>'.$/);
275: $r->rflush();
276: }
1.2 matthew 277: $r->print($tableheader);
278: }
1.5 matthew 279: my ($symb,$timestamp,$student,$action,$machine,$values);
280: if ($mode eq 'full_class') {
1.11 albertel 281: ($symb,$timestamp,$student,$action,$machine,$values) = split(',',$line,6);
1.5 matthew 282: } else {
1.11 albertel 283: ($symb,$timestamp,$action,$machine,$values) = split(',',$line,5);
1.5 matthew 284: }
1.11 albertel 285: foreach ($symb,$timestamp,$student,$action,$machine) {
286: $_=&Apache::lonnet::unescape($_);
287: }
1.2 matthew 288: my ($title,$src);
1.4 matthew 289: if ($symb =~ m:^/adm/:) {
1.2 matthew 290: $title = $symb;
291: $src = $symb;
292: } else {
1.4 matthew 293: my $nav_res = $navmap->getBySymb($symb);
294: if (defined($nav_res)) {
1.11 albertel 295: $title = $nav_res->compTitle();
1.4 matthew 296: $src = $nav_res->src();
297: } else {
1.6 matthew 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: }
1.4 matthew 309: }
1.2 matthew 310: }
1.6 matthew 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};
1.4 matthew 317: #
1.5 matthew 318: if ($symb eq '/prtspool/') {
1.4 matthew 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/ /\ /g;
328: $class = 'warning';
329: }
330: if (! defined($title) || $title eq '') {
331: $title = 'untitled';
332: $class = 'warning';
333: }
1.6 matthew 334: # Clean up the values
1.11 albertel 335: $values = &display_values($action,$values);
1.6 matthew 336: #
337: # Build the row for output
338: my $tablerow = qq{<tr class="$class">};
339: if ($src =~ m|^/adm/|) {
340: $tablerow .=
1.11 albertel 341: '<td valign="top"><nobr>'.$title.'</nobr></td>';
1.6 matthew 342: } else {
343: $tablerow .=
1.11 albertel 344: '<td valign="top"><nobr>'.
1.6 matthew 345: '<a href="'.$src.'">'.$title.'</a>'.
346: '</nobr></td>';
1.5 matthew 347: }
1.11 albertel 348: $tablerow .= '<td valign="top"><nobr>'.$timestamp.'</nobr></td>';
1.5 matthew 349: if ($mode eq 'full_class') {
1.11 albertel 350: $tablerow.='<td valign="top">'.$student.'</td>';
1.5 matthew 351: }
1.6 matthew 352: $tablerow .=
1.11 albertel 353: '<td valign="top">'.$action.'</td>'.
1.6 matthew 354: # '<td>'.$machine.'</td>'.
1.11 albertel 355: '<td valign="top">'.$values.'</td>'.
1.6 matthew 356: '</tr>';
357: $r->print($tablerow.$/);
1.2 matthew 358: }
1.5 matthew 359: $r->print('</table>'.$/) if (! $count % 50);
1.2 matthew 360: close(ACTIVITYDATA);
361: return;
362: }
363:
1.5 matthew 364: ###################################################################
365: ###################################################################
1.11 albertel 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: ###################################################################
1.1 matthew 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'};
1.6 matthew 400: # &Apache::lonnet::logthis($command.' '.$course.' '.$domain.' '.$home);
1.1 matthew 401: my $result = &Apache::lonnet::metadata_query($command,$course,$domain,
402: [$home]);
403: return $result;
404: }
405:
406: ###################################################################
407: ###################################################################
1.5 matthew 408: sub pick_student {
409: my ($r) = @_;
410: $r->print("Sorry, cannot display classlist at this time. Come back another time.");
411: return;
412: }
1.1 matthew 413:
1.5 matthew 414: ###################################################################
415: ###################################################################
1.4 matthew 416: sub styles {
417: return <<END;
1.5 matthew 418: <style type="text/css">
1.6 matthew 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">
1.4 matthew 437: tr.warning { background-color: red; }
438: tr.chat { background-color: yellow; }
439: tr.chatfetch { background-color: yellow; }
1.7 matthew 440: tr.evaluate { background-color: red; }
1.4 matthew 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; }
1.6 matthew 446: tr.parmset { background-color: \#000088; }
1.4 matthew 447: tr.printout { background-color: blue; }
1.6 matthew 448: tr.grades { background-color: \#CCCCCC; }
1.5 matthew 449: </style>
1.4 matthew 450: END
451: }
1.1 matthew 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: #
1.2 matthew 492: # We will almost always need this...
493: my $navmap = Apache::lonnavmaps::navmap->new();
1.1 matthew 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: #
1.2 matthew 502: # Give the LON-CAPA page header
1.4 matthew 503: $r->print('<html><head>'.&styles.'<title>'.
1.2 matthew 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: #
1.1 matthew 510: # Begin form output
1.2 matthew 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>');
1.1 matthew 517: $r->rflush();
1.2 matthew 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'));
1.1 matthew 524: #
525: my $result = &request_data_update();
526: if (ref($result) eq 'HASH') {
1.2 matthew 527: $result = join(' ',map { $_.'=>'.$result->{$_}; } keys(%$result));
1.1 matthew 528: }
529: #
1.5 matthew 530: if (exists($ENV{'form.selected_student'})) {
1.4 matthew 531: # For now, just show all the data, in the future allow selection of
532: # a student
1.5 matthew 533: my ($sname,$sdom) = split(':',$ENV{'form.selected_student'});
1.6 matthew 534: if ($sname =~ /^\w*$/ && $sdom =~ /^\w*$/) {
535: $r->print('<h2>'.
536: &mt('Recent activity of [_1]@[_2]',$sname,$sdom).
537: '</h2>');
1.8 matthew 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
1.6 matthew 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: }
1.1 matthew 548: } else {
1.4 matthew 549: # For now, just show all the data instead of limiting it to one student
1.5 matthew 550: &get_data($r,\%prog_state,$navmap,'full_class');
1.1 matthew 551: }
552: #
1.4 matthew 553: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Done'));
554: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
1.2 matthew 555: #
1.1 matthew 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>
![[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