1: # The LearningOnline Network with CAPA
2: #
3: # $Id: lontrackstudent.pm,v 1.11 2004/12/22 22:54:59 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::lonnet();
48: use Apache::lonlocal;
49: use Time::HiRes;
50: use Time::Local;
51:
52: sub get_data {
53: my ($r,$prog_state,$navmap,$mode) = @_;
54: ##
55: ## Compose the query
56: &Apache::lonhtmlcommon::Update_PrgWin
57: ($r,$prog_state,&mt('Composing Query'));
58: #
59: # Allow the other server to begin processing the data before we ask for it.
60: sleep(5);
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);
73: ##
74: ## Send it along
75: my $home = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
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)) {
93: &Apache::lonhtmlcommon::Update_PrgWin
94: ($r,$prog_state,&mt('Waiting up to [_1] seconds for results',
95: $starttime+$maxtime-time));
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: }
104: $r->rflush();
105: #
106: &Apache::lonhtmlcommon::Update_PrgWin
107: ($r,$prog_state,&mt('Parsing results'));
108: #
109: &output_results($r,$results_file,$navmap,$mode);
110: &Apache::lonhtmlcommon::Update_PrgWin($r,$prog_state,&mt('Finished!'));
111: return;
112: }
113:
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:
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: #
199: my %table = &table_names();
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
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
209: ORDER BY A.time DESC
210: LIMIT 500
211: };
212: } elsif ($mode =~ /^student:(.*):(.*)$/) {
213: my $student = $1.':'.$2;
214: $query = qq{
215: SELECT B.resource,A.time,A.action,E.machine,A.action_values
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
220: WHERE C.student='$student'
221: ORDER BY A.time DESC
222: LIMIT 500
223: };
224: }
225: $query =~ s|$/||g;
226: return $query;
227: }
228:
229: ###################################################################
230: ###################################################################
231: sub output_results {
232: my ($r,$results_file,$navmap,$mode) = @_;
233: ##
234: ##
235: if (! open(ACTIVITYDATA,$results_file)) {
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>');
242: return;
243: }
244: ##
245: ##
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>'.
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>'.
265: '</tr>'.$/;
266: }
267: my $count = -1;
268: $r->rflush();
269: ##
270: ##
271: while (my $line = <ACTIVITYDATA>) {
272: # FIXME: does not pass symbs along :(
273: chomp($line);
274: $line = &Apache::lonnet::unescape($line);
275: if (++$count % 50 == 0) {
276: if ($count != 0) {
277: $r->print('</table>'.$/);
278: $r->rflush();
279: }
280: $r->print($tableheader);
281: }
282: my ($symb,$timestamp,$student,$action,$machine,$values);
283: if ($mode eq 'full_class') {
284: ($symb,$timestamp,$student,$action,$machine,$values) = split(',',$line,6);
285: } else {
286: ($symb,$timestamp,$action,$machine,$values) = split(',',$line,5);
287: }
288: foreach ($symb,$timestamp,$student,$action,$machine) {
289: $_=&Apache::lonnet::unescape($_);
290: }
291: my ($title,$src);
292: if ($symb =~ m:^/adm/:) {
293: $title = $symb;
294: $src = $symb;
295: } else {
296: my $nav_res = $navmap->getBySymb($symb);
297: if (defined($nav_res)) {
298: $title = $nav_res->compTitle();
299: $src = $nav_res->src();
300: } else {
301: if ($src =~ m|^/res|) {
302: $title = $src;
303: } elsif ($values =~ /^\s*$/ &&
304: (! defined($src) || $src =~ /^\s*$/)) {
305: next;
306: } elsif ($values =~ /^\s*$/) {
307: $values = $src;
308: } else {
309: $title = 'unable to retrieve title';
310: $src = '/dev/null';
311: }
312: }
313: }
314: my %classes;
315: my $class_count=0;
316: if (! exists($classes{$symb})) {
317: $classes{$symb} = $class_count++;
318: }
319: my $class = 'a';#.$classes{$symb};
320: #
321: if ($symb eq '/prtspool/') {
322: $class = 'print';
323: $title = 'retrieve printout';
324: } elsif ($symb =~ m|^/adm/([^/]+)|) {
325: $class = $1;
326: } elsif ($symb =~ m|^/adm/|) {
327: $class = 'adm';
328: }
329: if ($title eq 'unable to retrieve title') {
330: $title =~ s/ /\ /g;
331: $class = 'warning';
332: }
333: if (! defined($title) || $title eq '') {
334: $title = 'untitled';
335: $class = 'warning';
336: }
337: # Clean up the values
338: $values = &display_values($action,$values);
339: #
340: # Build the row for output
341: my $tablerow = qq{<tr class="$class">};
342: if ($src =~ m|^/adm/|) {
343: $tablerow .=
344: '<td valign="top"><nobr>'.$title.'</nobr></td>';
345: } else {
346: $tablerow .=
347: '<td valign="top"><nobr>'.
348: '<a href="'.$src.'">'.$title.'</a>'.
349: '</nobr></td>';
350: }
351: $tablerow .= '<td valign="top"><nobr>'.$timestamp.'</nobr></td>';
352: if ($mode eq 'full_class') {
353: $tablerow.='<td valign="top">'.$student.'</td>';
354: }
355: $tablerow .=
356: '<td valign="top">'.$action.'</td>'.
357: # '<td>'.$machine.'</td>'.
358: '<td valign="top">'.$values.'</td>'.
359: '</tr>';
360: $r->print($tablerow.$/);
361: }
362: $r->print('</table>'.$/) if (! $count % 50);
363: close(ACTIVITYDATA);
364: return;
365: }
366:
367: ###################################################################
368: ###################################################################
369: sub display_values {
370: my ($action,$values)=@_;
371: my $result='<table>';
372: if ($action eq 'CSTORE') {
373: my %values=map {split('=',$_,-1)} split(/\&/,$values);
374: foreach my $key (sort(keys(%values))) {
375: $result.='<tr><td align="right">'.
376: &Apache::lonnet::unescape($key).
377: '</td><td>=</td><td align="left">'.
378: &Apache::lonnet::unescape($values{$key}).'</td></tr>';
379: }
380: $result.='</table>';
381: } elsif ($action eq 'POST') {
382: my %values=
383: map {split('=',&Apache::lonnet::unescape($_),-1)} split(/\&/,$values);
384: foreach my $key (sort(keys(%values))) {
385: if ($key eq 'counter') { next; }
386: $result.='<tr><td align="right">'.$key.'</td>'.
387: '<td>=</td><td align="left">'.$values{$key}.'</td></tr>';
388: }
389: $result.='</table>';
390: } else {
391: $result=&Apache::lonnet::unescape($values)
392: }
393: return $result;
394: }
395: ###################################################################
396: ###################################################################
397: sub request_data_update {
398: my $command = 'prepare activity log';
399: my $cid = $ENV{'request.course.id'};
400: my $domain = $ENV{'course.'.$cid.'.domain'};
401: my $home = $ENV{'course.'.$cid.'.home'};
402: my $course = $ENV{'course.'.$cid.'.num'};
403: # &Apache::lonnet::logthis($command.' '.$course.' '.$domain.' '.$home);
404: my $result = &Apache::lonnet::metadata_query($command,$course,$domain,
405: [$home]);
406: return $result;
407: }
408:
409: ###################################################################
410: ###################################################################
411: sub pick_student {
412: my ($r) = @_;
413: $r->print("Sorry, cannot display classlist at this time. Come back another time.");
414: return;
415: }
416:
417: ###################################################################
418: ###################################################################
419: sub styles {
420: return <<END;
421: <style type="text/css">
422: tr.warning { background-color: \#CCCCCC; }
423: tr.chat { background-color: \#CCCCCC; }
424: tr.chatfetch { background-color: \#CCCCCC; }
425: tr.navmaps { background-color: \#CCCCCC; }
426: tr.roles { background-color: \#CCCCCC; }
427: tr.flip { background-color: \#CCCCCC; }
428: tr.adm { background-color: \#CCCCCC; }
429: tr.print { background-color: \#CCCCCC; }
430: tr.printout { background-color: \#CCCCCC; }
431: tr.parmset { background-color: \#CCCCCC; }
432: tr.grades { background-color: \#CCCCCC; }
433: </style>
434: END
435: }
436:
437: sub developer_centric_styles {
438: return <<END;
439: <style type="text/css">
440: tr.warning { background-color: red; }
441: tr.chat { background-color: yellow; }
442: tr.chatfetch { background-color: yellow; }
443: tr.evaluate { background-color: red; }
444: tr.navmaps { background-color: \#777777; }
445: tr.roles { background-color: \#999999; }
446: tr.flip { background-color: \#BBBBBB; }
447: tr.adm { background-color: green; }
448: tr.print { background-color: blue; }
449: tr.parmset { background-color: \#000088; }
450: tr.printout { background-color: blue; }
451: tr.grades { background-color: \#CCCCCC; }
452: </style>
453: END
454: }
455:
456: ###################################################################
457: ###################################################################
458: sub handler {
459: my $r=shift;
460: my $c = $r->connection();
461: #
462: # Check for overloading here and on the course home server
463: my $loaderror=&Apache::lonnet::overloaderror($r);
464: if ($loaderror) { return $loaderror; }
465: $loaderror=
466: &Apache::lonnet::overloaderror
467: ($r,
468: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
469: if ($loaderror) { return $loaderror; }
470: #
471: # Check for access
472: if (! &Apache::lonnet::allowed('vsa',$ENV{'request.course.id'})) {
473: $ENV{'user.error.msg'}=
474: $r->uri.":vsa:0:0:Cannot student activity for complete course";
475: if (!
476: &Apache::lonnet::allowed('vsa',
477: $ENV{'request.course.id'}.'/'.
478: $ENV{'request.course.sec'})) {
479: $ENV{'user.error.msg'}=
480: $r->uri.":vsa:0:0:Cannot view student activity with given role";
481: return HTTP_NOT_ACCEPTABLE;
482: }
483: }
484: #
485: # Send the header
486: &Apache::loncommon::no_cache($r);
487: &Apache::loncommon::content_type($r,'text/html');
488: $r->send_http_header;
489: if ($r->header_only) { return OK; }
490: #
491: # Extract form elements from query string
492: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
493: ['selected_student']);
494: #
495: # We will almost always need this...
496: my $navmap = Apache::lonnavmaps::navmap->new();
497: #
498: &Apache::lonhtmlcommon::clear_breadcrumbs();
499: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/studentactivity',
500: title=>'Student Activity',
501: text =>'Student Activity',
502: faq=>139,
503: bug=>'instructor interface'});
504: #
505: # Give the LON-CAPA page header
506: $r->print('<html><head>'.&styles.'<title>'.
507: &mt('Student Activity').
508: "</title></head>\n".
509: &Apache::loncommon::bodytag('Student Activity').
510: &Apache::lonhtmlcommon::breadcrumbs(undef,'Student Activity'));
511: $r->rflush();
512: #
513: # Begin form output
514: $r->print('<form name="trackstudent" method="post" action="/adm/trackstudent">');
515: $r->print('<br />');
516: $r->print('<div name="statusline">'.
517: &mt('Status:[_1]',
518: '<input type="text" name="status" size="60" value="" />').
519: '</div>');
520: $r->rflush();
521: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
522: ($r,&mt('Student Activity Retrieval'),
523: &mt('Student Activity Retrieval'),undef,'inline',undef,
524: 'trackstudent','status');
525: &Apache::lonhtmlcommon::Update_PrgWin
526: ($r,\%prog_state,&mt('Contacting course home server'));
527: #
528: my $result = &request_data_update();
529: if (ref($result) eq 'HASH') {
530: $result = join(' ',map { $_.'=>'.$result->{$_}; } keys(%$result));
531: }
532: #
533: if (exists($ENV{'form.selected_student'})) {
534: # For now, just show all the data, in the future allow selection of
535: # a student
536: my ($sname,$sdom) = split(':',$ENV{'form.selected_student'});
537: if ($sname =~ /^\w*$/ && $sdom =~ /^\w*$/) {
538: $r->print('<h2>'.
539: &mt('Recent activity of [_1]@[_2]',$sname,$sdom).
540: '</h2>');
541: $r->print('<p>'.&mt(<<END).'</p>');
542: Compiling student activity data can take a long time.
543: It may be necessary to reload this page to get the most current information.
544: END
545: &get_data($r,\%prog_state,$navmap,
546: 'student:'.$ENV{'form.selected_student'});
547: } else {
548: $r->print('<h2>'.&mt('Unable to process for [_1]@[_2]',
549: $sname,$sdom).'</h2>');
550: }
551: } else {
552: # For now, just show all the data instead of limiting it to one student
553: &get_data($r,\%prog_state,$navmap,'full_class');
554: }
555: #
556: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Done'));
557: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
558: #
559: $r->print("</form>\n");
560: $r->print("</body>\n</html>\n");
561: $r->rflush();
562: #
563: return OK;
564: }
565:
566: 1;
567:
568: #######################################################
569: #######################################################
570:
571: =pod
572:
573: =back
574:
575: =cut
576:
577: #######################################################
578: #######################################################
579:
580: __END__
581:
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