1: # The LearningOnline Network with CAPA
2: #
3: # $Id: lontrackstudent.pm,v 1.9 2004/12/13 21:08:09 matthew 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:
51: sub get_data {
52: my ($r,$prog_state,$navmap,$mode) = @_;
53: ##
54: ## Compose the query
55: &Apache::lonhtmlcommon::Update_PrgWin
56: ($r,$prog_state,&mt('Composing Query'));
57: #
58: my $query = &build_query($mode);
59: # Allow the other server to begin processing the data before we ask for it.
60: sleep(5);
61: &Apache::lonnet::logthis('sending query '.$query);
62: ##
63: ## Send it along
64: my $home = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
65: my $reply=&Apache::lonnet::metadata_query($query,undef,undef,[$home]);
66: if (ref($reply) ne 'HASH') {
67: $r->print('<h2>'.
68: &mt('Error contacting home server for course: [_1]',
69: $reply).
70: '</h2>');
71: return;
72: }
73: my $results_file = $r->dir_config('lonDaemons').'/tmp/'.$reply->{$home};
74: my $endfile = $results_file.'.end';
75: ##
76: ## Check for the results
77: &Apache::lonhtmlcommon::Update_PrgWin
78: ($r,$prog_state,&mt('Waiting for results'));
79: my $maxtime = 500;
80: my $starttime = time;
81: while (! -e $endfile && (time-$starttime < $maxtime)) {
82: &Apache::lonhtmlcommon::Update_PrgWin
83: ($r,$prog_state,&mt('Waiting up to [_1] seconds for results',
84: $starttime+$maxtime-time));
85: sleep(1);
86: }
87: if (! -e $endfile) {
88: $r->print('<h2>'.
89: &mt('Unable to retrieve data.').'</h2>');
90: $r->print(&mt('Please try again in a few minutes.'));
91: return;
92: }
93: # $r->print('<h2>'.&mt('Elapsed Time = [_1] seconds',
94: # time-$starttime).'</h2>');
95: $r->rflush();
96: &Apache::lonhtmlcommon::Update_PrgWin
97: ($r,$prog_state,&mt('Parsing results'));
98: # $r->print('<h2>'.
99: # &mt('Reloading this page may result in newer data').
100: # '</h2>');
101: &output_results($r,$results_file,$navmap,$mode);
102: &Apache::lonhtmlcommon::Update_PrgWin($r,$prog_state,&mt('Finished!'));
103: return;
104: }
105:
106: sub build_query {
107: my ($mode) = @_;
108: my $cid = $ENV{'request.course.id'};
109: my $domain = $ENV{'course.'.$cid.'.domain'};
110: my $home = $ENV{'course.'.$cid.'.home'};
111: my $course = $ENV{'course.'.$cid.'.num'};
112: my $prefix = $course.'_'.$domain.'_';
113: #
114: my $student_table = $prefix.'students';
115: my $res_table = $prefix.'resource';
116: my $action_table = $prefix.'actions';
117: my $machine_table = $prefix.'machine_table';
118: my $activity_table = $prefix.'activity';
119: #
120: my $query;
121: if ($mode eq 'full_class') {
122: $query = qq{
123: SELECT B.resource,A.time,C.student,A.action,E.machine,A.action_values
124: FROM $activity_table AS A
125: LEFT JOIN $res_table AS B ON B.res_id=A.res_id
126: LEFT JOIN $student_table AS C ON C.student_id=A.student_id
127: LEFT JOIN $machine_table AS E ON E.machine_id=A.machine_id
128: WHERE A.student_id>10
129: ORDER BY A.time DESC
130: LIMIT 500
131: };
132: } elsif ($mode =~ /^student:(.*):(.*)$/) {
133: my $student = $1.':'.$2;
134: $query = qq{
135: SELECT B.resource,A.time,A.action,E.machine,A.action_values
136: FROM $activity_table AS A
137: LEFT JOIN $res_table AS B ON B.res_id=A.res_id
138: LEFT JOIN $student_table AS C ON C.student_id=A.student_id
139: LEFT JOIN $machine_table AS E ON E.machine_id=A.machine_id
140: WHERE C.student='$student'
141: ORDER BY A.time DESC
142: LIMIT 500
143: };
144: }
145: $query =~ s|$/||g;
146: return $query;
147: }
148:
149: ###################################################################
150: ###################################################################
151: sub output_results {
152: my ($r,$results_file,$navmap,$mode) = @_;
153: ##
154: ##
155: if (! open(ACTIVITYDATA,$results_file)) {
156: $r->print('<h2>'.&mt('Unable to read results file.').'</h2>'.
157: '<p>'.
158: &mt('This is a serious error and has been logged. '.
159: 'You should contact your system administrator '.
160: 'to resolve this issue.').
161: '</p>');
162: return;
163: }
164: ##
165: ##
166: my $tableheader;
167: if ($mode eq 'full_class') {
168: $tableheader =
169: '<table><tr>'.
170: '<th>'.&mt('Resource').'</th>'.
171: '<th>'.&mt('Time').'</th>'.
172: '<th>'.&mt('Student').'</th>'.
173: '<th>'.&mt('Action').'</th>'.
174: # '<th>'.&mt('Originating Server').'</th>'.
175: '<th align="left">'.&mt('Data').'</th>'.
176: '</tr>'.$/;
177: } elsif ($mode =~ /^student:(.*):(.*)$/) {
178: $tableheader =
179: '<table><tr>'.
180: '<th>'.&mt('Resource').'</th>'.
181: '<th>'.&mt('Time').'</th>'.
182: '<th>'.&mt('Action').'</th>'.
183: # '<th>'.&mt('Originating Server').'</th>'.
184: '<th align="left">'.&mt('Data').'</th>'.
185: '</tr>'.$/;
186: }
187: my $count = -1;
188: $r->rflush();
189: ##
190: ##
191: while (my $line = <ACTIVITYDATA>) {
192: chomp($line);
193: $line = &Apache::lonnet::unescape($line);
194: if (++$count % 50 == 0) {
195: if ($count != 0) {
196: $r->print('</table>'.$/);
197: $r->rflush();
198: }
199: $r->print($tableheader);
200: }
201: my ($symb,$timestamp,$student,$action,$machine,$values);
202: if ($mode eq 'full_class') {
203: ($symb,$timestamp,$student,$action,$machine,$values) =
204: map { &Apache::lonnet::unescape($_); } split(',',$line,6);
205: } else {
206: ($symb,$timestamp,$action,$machine,$values) =
207: map { &Apache::lonnet::unescape($_); } split(',',$line,5);
208: }
209: my ($title,$src);
210: if ($symb =~ m:^/adm/:) {
211: $title = $symb;
212: $src = $symb;
213: } else {
214: my $nav_res = $navmap->getBySymb($symb);
215: if (defined($nav_res)) {
216: $title = $nav_res->title();
217: $src = $nav_res->src();
218: } else {
219: if ($src =~ m|^/res|) {
220: $title = $src;
221: } elsif ($values =~ /^\s*$/ &&
222: (! defined($src) || $src =~ /^\s*$/)) {
223: next;
224: } elsif ($values =~ /^\s*$/) {
225: $values = $src;
226: } else {
227: $title = 'unable to retrieve title';
228: $src = '/dev/null';
229: }
230: }
231: }
232: my %classes;
233: my $class_count=0;
234: if (! exists($classes{$symb})) {
235: $classes{$symb} = $class_count++;
236: }
237: my $class = 'a';#.$classes{$symb};
238: #
239: if ($symb eq '/prtspool/') {
240: $class = 'print';
241: $title = 'retrieve printout';
242: } elsif ($symb =~ m|^/adm/([^/]+)|) {
243: $class = $1;
244: } elsif ($symb =~ m|^/adm/|) {
245: $class = 'adm';
246: }
247: if ($title eq 'unable to retrieve title') {
248: $title =~ s/ /\ /g;
249: $class = 'warning';
250: }
251: if (! defined($title) || $title eq '') {
252: $title = 'untitled';
253: $class = 'warning';
254: }
255: # Clean up the values
256: $values =~ s/counter=\d+$//;
257: #
258: # Build the row for output
259: my $tablerow = qq{<tr class="$class">};
260: if ($src =~ m|^/adm/|) {
261: $tablerow .=
262: '<td><nobr>'.$title.'</td>';
263: } else {
264: $tablerow .=
265: '<td><nobr>'.
266: '<a href="'.$src.'">'.$title.'</a>'.
267: '</nobr></td>';
268: }
269: $tablerow .= '<td><nobr>'.$timestamp.'</nobr></td>';
270: if ($mode eq 'full_class') {
271: $tablerow.='<td>'.$student.'</td>';
272: }
273: $tablerow .=
274: '<td>'.$action.'</td>'.
275: # '<td>'.$machine.'</td>'.
276: '<td>'.$values.'</td>'.
277: '</tr>';
278: $r->print($tablerow.$/);
279: }
280: $r->print('</table>'.$/) if (! $count % 50);
281: close(ACTIVITYDATA);
282: return;
283: }
284:
285: ###################################################################
286: ###################################################################
287: sub request_data_update {
288: my $command = 'prepare activity log';
289: my $cid = $ENV{'request.course.id'};
290: my $domain = $ENV{'course.'.$cid.'.domain'};
291: my $home = $ENV{'course.'.$cid.'.home'};
292: my $course = $ENV{'course.'.$cid.'.num'};
293: # &Apache::lonnet::logthis($command.' '.$course.' '.$domain.' '.$home);
294: my $result = &Apache::lonnet::metadata_query($command,$course,$domain,
295: [$home]);
296: return $result;
297: }
298:
299: ###################################################################
300: ###################################################################
301: sub pick_student {
302: my ($r) = @_;
303: $r->print("Sorry, cannot display classlist at this time. Come back another time.");
304: return;
305: }
306:
307: ###################################################################
308: ###################################################################
309: sub styles {
310: return <<END;
311: <style type="text/css">
312: tr.warning { background-color: \#CCCCCC; }
313: tr.chat { background-color: \#CCCCCC; }
314: tr.chatfetch { background-color: \#CCCCCC; }
315: tr.navmaps { background-color: \#CCCCCC; }
316: tr.roles { background-color: \#CCCCCC; }
317: tr.flip { background-color: \#CCCCCC; }
318: tr.adm { background-color: \#CCCCCC; }
319: tr.print { background-color: \#CCCCCC; }
320: tr.printout { background-color: \#CCCCCC; }
321: tr.parmset { background-color: \#CCCCCC; }
322: tr.grades { background-color: \#CCCCCC; }
323: </style>
324: END
325: }
326:
327: sub developer_centric_styles {
328: return <<END;
329: <style type="text/css">
330: tr.warning { background-color: red; }
331: tr.chat { background-color: yellow; }
332: tr.chatfetch { background-color: yellow; }
333: tr.evaluate { background-color: red; }
334: tr.navmaps { background-color: \#777777; }
335: tr.roles { background-color: \#999999; }
336: tr.flip { background-color: \#BBBBBB; }
337: tr.adm { background-color: green; }
338: tr.print { background-color: blue; }
339: tr.parmset { background-color: \#000088; }
340: tr.printout { background-color: blue; }
341: tr.grades { background-color: \#CCCCCC; }
342: </style>
343: END
344: }
345:
346: ###################################################################
347: ###################################################################
348: sub handler {
349: my $r=shift;
350: my $c = $r->connection();
351: #
352: # Check for overloading here and on the course home server
353: my $loaderror=&Apache::lonnet::overloaderror($r);
354: if ($loaderror) { return $loaderror; }
355: $loaderror=
356: &Apache::lonnet::overloaderror
357: ($r,
358: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
359: if ($loaderror) { return $loaderror; }
360: #
361: # Check for access
362: if (! &Apache::lonnet::allowed('vsa',$ENV{'request.course.id'})) {
363: $ENV{'user.error.msg'}=
364: $r->uri.":vsa:0:0:Cannot student activity for complete course";
365: if (!
366: &Apache::lonnet::allowed('vsa',
367: $ENV{'request.course.id'}.'/'.
368: $ENV{'request.course.sec'})) {
369: $ENV{'user.error.msg'}=
370: $r->uri.":vsa:0:0:Cannot view student activity with given role";
371: return HTTP_NOT_ACCEPTABLE;
372: }
373: }
374: #
375: # Send the header
376: &Apache::loncommon::no_cache($r);
377: &Apache::loncommon::content_type($r,'text/html');
378: $r->send_http_header;
379: if ($r->header_only) { return OK; }
380: #
381: # Extract form elements from query string
382: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
383: ['selected_student']);
384: #
385: # We will almost always need this...
386: my $navmap = Apache::lonnavmaps::navmap->new();
387: #
388: &Apache::lonhtmlcommon::clear_breadcrumbs();
389: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/studentactivity',
390: title=>'Student Activity',
391: text =>'Student Activity',
392: faq=>139,
393: bug=>'instructor interface'});
394: #
395: # Give the LON-CAPA page header
396: $r->print('<html><head>'.&styles.'<title>'.
397: &mt('Student Activity').
398: "</title></head>\n".
399: &Apache::loncommon::bodytag('Student Activity').
400: &Apache::lonhtmlcommon::breadcrumbs(undef,'Student Activity'));
401: $r->rflush();
402: #
403: # Begin form output
404: $r->print('<form name="trackstudent" method="post" action="/adm/trackstudent">');
405: $r->print('<br />');
406: $r->print('<div name="statusline">'.
407: &mt('Status:[_1]',
408: '<input type="text" name="status" size="60" value="" />').
409: '</div>');
410: $r->rflush();
411: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
412: ($r,&mt('Student Activity Retrieval'),
413: &mt('Student Activity Retrieval'),undef,'inline',undef,
414: 'trackstudent','status');
415: &Apache::lonhtmlcommon::Update_PrgWin
416: ($r,\%prog_state,&mt('Contacting course home server'));
417: #
418: my $result = &request_data_update();
419: if (ref($result) eq 'HASH') {
420: $result = join(' ',map { $_.'=>'.$result->{$_}; } keys(%$result));
421: }
422: #
423: if (exists($ENV{'form.selected_student'})) {
424: # For now, just show all the data, in the future allow selection of
425: # a student
426: my ($sname,$sdom) = split(':',$ENV{'form.selected_student'});
427: if ($sname =~ /^\w*$/ && $sdom =~ /^\w*$/) {
428: $r->print('<h2>'.
429: &mt('Recent activity of [_1]@[_2]',$sname,$sdom).
430: '</h2>');
431: $r->print('<p>'.&mt(<<END).'</p>');
432: Compiling student activity data can take a long time.
433: It may be necessary to reload this page to get the most current information.
434: END
435: &get_data($r,\%prog_state,$navmap,
436: 'student:'.$ENV{'form.selected_student'});
437: } else {
438: $r->print('<h2>'.&mt('Unable to process for [_1]@[_2]',
439: $sname,$sdom).'</h2>');
440: }
441: } else {
442: # For now, just show all the data instead of limiting it to one student
443: &get_data($r,\%prog_state,$navmap,'full_class');
444: }
445: #
446: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Done'));
447: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
448: #
449: $r->print("</form>\n");
450: $r->print("</body>\n</html>\n");
451: $r->rflush();
452: #
453: return OK;
454: }
455:
456: 1;
457:
458: #######################################################
459: #######################################################
460:
461: =pod
462:
463: =back
464:
465: =cut
466:
467: #######################################################
468: #######################################################
469:
470: __END__
471:
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