Return to lontrackstudent.pm CVS log

Up to [LON-CAPA] / loncom / interface

Removed 'orginating server' column.
Reduced number of lines requested to 500.
Better handling of tables.
Changed style of table to be much less colorful.
Reduced the number of useless pieces of information output to the user.

# The LearningOnline Network with CAPA
#
# $Id: lontrackstudent.pm,v 1.6 2004/08/29 19:58:32 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;

sub get_data {
    my ($r,$prog_state,$navmap,$mode) = @_;
    ##
    ## Compose the query
    &Apache::lonhtmlcommon::Update_PrgWin
        ($r,$prog_state,&mt('Composing Query'));
    #
    my $query = &build_query($mode);
    &Apache::lonnet::logthis('sending query '.$query);
    ##
    ## 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->print('<h2>'.&mt('Elapsed Time = [_1] seconds',
#                         time-$starttime).'</h2>');
    $r->rflush();
    &Apache::lonhtmlcommon::Update_PrgWin
        ($r,$prog_state,&mt('Parsing results'));
#    $r->print('<h2>'.
#              &mt('Reloading this page may result in newer data').
#              '</h2>');
    &output_results($r,$results_file,$navmap,$mode);
    &Apache::lonhtmlcommon::Update_PrgWin($r,$prog_state,&mt('Finished!'));
    return;
}

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 $student_table  = $prefix.'students';
    my $res_table      = $prefix.'resource';
    my $action_table   = $prefix.'actions';
    my $machine_table  = $prefix.'machine_table';
    my $activity_table = $prefix.'activity';
    #
    my $query;
    if ($mode eq 'full_class') {
        $query = qq{
        SELECT B.resource,A.time,C.student,A.action,E.machine,A.action_values 
            FROM $activity_table AS A
            LEFT JOIN $res_table      AS B ON B.res_id=A.res_id 
            LEFT JOIN $student_table  AS C ON C.student_id=A.student_id 
            LEFT JOIN $machine_table  AS E ON E.machine_id=A.machine_id
            WHERE A.student_id>10
            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 $activity_table AS A
                LEFT JOIN $res_table      AS B ON B.res_id=A.res_id 
                LEFT JOIN $student_table  AS C ON C.student_id=A.student_id 
                LEFT JOIN $machine_table  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>) {
        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/ /\&nbsp;/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.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>');
            &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__