# 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('
'.&mt('Activity data compiled up to [_1]',
&Apache::lonlocal::locallocaltime($max_time)).
'
'.&mt('While data is processed, periodically reload this page for more recent activity').'
');
$r->rflush();
} else {
$r->print(''.&mt('Unable to retrieve any data. Please reload this page and try again.').'
');
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(''.
&mt('Error contacting home server for course: [_1]',
$reply).
'
');
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(''.
&mt('Unable to retrieve data.').'
');
$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(''.
&mt('Unable to retrieve data.').'
');
$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(''.&mt('Unable to read results file.').'
'.
''.
&mt('This is a serious error and has been logged. '.
'You should contact your system administrator '.
'to resolve this issue.').
'
');
return;
}
#
my $timestr = '';
while (my $line = ) {
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(''.&mt('So far, no data has been returned for your request').'
');
return;
}
if (! open(ACTIVITYDATA,$results_file)) {
$r->print(''.&mt('Unable to read results file.').'
'.
''.
&mt('This is a serious error and has been logged. '.
'You should contact your system administrator '.
'to resolve this issue.').
'
');
return;
}
##
##
my $tableheader;
if ($mode eq 'full_class') {
$tableheader =
''.
''.&mt('Resource').' | '.
''.&mt('Time').' | '.
''.&mt('Student').' | '.
''.&mt('Action').' | '.
# ''.&mt('Originating Server').' | '.
''.&mt('Data').' | '.
'
'.$/;
} elsif ($mode =~ /^student:(.*):(.*)$/) {
$tableheader =
''.
''.&mt('Resource').' | '.
''.&mt('Time').' | '.
''.&mt('Action').' | '.
# ''.&mt('Originating Server').' | '.
''.&mt('Data').' | '.
'
'.$/;
}
my $count = $env{'form.start'}-1;
$r->rflush();
##
##
while (my $line = ) {
# FIXME: does not pass symbs along :(
chomp($line);
$line = &unescape($line);
if (++$count % 50 == 0) {
if ($count != 0) {
$r->print('
'.$/);
$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{}.($count+1).qq{ | };
if ($src =~ m|^/adm/|) {
$tablerow .=
''.$title.' | ';
} else {
$tablerow .=
''.
''.$title.''.
' | ';
}
$tablerow .= ''.$timestamp.' | ';
if ($mode eq 'full_class') {
$tablerow.=''.$student.' | ';
}
$tablerow .=
''.$action.' | '.
# ''.$machine.' | '.
''.$values.' | '.
'
';
$r->print($tablerow.$/);
}
$r->print('
'.$/);### if (! $count % 50);
close(ACTIVITYDATA);
return;
}
###################################################################
###################################################################
sub display_values {
my ($action,$values)=@_;
my $result='';
if ($action eq 'CSTORE') {
my %values=map {split('=',$_,-1)} split(/\&/,$values);
foreach my $key (sort(keys(%values))) {
$result.=''.
&unescape($key).
' | = | '.
&unescape($values{$key}).' |
';
}
$result.='
';
} elsif ($action eq 'POST') {
my %values=
map {split('=',&unescape($_),-1)} split(/\&/,$values);
foreach my $key (sort(keys(%values))) {
if ($key eq 'counter') { next; }
$result.=''.$key.' | '.
'= | '.$values{$key}.' |
';
}
$result.='';
} 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 <
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; }
END
}
sub developer_centric_styles {
return <
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; }
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('\n");
$r->print(&Apache::loncommon::end_page());
$r->rflush();
#
return OK;
}
1;
#######################################################
#######################################################
=pod
=back
=cut
#######################################################
#######################################################
__END__