loncom/interface/lontrackstudent.pm - view

File: [LON-CAPA] / loncom / interface / lontrackstudent.pm
Revision 1.21: download - view: text, annotated - select for diffs
Wed Dec 6 22:22:37 2006 UTC (18 years, 1 month ago) by albertel
Branches: MAIN
CVS tags: version_2_3_X, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_99_1, version_2_2_99_0, HEAD

- more re fix ups

# The LearningOnline Network with CAPA # # $Id: lontrackstudent.pm,v 1.21 2006/12/06 22:22:37 albertel Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ### =pod =head1 NAME lontrackstudent =head1 SYNOPSIS Track student progress through course materials =over 4 =cut package Apache::lontrackstudent; use strict; use Apache::Constants qw(:common :http); use Apache::lonmysql; use Apache::lonnet; use Apache::lonlocal; use Time::HiRes; use lib '/home/httpd/lib/perl/'; use LONCAPA; my $num_records=500; sub get_data { my ($r,$prog_state,$navmap,$mode) = @_; ## ## Compose the query &Apache::lonhtmlcommon::Update_PrgWin ($r,$prog_state,&mt('Composing Query')); # # Allow the other server to begin processing the data before we ask for it. sleep(5); # my $max_time = &get_max_time_in_db($r,$prog_state); if (defined($max_time)) { $r->print('<h3>'.&mt('Activity data compiled up to [_1]', &Apache::lonlocal::locallocaltime($max_time)). '</h3>'.&mt('While data is processed, periodically reload this page for more recent activity').'<br />'); $r->rflush(); } else { $r->print('<h3>'.&mt('Unable to retrieve any data. Please reload this page and try again.').'</h3>'); return; } my $query = &build_query($mode); ## ## Send it along my $home = $env{'course.'.$env{'request.course.id'}.'.home'}; my $reply=&Apache::lonnet::metadata_query($query,undef,undef,[$home]); if (ref($reply) ne 'HASH') { $r->print('<h2>'. &mt('Error contacting home server for course: [_1]', $reply). '</h2>'); return; } my $results_file = $r->dir_config('lonDaemons').'/tmp/'.$reply->{$home}; my $endfile = $results_file.'.end'; ## ## Check for the results &Apache::lonhtmlcommon::Update_PrgWin ($r,$prog_state,&mt('Waiting for results')); my $maxtime = 500; my $starttime = time; while (! -e $endfile && (time-$starttime < $maxtime)) { &Apache::lonhtmlcommon::Update_PrgWin ($r,$prog_state,&mt('Waiting up to [_1] seconds for results', $starttime+$maxtime-time)); sleep(1); } if (! -e $endfile) { $r->print('<h2>'. &mt('Unable to retrieve data.').'</h2>'); $r->print(&mt('Please try again in a few minutes.')); return; } $r->rflush(); # &Apache::lonhtmlcommon::Update_PrgWin ($r,$prog_state,&mt('Parsing results')); # &output_results($r,$results_file,$navmap,$mode); my ($sname,$sdom) = ($mode=~/^student:(.*):(.*)$/); $r->print(&Apache::loncommon::track_student_link( 'View more activity by this student', $sname,$sdom,undef, ($env{'form.start'}+$num_records))); &Apache::lonhtmlcommon::Update_PrgWin($r,$prog_state,&mt('Finished!')); return; } sub table_names { my $cid = $env{'request.course.id'}; my $domain = $env{'course.'.$cid.'.domain'}; my $home = $env{'course.'.$cid.'.home'}; my $course = $env{'course.'.$cid.'.num'}; my $prefix = $course.'_'.$domain.'_'; # my %tables = ( student =>&Apache::lonmysql::fix_table_name($prefix.'students'), res =>&Apache::lonmysql::fix_table_name($prefix.'resource'), machine =>&Apache::lonmysql::fix_table_name($prefix.'machine_table'), activity=>&Apache::lonmysql::fix_table_name($prefix.'activity'), ); return %tables; } sub get_max_time_in_db { my ($r,$prog_state) = @_; my %table = &table_names(); my $query = qq{SELECT MAX(time) FROM $table{'activity'} }; # my $home = $env{'course.'.$env{'request.course.id'}.'.home'}; my $reply=&Apache::lonnet::metadata_query($query,undef,undef,[$home]); if (ref($reply) ne 'HASH') { return undef; } my $results_file = $r->dir_config('lonDaemons').'/tmp/'.$reply->{$home}; my $endfile = $results_file.'.end'; ## ## Check for the results &Apache::lonhtmlcommon::Update_PrgWin ($r,$prog_state,&mt('Waiting for results')); my $maxtime = 500; my $starttime = time; while (! -e $endfile && (time-$starttime < $maxtime)) { &Apache::lonhtmlcommon::Update_PrgWin ($r,$prog_state,&mt('Waiting up to [_1] seconds for results', $starttime+$maxtime-time)); sleep(1); } if (! -e $endfile) { $r->print('<h2>'. &mt('Unable to retrieve data.').'</h2>'); $r->print(&mt('Please try again in a few minutes.')); return undef; } $r->rflush(); # &Apache::lonhtmlcommon::Update_PrgWin ($r,$prog_state,&mt('Parsing results')); # if (! open(TIMEDATA,$results_file)) { $r->print('<h2>'.&mt('Unable to read results file.').'</h2>'. '<p>'. &mt('This is a serious error and has been logged. '. 'You should contact your system administrator '. 'to resolve this issue.'). '</p>'); return; } # my $timestr = ''; while (my $line = <TIMEDATA>) { chomp($line); $timestr = &unescape($line); } close(TIMEDATA); return &Apache::lonmysql::unsqltime($timestr); } sub build_query { my ($mode) = @_; my $cid = $env{'request.course.id'}; my $domain = $env{'course.'.$cid.'.domain'}; my $home = $env{'course.'.$cid.'.home'}; my $course = $env{'course.'.$cid.'.num'}; my $prefix = $course.'_'.$domain.'_'; my $start = ($env{'form.start'}+0); # my %table = &table_names(); # my $query; if ($mode eq 'full_class') { $query = qq{ SELECT B.resource,A.time,C.student,A.action,E.machine,A.action_values FROM $table{'activity'} AS A LEFT JOIN $table{'res'} AS B ON B.res_id=A.res_id LEFT JOIN $table{'student'} AS C ON C.student_id=A.student_id LEFT JOIN $table{'machine'} AS E ON E.machine_id=A.machine_id ORDER BY A.time DESC LIMIT $start, $num_records }; } elsif ($mode =~ /^student:(.*):(.*)$/) { my $student = $1.':'.$2; $query = qq{ SELECT B.resource,A.time,A.action,E.machine,A.action_values FROM $table{'activity'} AS A LEFT JOIN $table{'res'} AS B ON B.res_id=A.res_id LEFT JOIN $table{'student'} AS C ON C.student_id=A.student_id LEFT JOIN $table{'machine'} AS E ON E.machine_id=A.machine_id WHERE C.student='$student' ORDER BY A.time DESC LIMIT $start, $num_records }; } $query =~ s|$/||g; return $query; } ################################################################### ################################################################### sub output_results { my ($r,$results_file,$navmap,$mode) = @_; ## ## if (! -s $results_file) { # results file is empty, just let them know there is no data $r->print('<h2>'.&mt('So far, no data has been returned for your request').'</h2>'); return; } if (! open(ACTIVITYDATA,$results_file)) { $r->print('<h2>'.&mt('Unable to read results file.').'</h2>'. '<p>'. &mt('This is a serious error and has been logged. '. 'You should contact your system administrator '. 'to resolve this issue.'). '</p>'); return; } ## ## my $tableheader; if ($mode eq 'full_class') { $tableheader = '<table><tr>'. '<th>'.&mt('Resource').'</th>'. '<th>'.&mt('Time').'</th>'. '<th>'.&mt('Student').'</th>'. '<th>'.&mt('Action').'</th>'. # '<th>'.&mt('Originating Server').'</th>'. '<th align="left">'.&mt('Data').'</th>'. '</tr>'.$/; } elsif ($mode =~ /^student:(.*):(.*)$/) { $tableheader = '<table><tr>'. '<th>'.&mt('Resource').'</th>'. '<th>'.&mt('Time').'</th>'. '<th>'.&mt('Action').'</th>'. # '<th>'.&mt('Originating Server').'</th>'. '<th align="left">'.&mt('Data').'</th>'. '</tr>'.$/; } my $count = $env{'form.start'}-1; $r->rflush(); ## ## while (my $line = <ACTIVITYDATA>) { # FIXME: does not pass symbs along :( chomp($line); $line = &unescape($line); if (++$count % 50 == 0) { if ($count != 0) { $r->print('</table>'.$/); $r->rflush(); } $r->print($tableheader); } my ($symb,$timestamp,$student,$action,$machine,$values); if ($mode eq 'full_class') { ($symb,$timestamp,$student,$action,$machine,$values) = split(',',$line,6); } else { ($symb,$timestamp,$action,$machine,$values) = split(',',$line,5); } foreach ($symb,$timestamp,$student,$action,$machine) { $_=&unescape($_); } my ($title,$src); if ($symb =~ m:^/adm/:) { $title = $symb; $src = $symb; } else { my $nav_res = $navmap->getBySymb($symb); if (defined($nav_res)) { $title = $nav_res->compTitle(); $src = $nav_res->src(); } else { if ($src =~ m|^/res|) { $title = $src; } elsif ($values =~ /^\s*$/ && (! defined($src) || $src =~ /^\s*$/)) { next; } elsif ($values =~ /^\s*$/) { $values = $src; } else { $title = 'unable to retrieve title'; $src = '/dev/null'; } } } my %classes; my $class_count=0; if (! exists($classes{$symb})) { $classes{$symb} = $class_count++; } my $class = 'a';#.$classes{$symb}; # if ($symb eq '/prtspool/') { $class = 'print'; $title = 'retrieve printout'; } elsif ($symb =~ m|^/adm/([^/]+)|) { $class = $1; } elsif ($symb =~ m|^/adm/|) { $class = 'adm'; } if ($title eq 'unable to retrieve title') { $title =~ s/ /\ /g; $class = 'warning'; } if (! defined($title) || $title eq '') { $title = 'untitled'; $class = 'warning'; } # Clean up the values $values = &display_values($action,$values); # # Build the row for output my $tablerow = qq{<tr class="$class"><td>}.($count+1).qq{</td>}; if ($src =~ m|^/adm/|) { $tablerow .= '<td valign="top"><nobr>'.$title.'</nobr></td>'; } else { $tablerow .= '<td valign="top"><nobr>'. '<a href="'.$src.'">'.$title.'</a>'. '</nobr></td>'; } $tablerow .= '<td valign="top"><nobr>'.$timestamp.'</nobr></td>'; if ($mode eq 'full_class') { $tablerow.='<td valign="top">'.$student.'</td>'; } $tablerow .= '<td valign="top">'.$action.'</td>'. # '<td>'.$machine.'</td>'. '<td valign="top">'.$values.'</td>'. '</tr>'; $r->print($tablerow.$/); } $r->print('</table>'.$/);### if (! $count % 50); close(ACTIVITYDATA); return; } ################################################################### ################################################################### sub display_values { my ($action,$values)=@_; my $result='<table>'; if ($action eq 'CSTORE') { my %values=map {split('=',$_,-1)} split(/\&/,$values); foreach my $key (sort(keys(%values))) { $result.='<tr><td align="right">'. &unescape($key). '</td><td>=</td><td align="left">'. &unescape($values{$key}).'</td></tr>'; } $result.='</table>'; } elsif ($action eq 'POST') { my %values= map {split('=',&unescape($_),-1)} split(/\&/,$values); foreach my $key (sort(keys(%values))) { if ($key eq 'counter') { next; } $result.='<tr><td align="right">'.$key.'</td>'. '<td>=</td><td align="left">'.$values{$key}.'</td></tr>'; } $result.='</table>'; } else { $result=&unescape($values) } return $result; } ################################################################### ################################################################### sub request_data_update { my $command = 'prepare activity log'; my $cid = $env{'request.course.id'}; my $domain = $env{'course.'.$cid.'.domain'}; my $home = $env{'course.'.$cid.'.home'}; my $course = $env{'course.'.$cid.'.num'}; # &Apache::lonnet::logthis($command.' '.$course.' '.$domain.' '.$home); my $result = &Apache::lonnet::metadata_query($command,$course,$domain, [$home]); return $result; } ################################################################### ################################################################### sub pick_student { my ($r) = @_; $r->print("Sorry, cannot display classlist at this time. Come back another time."); return; } ################################################################### ################################################################### sub styles { return <<END; <style type="text/css"> tr.warning { background-color: \#CCCCCC; } tr.chat { background-color: \#CCCCCC; } tr.chatfetch { background-color: \#CCCCCC; } tr.navmaps { background-color: \#CCCCCC; } tr.roles { background-color: \#CCCCCC; } tr.flip { background-color: \#CCCCCC; } tr.adm { background-color: \#CCCCCC; } tr.print { background-color: \#CCCCCC; } tr.printout { background-color: \#CCCCCC; } tr.parmset { background-color: \#CCCCCC; } tr.grades { background-color: \#CCCCCC; } </style> END } sub developer_centric_styles { return <<END; <style type="text/css"> tr.warning { background-color: red; } tr.chat { background-color: yellow; } tr.chatfetch { background-color: yellow; } tr.evaluate { background-color: red; } tr.navmaps { background-color: \#777777; } tr.roles { background-color: \#999999; } tr.flip { background-color: \#BBBBBB; } tr.adm { background-color: green; } tr.print { background-color: blue; } tr.parmset { background-color: \#000088; } tr.printout { background-color: blue; } tr.grades { background-color: \#CCCCCC; } </style> END } ################################################################### ################################################################### sub handler { my $r=shift; my $c = $r->connection(); # # Check for overloading here and on the course home server my $loaderror=&Apache::lonnet::overloaderror($r); if ($loaderror) { return $loaderror; } $loaderror= &Apache::lonnet::overloaderror ($r, $env{'course.'.$env{'request.course.id'}.'.home'}); if ($loaderror) { return $loaderror; } # # Check for access if (! &Apache::lonnet::allowed('vsa',$env{'request.course.id'})) { $env{'user.error.msg'}= $r->uri.":vsa:0:0:Cannot student activity for complete course"; if (! &Apache::lonnet::allowed('vsa', $env{'request.course.id'}.'/'. $env{'request.course.sec'})) { $env{'user.error.msg'}= $r->uri.":vsa:0:0:Cannot view student activity with given role"; return HTTP_NOT_ACCEPTABLE; } } # # Send the header &Apache::loncommon::no_cache($r); &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; if ($r->header_only) { return OK; } # # Extract form elements from query string &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['selected_student','start']); # # We will almost always need this... my $navmap = Apache::lonnavmaps::navmap->new(); # &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/studentactivity', title=>'Student Activity', text =>'Student Activity', faq=>139, bug=>'instructor interface'}); # # Give the LON-CAPA page header $r->print(&Apache::loncommon::start_page('Student Activity',&styles()). &Apache::lonhtmlcommon::breadcrumbs('Student Activity')); $r->rflush(); # # Begin form output $r->print('<form name="trackstudent" method="post" action="/adm/trackstudent">'); $r->print('<br />'); $r->print('<div name="statusline">'. &mt('Status:[_1]', '<input type="text" name="status" size="60" value="" />'). '</div>'); $r->rflush(); my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin ($r,&mt('Student Activity Retrieval'), &mt('Student Activity Retrieval'),undef,'inline',undef, 'trackstudent','status'); &Apache::lonhtmlcommon::Update_PrgWin ($r,\%prog_state,&mt('Contacting course home server')); # my $result = &request_data_update(); # if (exists($env{'form.selected_student'})) { # For now, just show all the data, in the future allow selection of # a student my ($sname,$sdom) = split(':',$env{'form.selected_student'}); if ($sname =~ /^$LONCAPA::username_re$/ && $sdom =~ /^$LONCAPA::domain_re$/) { $r->print('<h2>'. &mt('Recent activity of [_1]:[_2]',$sname,$sdom). '</h2>'); $r->print('<p>'.&mt(<<END).'</p>'); Compiling student activity data can take a long time. Your request continues to be processed while results are displayed. END &get_data($r,\%prog_state,$navmap, 'student:'.$env{'form.selected_student'}); } else { $r->print('<h2>'.&mt('Unable to process for [_1]:[_2]', $sname,$sdom).'</h2>'); } } else { # For now, just show all the data instead of limiting it to one student &get_data($r,\%prog_state,$navmap,'full_class'); } # &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Done')); &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); # $r->print("</form>\n"); $r->print(&Apache::loncommon::end_page()); $r->rflush(); # return OK; } 1; ####################################################### ####################################################### =pod =back =cut ####################################################### ####################################################### __END__