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