# The LearningOnline Network with CAPA
#
# $Id: lontrackstudent.pm,v 1.33 2011/12/21 21:25:40 www 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 DateTime();
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'));
#
my $last = &output_results($r,$results_file,$navmap,$mode);
my ($sname,$sdom) = ($mode=~/^student:(.*):(.*)$/);
my ($text,$inc);
if ( $last > 0 && (($last+1) >= $env{'form.start'}+$num_records) ) {
$text = 'View more activity by this student';
$inc = $num_records;
$r->print(&Apache::loncommon::track_student_link($text,$sname,$sdom,undef,
($env{'form.start'}+$inc),
$env{'form.only_body'}
));
$r->print('<br />');
}
$r->print('<hr />');
$text = 'Resubmit last request to check for newer data';
$r->print(&Apache::loncommon::track_student_link($text,$sname,$sdom,undef,
$env{'form.start'},
$env{'form.only_body'}));
&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 -1;
}
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 -2;
}
##
##
my $tableheader;
if ($mode eq 'full_class') {
$tableheader =
'<table><tr>'.
'<th> </th>'.
'<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> </th>'.
'<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();
##
##
my $cid = $env{'request.course.id'};
my $cnum = $env{'course.'.$cid.'.num'};
my $cdom = $env{'course.'.$cid.'.domain'};
my $server_timezone = &Apache::lonnet::get_server_timezone($cnum,$cdom);
if ($server_timezone ne '') {
if (&Apache::lonlocal::gettimezone($server_timezone) eq 'local') {
$server_timezone = '';
}
}
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 {
$src = $symb;
if ($src !~ m{/adm}) {
$title = &Apache::lonnet::gettitle($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"><span class="LC_nobreak">'.$title.'</span></td>';
} else {
$tablerow .=
'<td valign="top"><span class="LC_nobreak">'.
'<a href="'.$src.'">'.$title.'</a>'.
'</span></td>';
}
if ($server_timezone ne '') {
$timestamp = &convert_timezone($server_timezone,$timestamp);
}
$tablerow .= '<td valign="top"><span class="LC_nobreak">'.$timestamp.'</span></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 $count;
}
sub convert_timezone {
my ($server_timezone,$timestamp) = @_;
if ($server_timezone && $timestamp) {
my ($date,$time) = split(/\s+/,$timestamp);
my ($year,$month,$day) = split(/\-/,$date);
my ($hour,$minute,$sec) = split(/:/,$time);
foreach ($month,$day,$hour,$minute,$sec) {
return $timestamp if $_ eq '';
$_ =~ s/^0//;
}
my $dt = DateTime->new(year => $year,
month => $month,
day => $day,
hour => $hour,
minute => $minute,
second => $sec,
time_zone => $server_timezone,
);
my $unixtime = $dt->epoch;
$timestamp = &Apache::lonlocal::locallocaltime($unixtime);
}
return $timestamp;
}
###################################################################
###################################################################
sub display_values {
my ($action,$values)=@_;
my $result='<table>';
if ($action eq 'CSTORE') {
my $is_anon;
my %values=map {split('=',$_,-1)} split(/\&/,$values);
foreach my $key (sort(keys(%values))) {
my $unesc_key = &unescape($key);
if ($values{$key} eq 'anonsurvey' || $values{$key} eq 'anonsurveycred') {
if ($unesc_key =~ /^resource\..+\.type$/) {
$is_anon = 1;
last;
}
}
$result.='<tr><td align="right">'.
$unesc_key.
'</td><td>=</td><td align="left">'.
&unescape($values{$key}).'</td></tr>';
}
$result.='</table>';
if ($is_anon) {
$result = '<span class="LC_warning">'.&mt('Anonymous Survey Submission: details not shown').'</span>';
}
} elsif ($action eq 'POST') {
my %values;
foreach my $pair (split(/\&/,$values)) {
my ($key,$value) = split('=',&unescape($pair),-1);
$values{$key} = $value;
}
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 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','only_body']);
#
# We will almost always need this...
my $navmap = Apache::lonnavmaps::navmap->new();
if (!defined($navmap)) {
my $requrl = $r->uri;
$env{'user.error.msg'} = "$requrl:bre:0:0:Navmap initialization failed.";
return HTTP_NOT_ACCEPTABLE;
}
#
&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
my $args;
if ($env{'form.only_body'}) {
$args = { only_body => 1, };
}
$r->print(&Apache::loncommon::start_page('Student Activity',&styles(),$args).
&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="" readonly="readonly" />').
'</div>');
$r->rflush();
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r);
&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]',$sname.':'.$sdom).
'</h2>');
$r->print('<p class="LC_info">'
.&mt('Compiling student activity data can take a long time.'
.' Your request continues to be processed while results are displayed.')
.'</p>'
);
&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__
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