[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--