# The LearningOnline Network with CAPA
#
# $Id: lontrackstudent.pm,v 1.10 2004/12/16 22:04:41 matthew 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::lonnet();
use Apache::lonlocal;
use Time::HiRes;
use Time::Local;
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 goes to [_1]',
&Apache::lonlocal::locallocaltime($max_time)).
'</h3>');
$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);
&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 => $prefix.'students',
res => $prefix.'resource',
machine => $prefix.'machine_table',
activity=> $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 = &Apache::lonnet::unescape($line);
}
close(TIMEDATA);
my ($year,$month,$day,$hour,$min,$sec) =
($timestr =~ /^(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/);
$month -= 1; # Good old timelocal
my $max_time = undef;
if (eval("&timelocal($sec,$min,$hour,$day,$month,$year)")) {
$max_time = &timelocal($sec,$min,$hour,$day,$month,$year);
}
return $max_time;
}
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 %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 500
};
} 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 500
};
}
$query =~ s|$/||g;
return $query;
}
###################################################################
###################################################################
sub output_results {
my ($r,$results_file,$navmap,$mode) = @_;
##
##
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 = -1;
$r->rflush();
##
##
while (my $line = <ACTIVITYDATA>) {
# FIXME: does not pass symbs along :(
chomp($line);
$line = &Apache::lonnet::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) =
map { &Apache::lonnet::unescape($_); } split(',',$line,6);
} else {
($symb,$timestamp,$action,$machine,$values) =
map { &Apache::lonnet::unescape($_); } split(',',$line,5);
}
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->title();
$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 =~ s/counter=\d+$//;
#
# Build the row for output
my $tablerow = qq{<tr class="$class">};
if ($src =~ m|^/adm/|) {
$tablerow .=
'<td><nobr>'.$title.'</td>';
} else {
$tablerow .=
'<td><nobr>'.
'<a href="'.$src.'">'.$title.'</a>'.
'</nobr></td>';
}
$tablerow .= '<td><nobr>'.$timestamp.'</nobr></td>';
if ($mode eq 'full_class') {
$tablerow.='<td>'.$student.'</td>';
}
$tablerow .=
'<td>'.$action.'</td>'.
# '<td>'.$machine.'</td>'.
'<td>'.$values.'</td>'.
'</tr>';
$r->print($tablerow.$/);
}
$r->print('</table>'.$/) if (! $count % 50);
close(ACTIVITYDATA);
return;
}
###################################################################
###################################################################
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']);
#
# 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('<html><head>'.&styles.'<title>'.
&mt('Student Activity').
"</title></head>\n".
&Apache::loncommon::bodytag('Student Activity').
&Apache::lonhtmlcommon::breadcrumbs(undef,'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 (ref($result) eq 'HASH') {
$result = join(' ',map { $_.'=>'.$result->{$_}; } keys(%$result));
}
#
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 =~ /^\w*$/ && $sdom =~ /^\w*$/) {
$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.
It may be necessary to reload this page to get the most current information.
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("</body>\n</html>\n");
$r->rflush();
#
return OK;
}
1;
#######################################################
#######################################################
=pod
=back
=cut
#######################################################
#######################################################
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>