[LON-CAPA-cvs] cvs: modules /gci timeontask.pl

gci gci@source.lon-capa.org
Sat, 24 Apr 2010 15:17:45 -0000


This is a MIME encoded message

--gci1272122265
Content-Type: text/plain

gci		Sat Apr 24 15:17:45 2010 EDT

  Added files:                 
    /modules/gci	timeontask.pl 
  Log:
  - Extract times between problem display and answer submission for
    problems in GCI concept tests.
    - Output in CSV files: 
    1. status_$cnum.csv:  columns are individual questions.
                          rows are student submission status (1 =correct)
    2. timeontask_$cnum.csv: columns are individual questions.
                             rows are times between display and submission
    3. names_$cnum.csv: map row numbers in files 1&2 to student usernames
                        (for debugging only; files 1 & 2 should be the ones
                         provided to researchers). 
  
  
--gci1272122265
Content-Type: text/plain
Content-Disposition: attachment; filename="gci-20100424151745.txt"


Index: modules/gci/timeontask.pl
+++ modules/gci/timeontask.pl
#!/usr/bin/perl

#
# Stuart Raeburn, 04/23/2010
#

use strict;
use DBI;
use URI::Escape;
use POSIX qw(strftime mktime);
use lib '/home/httpd/lib/perl';
use LONCAPA;
use Apache::loncommon();
use Apache::lonnet;
use Apache::lonuserstate();
use Apache::lonnavmaps();
use Apache::loncoursedata();

my $dbh;
unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",'localhostkey',
                            { RaiseError =>0,PrintError=>0})) {
    print "Cannot connect to database!\n";
    exit;
}

my @courses;
if (!@ARGV) {
    print "Usage: timeontask.pl <coursenum1> <coursenum2> ... \n".
          "where <coursenumN> is a course number in the gcitest domain, e.g.,1z283940760524b64gcil1, for which you wish to extract data. More than one coursenumber can be entered.\n";
} else {
    @courses = @ARGV;
}

my $cdom = 'gcitest';
my $folder = 'default_1261144274.sequence';
my $role = 'st';
my $secidx = &Apache::loncoursedata::CL_SECTION(); 

foreach my $cnum (@courses) {
    my $cid = $cdom.'_'.$cnum;
    my $act_table = $cnum.'_'.$cdom.'_activity';
    my $res_table = $cnum.'_'.$cdom.'_resource';
    my $user_table = $cnum.'_'.$cdom.'_students';
    my %coursepersonnel = &Apache::lonnet::get_course_adv_roles($cid,1);
    my %allstaff;
    foreach my $role (keys(%coursepersonnel)) {
        my @staff = split(',',$coursepersonnel{$role});
        foreach my $person (@staff) {
            $allstaff{$person} = 1;
        }
    }
    my ($fh,$statusfh,$namesfh);
    unless(open $fh,'>/root/timeontask_'.$cnum.'.csv') {
        print "Could not open /root/timeontask_'.$cnum.'.csv for writing\n";
        next;
    }
    unless(open $statusfh,'>/root/status_'.$cnum.'.csv') {
        print "Could not open /root/status_'.$cnum.'.csv for writing\n";
        next;
    }
    unless(open $namesfh,'>/root/names_'.$cnum.'.csv') {
        print "Could not open /root/names_'.$cnum.'.csv for writing\n";
        next;
    }
    my %position;
    my $subdir = &propath($cnum);
    unless (open my $seqfh,"</home/httpd/lonUsers/$cdom/$subdir/userfiles/$folder") {
        while (<$seqfh>) {
            chomp();
            if (m{^<resource id=\"\d+\" src=\"/res/([^"]+)\" type=\"start\" title=\"Problem (\d+)\" />$}) {
                $position{$1} = $2;
            }
        }
    }
    my %users;
    my (%post,%cstore,%ordered,%unsubmitted,%unviewed,%times,%hists,%status,%parts);

    my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);

    my $sth=$dbh->prepare("SELECT student,student_id FROM $user_table");
    $sth->execute();
    while ( my($user,$pid)  = $sth->fetchrow_array ) {
        unless ($user eq 'raeburn:gci' || $user eq 'emgward@gmail.com:gci' || $user eq 'libarkin:gci' || $user eq 'moc:gcitest' || $user eq 'mariannec:gcitest' || $user eq 'mcaldwell@hccfl.edu:gcitest' || $user eq '	mcaldwell:gcitest' || $user eq 'mariC:gcitest') {
            next if ($allstaff{$user});
            $users{$pid} = $user;
        }
    }
    $sth->finish;
    if (keys(%users) == 0) {
        print "No students found in user table: $user_table. You may need to have LON-CAPA create  the table by logging into the course, and viewing activity for one student.\n";
        next;
    }

    $sth = $dbh->prepare("SELECT resource FROM $res_table WHERE resource LIKE 'uploaded/$cdom/$cnum/$folder%'");
    $sth->execute();
    while (my $resource = $sth->fetchrow_array ) {
        if ($resource =~ /sequence___(\d+)___/) {
            $ordered{$1} = $resource;
        }
    }

    print $fh ',';
    print $statusfh ',';
    foreach my $res (sort { $a <=> $b } (keys(%ordered))) {
        my $resource = $ordered{$res};
        my ($name) = ($resource =~ m{([^/]+)\.problem$});
        print $fh $name.',';
        print $statusfh $name.',';
    }
    print $fh "\n";
    print $statusfh "\n";

    foreach my $pid (sort(keys(%users))) {
        my $query = "SELECT r.resource,a.time from $act_table a, $res_table r where a.student_id = '$pid' AND a.action = 'POST' AND a.action_values LIKE 'symb%' AND  a.res_id=r.res_id ORDER by a.time";
        $sth = $dbh->prepare($query);
        $sth->execute();
        while ( my($resource,$time)  = $sth->fetchrow_array ) {
            my $timestamp = &unsqltime($time);
            push(@{$post{$users{$pid}}{$resource}},$timestamp);
        }
        $sth->finish;
        $query = "SELECT r.resource,a.time,a.action_values from $act_table a, $res_table r where a.student_id = '$pid' AND a.action = 'CSTORE' AND  a.res_id=r.res_id ORDER by a.time";
        $sth = $dbh->prepare($query);
        $sth->execute();
        while ( my($resource,$time,$action)  = $sth->fetchrow_array ) {
            next if ($action =~ /regrader=emgward/);
            $resource = &URI::Escape::uri_unescape($resource);
            my $timestamp = &unsqltime($time);
            push(@{$cstore{$users{$pid}}{$resource}},$timestamp);
        }
        $sth->finish;
    }

    foreach my $user (sort(keys(%post))) {
        $status{$user} = {};
        $parts{$user} = {};
        my ($uname,$udom) = split(':',$user);
        my $home = &Apache::lonnet::homeserver($uname,$udom);
        my $sec;
        if (ref($classlist) eq 'HASH') {
            if (ref($classlist->{$user}) eq 'ARRAY') {
                $sec=$classlist->{$user}->[$secidx];
            }
        }
        my @symbs = &walk_course($user,$cid,$home,$folder,$role,$sec,$parts{$user});
        my ($lastcstore,$lastpost);
        foreach my $resource (@symbs) {
            my (@posts,@cstores); 
            if (ref($post{$user}{$resource}) eq 'ARRAY') {
                @posts = @{$post{$user}{$resource}};
            }
            if (ref($cstore{$user}{$resource}) eq 'ARRAY') {
                @cstores = @{$cstore{$user}{$resource}}; 
            }
            if (!@cstores) {
                unless (ref($hists{$user}) eq 'HASH') {
                    my ($uname,$udom) = split(':',$user);
                    my $subdir = &propath($uname);
                    if (open(my $histfh,"</home/httpd/lonUsers/$udom/$subdir/".$cdom.'_'.$cnum.'.hist')) {
                        while(<$histfh>) {
                            chomp();
                            my ($action,$stamp,$res,$submission) = split(/:/);
                            if (($action eq 'S') && ($submission =~ /tries=1/)) {
                                $res = &URI::Escape::uri_unescape($res);
                                push(@{$hists{$user}{$res}},$stamp);
                            }
                        }
                        close($histfh);
                    }
                }
                if (ref($hists{$user}) eq 'HASH') { 
                    if (ref($hists{$user}{$resource}) eq 'ARRAY') {
                        push(@{$times{$user}{$resource}},$hists{$user}{$resource});
                        @cstores = @{$hists{$user}{$resource}};
                    }
                }
            }
            if (@cstores) {
                my %record=&Apache::lonnet::restore($resource,$cid,$udom,$uname);
                if (ref($parts{$user}) eq 'HASH') {
                    if (ref($parts{$user}{$resource}) eq 'ARRAY') {
                        my $numcorrect = 0;
                        my $partscount = 0;
                        foreach my $part (@{$parts{$user}{$resource}}) { 
                            if ($record{'resource.'.$part.'.solved'} =~ /^correct/) {
                                $numcorrect ++ ;
                            }
                            $partscount ++;
                        }
                        if (($numcorrect) && ($numcorrect == $partscount)) {
                            $status{$user}{$resource} = 1;
                        }
                    } elsif ($record{'resource.0.solved'} =~ /^correct/) {
                        $status{$user}{$resource} = 1;
                    }
                } elsif ($record{'resource.0.solved'} =~ /^correct/) {
                    $status{$user}{$resource} = 1;
                }
                my $count = 0;
                foreach my $cstore (@cstores) {
                   $count ++;
                   if (@posts) {
                      my $gotpost = 0; 
                      foreach my $post (@posts) {
                           my $diff = $cstore-$post;
                           if ($diff >= 0) {
                               push(@{$times{$resource}{$user}},$diff);
                               $gotpost = 1;
                           } else {
                               my $showpost = &sqltime($post);
                               my $showcstore = &sqltime($cstore);
#                            print "$user $resource $diff FROM $showpost AND $showcstore\n";
                           }
                        }
                        unless ($gotpost) {
                            if ($lastcstore) {
                                my $diff = $cstore - $lastcstore;
                                if ($diff > 0) {
                                    push(@{$times{$resource}{$user}},$diff);
                                }
                            } elsif ($lastpost) {
                                my $diff = $cstore - $lastpost;
                                if ($diff > 0) {
                                    push(@{$times{$resource}{$user}},$diff);
                                }
                            }
                        }
                    } else {
                        if ($lastcstore) {
                            my $diff = $cstore - $lastcstore;
                            if ($diff > 0) { 
                                push(@{$times{$resource}{$user}},$diff);
                            }
                        } elsif ($lastpost) {
                            my $diff = $cstore - $lastpost;
                            if ($diff > 0) {
                                push(@{$times{$resource}{$user}},$diff);
                            }
                        }
                    }
                    $lastpost = $posts[-1];
                }
                $lastcstore = $cstores[-1];
            } else {
                if (!@posts) {
                    $unviewed{$user}{$resource} = 1;
                } else {
                    $unsubmitted{$user}{$resource} = 1;
                }
            }
        }
    }

    my $num = 0;
    foreach my $user (keys(%post)) {
        $num ++;
        print $namesfh $num.','.$user."\n";
        print $fh $num.',';
        print $statusfh $num.',';
        foreach my $res (sort { $a <=> $b } (keys(%ordered))) {
            my $resource = $ordered{$res};
            if (ref($times{$resource}) eq 'HASH') {
                if (ref($times{$resource}{$user}) eq 'ARRAY') {
                    print $fh $times{$resource}{$user}[-1];
#                print $fh join(':',@{$times{$resource}{$user}});
                }
            }
            print $fh ',';
            if (ref($status{$user}) eq 'HASH') {
                print $statusfh $status{$user}{$resource};
            }
            print $statusfh ',';
        }
        print $fh "\n";
        print $statusfh "\n";
    }
    close($fh);
    close($statusfh);
    close($namesfh);
}

sub sqltime {
    my ($timestamp) = @_; 
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
        localtime($timestamp);
    $mon++; $year+=1900;
    return "$year-$mon-$mday $hour:$min:$sec";
}

sub unsqltime {
    my $timestamp=shift;
    if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
        $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
                             'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
    }
    return $timestamp;
}

sub maketime {
    my %th=@_;
    return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
                          $th{'day'},$th{'month'}-1,
                          $th{'year'}-1900,0,0,$th{'dlsav'}));
}

sub propath {
    my ($cnum)=@_;
    my $subdir=$cnum.'__';
    $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
    my $proname="$subdir/$cnum";
    return $proname;
}

sub walk_course {
    my ($user,$cid,$home,$folder,$role,$sec,$parts) = @_;
    my ($uname,$udom) = split(':',$user);
    my $cookie =
        &Apache::loncommon::init_user_environment(undef, $uname, $udom,
                                                  $home, undef,
                                                  {'robot' => 'walkcourse',});
    my @symbs;
    if ($cookie) {
        if (keys(%env) > 0) {
            my ($cdom,$cnum) = split('_',$cid);
            my ($furl,$ferr) =
                &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
                return if ($ferr ne '');
                my $rolecode = $role.'./'.$cdom.'/'.$cnum;
                if ($sec ne '') {
                    $rolecode .= '/'.$sec; 
                }
                &Apache::lonnet::appenv(
                          {
                           'request.course.id'   => $cid,
                           'request.role'        => $rolecode,
                           'request.role.domain' => $cdom,
                          });
                if ($sec ne '') {
                    &Apache::lonnet::appenv(
                                 {'request.course.sec' => $sec,
                                  'user.priv.'.$rolecode.'./'.$cdom.'/'.$cnum.'/'.$sec => ':bre&RXL',
                                 },[$role]);
                } else {
                    &Apache::lonnet::appenv(
                                 {'user.priv.'.$rolecode.'./'.$cdom.'/'.$cnum => ':bre&RXL',
                                 },[$role]);
                }
                my $navmap = Apache::lonnavmaps::navmap->new();
                if (ref($navmap)) {
                    my $mapurl = '/uploaded/'.$cdom.'/'.$cnum.'/'.$folder;
                    my $map = $navmap->getResourceByUrl($mapurl);
                    my $firstResource = $map->map_start();
                    my $finishResource = $map->map_finish();
                    if (ref($firstResource) && ref($finishResource)) {
                        my $it = $navmap->getIterator($firstResource, $finishResource,undef,1);
                        my $curRes;
                        while ($curRes = $it->next()) {
                            if (ref($curRes)) {
                                unless ($curRes->is_sequence() || $curRes->is_page()) {
                                my $symb = $curRes->symb();
                                if (ref($parts) eq 'HASH') {
                                    $parts->{$symb} = $curRes->parts();
                                }
                                unless ($curRes->randomout()) {
                                    if ($symb) {
                                        push(@symbs,$symb);
                                    }
                                }
                            }
                        }
                    }
                    undef($navmap);
                } else {
                    print "No navmap object\n";
                }
            }
        }
    }
    undef(%env);
    return @symbs;
}


--gci1272122265--