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