Annotation of loncom/interface/lontrackstudent.pm, revision 1.6
1.1 matthew 1: # The LearningOnline Network with CAPA
2: #
1.6 ! matthew 3: # $Id: lontrackstudent.pm,v 1.5 2004/08/25 15:53:34 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.6 ! matthew 91: # $r->print('<h2>'.&mt('Elapsed Time = [_1] seconds',
! 92: # time-$starttime).'</h2>');
1.5 matthew 93: $r->rflush();
1.2 matthew 94: &Apache::lonhtmlcommon::Update_PrgWin
95: ($r,$prog_state,&mt('Parsing results'));
1.6 ! matthew 96: # $r->print('<h2>'.
! 97: # &mt('Reloading this page may result in newer data').
! 98: # '</h2>');
1.5 matthew 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
1.6 ! matthew 128: LIMIT 500
1.5 matthew 129: };
130: } elsif ($mode =~ /^student:(.*):(.*)$/) {
131: my $student = $1.':'.$2;
132: $query = qq{
1.6 ! matthew 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 500
! 141: };
1.5 matthew 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.6 ! matthew 151: ##
! 152: ##
1.2 matthew 153: if (! open(ACTIVITYDATA,$results_file)) {
1.4 matthew 154: $r->print('<h2>'.&mt('Unable to read results file.').'</h2>'.
155: '<p>'.
156: &mt('This is a serious error and has been logged. '.
157: 'You should contact your system administrator '.
158: 'to resolve this issue.').
159: '</p>');
1.2 matthew 160: return;
161: }
1.6 ! matthew 162: ##
! 163: ##
1.5 matthew 164: my $tableheader;
165: if ($mode eq 'full_class') {
166: $tableheader =
167: '<table><tr>'.
168: '<th>'.&mt('Resource').'</th>'.
169: '<th>'.&mt('Time').'</th>'.
170: '<th>'.&mt('Student').'</th>'.
171: '<th>'.&mt('Action').'</th>'.
1.6 ! matthew 172: # '<th>'.&mt('Originating Server').'</th>'.
! 173: '<th align="left">'.&mt('Data').'</th>'.
! 174: '</tr>'.$/;
! 175: } elsif ($mode =~ /^student:(.*):(.*)$/) {
! 176: $tableheader =
! 177: '<table><tr>'.
! 178: '<th>'.&mt('Resource').'</th>'.
! 179: '<th>'.&mt('Time').'</th>'.
! 180: '<th>'.&mt('Action').'</th>'.
! 181: # '<th>'.&mt('Originating Server').'</th>'.
! 182: '<th align="left">'.&mt('Data').'</th>'.
1.5 matthew 183: '</tr>'.$/;
184: }
185: my $count = -1;
1.2 matthew 186: $r->rflush();
1.6 ! matthew 187: ##
! 188: ##
1.2 matthew 189: while (my $line = <ACTIVITYDATA>) {
1.6 ! matthew 190: chomp($line);
1.2 matthew 191: $line = &Apache::lonnet::unescape($line);
192: if (++$count % 50 == 0) {
1.5 matthew 193: if ($count != 0) {
194: $r->print('</table>'.$/);
195: $r->rflush();
196: }
1.2 matthew 197: $r->print($tableheader);
198: }
1.5 matthew 199: my ($symb,$timestamp,$student,$action,$machine,$values);
200: if ($mode eq 'full_class') {
201: ($symb,$timestamp,$student,$action,$machine,$values) =
202: map { &Apache::lonnet::unescape($_); } split(',',$line,6);
203: } else {
204: ($symb,$timestamp,$action,$machine,$values) =
205: map { &Apache::lonnet::unescape($_); } split(',',$line,5);
206: }
1.2 matthew 207: my ($title,$src);
1.4 matthew 208: if ($symb =~ m:^/adm/:) {
1.2 matthew 209: $title = $symb;
210: $src = $symb;
211: } else {
1.4 matthew 212: my $nav_res = $navmap->getBySymb($symb);
213: if (defined($nav_res)) {
214: $title = $nav_res->title();
215: $src = $nav_res->src();
216: } else {
1.6 ! matthew 217: if ($src =~ m|^/res|) {
! 218: $title = $src;
! 219: } elsif ($values =~ /^\s*$/ &&
! 220: (! defined($src) || $src =~ /^\s*$/)) {
! 221: next;
! 222: } elsif ($values =~ /^\s*$/) {
! 223: $values = $src;
! 224: } else {
! 225: $title = 'unable to retrieve title';
! 226: $src = '/dev/null';
! 227: }
1.4 matthew 228: }
1.2 matthew 229: }
1.6 ! matthew 230: my %classes;
! 231: my $class_count=0;
! 232: if (! exists($classes{$symb})) {
! 233: $classes{$symb} = $class_count++;
! 234: }
! 235: my $class = 'a';#.$classes{$symb};
1.4 matthew 236: #
1.5 matthew 237: if ($symb eq '/prtspool/') {
1.4 matthew 238: $class = 'print';
239: $title = 'retrieve printout';
240: } elsif ($symb =~ m|^/adm/([^/]+)|) {
241: $class = $1;
242: } elsif ($symb =~ m|^/adm/|) {
243: $class = 'adm';
244: }
245: if ($title eq 'unable to retrieve title') {
246: $title =~ s/ /\ /g;
247: $class = 'warning';
248: }
249: if (! defined($title) || $title eq '') {
250: $title = 'untitled';
251: $class = 'warning';
252: }
1.6 ! matthew 253: # Clean up the values
! 254: $values =~ s/counter=\d+$//;
! 255: #
! 256: # Build the row for output
! 257: my $tablerow = qq{<tr class="$class">};
! 258: if ($src =~ m|^/adm/|) {
! 259: $tablerow .=
! 260: '<td><nobr>'.$title.'</td>';
! 261: } else {
! 262: $tablerow .=
! 263: '<td><nobr>'.
! 264: '<a href="'.$src.'">'.$title.'</a>'.
! 265: '</nobr></td>';
1.5 matthew 266: }
1.6 ! matthew 267: $tablerow .= '<td><nobr>'.$timestamp.'</nobr></td>';
1.5 matthew 268: if ($mode eq 'full_class') {
1.6 ! matthew 269: $tablerow.='<td>'.$student.'</td>';
1.5 matthew 270: }
1.6 ! matthew 271: $tablerow .=
! 272: '<td>'.$action.'</td>'.
! 273: # '<td>'.$machine.'</td>'.
! 274: '<td>'.$values.'</td>'.
! 275: '</tr>';
! 276: $r->print($tablerow.$/);
1.2 matthew 277: }
1.5 matthew 278: $r->print('</table>'.$/) if (! $count % 50);
1.2 matthew 279: close(ACTIVITYDATA);
280: return;
281: }
282:
1.5 matthew 283: ###################################################################
284: ###################################################################
1.1 matthew 285: sub request_data_update {
286: my $command = 'prepare activity log';
287: my $cid = $ENV{'request.course.id'};
288: my $domain = $ENV{'course.'.$cid.'.domain'};
289: my $home = $ENV{'course.'.$cid.'.home'};
290: my $course = $ENV{'course.'.$cid.'.num'};
1.6 ! matthew 291: # &Apache::lonnet::logthis($command.' '.$course.' '.$domain.' '.$home);
1.1 matthew 292: my $result = &Apache::lonnet::metadata_query($command,$course,$domain,
293: [$home]);
294: return $result;
295: }
296:
297: ###################################################################
298: ###################################################################
1.5 matthew 299: sub pick_student {
300: my ($r) = @_;
301: $r->print("Sorry, cannot display classlist at this time. Come back another time.");
302: return;
303: }
1.1 matthew 304:
1.5 matthew 305: ###################################################################
306: ###################################################################
1.4 matthew 307: sub styles {
308: return <<END;
1.5 matthew 309: <style type="text/css">
1.6 ! matthew 310: tr.warning { background-color: \#CCCCCC; }
! 311: tr.chat { background-color: \#CCCCCC; }
! 312: tr.chatfetch { background-color: \#CCCCCC; }
! 313: tr.navmaps { background-color: \#CCCCCC; }
! 314: tr.roles { background-color: \#CCCCCC; }
! 315: tr.flip { background-color: \#CCCCCC; }
! 316: tr.adm { background-color: \#CCCCCC; }
! 317: tr.print { background-color: \#CCCCCC; }
! 318: tr.printout { background-color: \#CCCCCC; }
! 319: tr.parmset { background-color: \#CCCCCC; }
! 320: tr.grades { background-color: \#CCCCCC; }
! 321: </style>
! 322: END
! 323: }
! 324:
! 325: sub developer_centric_styles {
! 326: return <<END;
! 327: <style type="text/css">
1.4 matthew 328: tr.warning { background-color: red; }
329: tr.chat { background-color: yellow; }
330: tr.chatfetch { background-color: yellow; }
331: tr.navmaps { background-color: \#777777; }
332: tr.roles { background-color: \#999999; }
333: tr.flip { background-color: \#BBBBBB; }
334: tr.adm { background-color: green; }
335: tr.print { background-color: blue; }
1.6 ! matthew 336: tr.parmset { background-color: \#000088; }
1.4 matthew 337: tr.printout { background-color: blue; }
1.6 ! matthew 338: tr.grades { background-color: \#CCCCCC; }
1.5 matthew 339: </style>
1.4 matthew 340: END
341: }
1.1 matthew 342:
343: ###################################################################
344: ###################################################################
345: sub handler {
346: my $r=shift;
347: my $c = $r->connection();
348: #
349: # Check for overloading here and on the course home server
350: my $loaderror=&Apache::lonnet::overloaderror($r);
351: if ($loaderror) { return $loaderror; }
352: $loaderror=
353: &Apache::lonnet::overloaderror
354: ($r,
355: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
356: if ($loaderror) { return $loaderror; }
357: #
358: # Check for access
359: if (! &Apache::lonnet::allowed('vsa',$ENV{'request.course.id'})) {
360: $ENV{'user.error.msg'}=
361: $r->uri.":vsa:0:0:Cannot student activity for complete course";
362: if (!
363: &Apache::lonnet::allowed('vsa',
364: $ENV{'request.course.id'}.'/'.
365: $ENV{'request.course.sec'})) {
366: $ENV{'user.error.msg'}=
367: $r->uri.":vsa:0:0:Cannot view student activity with given role";
368: return HTTP_NOT_ACCEPTABLE;
369: }
370: }
371: #
372: # Send the header
373: &Apache::loncommon::no_cache($r);
374: &Apache::loncommon::content_type($r,'text/html');
375: $r->send_http_header;
376: if ($r->header_only) { return OK; }
377: #
378: # Extract form elements from query string
379: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
380: ['selected_student']);
381: #
1.2 matthew 382: # We will almost always need this...
383: my $navmap = Apache::lonnavmaps::navmap->new();
1.1 matthew 384: #
385: &Apache::lonhtmlcommon::clear_breadcrumbs();
386: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/studentactivity',
387: title=>'Student Activity',
388: text =>'Student Activity',
389: faq=>139,
390: bug=>'instructor interface'});
391: #
1.2 matthew 392: # Give the LON-CAPA page header
1.4 matthew 393: $r->print('<html><head>'.&styles.'<title>'.
1.2 matthew 394: &mt('Student Activity').
395: "</title></head>\n".
396: &Apache::loncommon::bodytag('Student Activity').
397: &Apache::lonhtmlcommon::breadcrumbs(undef,'Student Activity'));
398: $r->rflush();
399: #
1.1 matthew 400: # Begin form output
1.2 matthew 401: $r->print('<form name="trackstudent" method="post" action="/adm/trackstudent">');
402: $r->print('<br />');
403: $r->print('<div name="statusline">'.
404: &mt('Status:[_1]',
405: '<input type="text" name="status" size="60" value="" />').
406: '</div>');
1.1 matthew 407: $r->rflush();
1.2 matthew 408: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
409: ($r,&mt('Student Activity Retrieval'),
410: &mt('Student Activity Retrieval'),undef,'inline',undef,
411: 'trackstudent','status');
412: &Apache::lonhtmlcommon::Update_PrgWin
413: ($r,\%prog_state,&mt('Contacting course home server'));
1.1 matthew 414: #
415: my $result = &request_data_update();
416: if (ref($result) eq 'HASH') {
1.2 matthew 417: $result = join(' ',map { $_.'=>'.$result->{$_}; } keys(%$result));
1.1 matthew 418: }
419: #
1.5 matthew 420: if (exists($ENV{'form.selected_student'})) {
1.4 matthew 421: # For now, just show all the data, in the future allow selection of
422: # a student
1.5 matthew 423: my ($sname,$sdom) = split(':',$ENV{'form.selected_student'});
1.6 ! matthew 424: if ($sname =~ /^\w*$/ && $sdom =~ /^\w*$/) {
! 425: $r->print('<h2>'.
! 426: &mt('Recent activity of [_1]@[_2]',$sname,$sdom).
! 427: '</h2>');
! 428: &get_data($r,\%prog_state,$navmap,
! 429: 'student:'.$ENV{'form.selected_student'});
! 430: } else {
! 431: $r->print('<h2>'.&mt('Unable to process for [_1]@[_2]',
! 432: $sname,$sdom).'</h2>');
! 433: }
1.1 matthew 434: } else {
1.4 matthew 435: # For now, just show all the data instead of limiting it to one student
1.5 matthew 436: &get_data($r,\%prog_state,$navmap,'full_class');
1.1 matthew 437: }
438: #
1.4 matthew 439: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Done'));
440: &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
1.2 matthew 441: #
1.1 matthew 442: $r->print("</form>\n");
443: $r->print("</body>\n</html>\n");
444: $r->rflush();
445: #
446: return OK;
447: }
448:
449: 1;
450:
451: #######################################################
452: #######################################################
453:
454: =pod
455:
456: =back
457:
458: =cut
459:
460: #######################################################
461: #######################################################
462:
463: __END__
464:
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