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