Annotation of modules/gci/timeontask.pl, revision 1.1
1.1 ! gci 1: #!/usr/bin/perl
! 2:
! 3: #
! 4: # Stuart Raeburn, 04/23/2010
! 5: #
! 6:
! 7: use strict;
! 8: use DBI;
! 9: use URI::Escape;
! 10: use POSIX qw(strftime mktime);
! 11: use lib '/home/httpd/lib/perl';
! 12: use LONCAPA;
! 13: use Apache::loncommon();
! 14: use Apache::lonnet;
! 15: use Apache::lonuserstate();
! 16: use Apache::lonnavmaps();
! 17: use Apache::loncoursedata();
! 18:
! 19: my $dbh;
! 20: unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",'localhostkey',
! 21: { RaiseError =>0,PrintError=>0})) {
! 22: print "Cannot connect to database!\n";
! 23: exit;
! 24: }
! 25:
! 26: my @courses;
! 27: if (!@ARGV) {
! 28: print "Usage: timeontask.pl <coursenum1> <coursenum2> ... \n".
! 29: "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";
! 30: } else {
! 31: @courses = @ARGV;
! 32: }
! 33:
! 34: my $cdom = 'gcitest';
! 35: my $folder = 'default_1261144274.sequence';
! 36: my $role = 'st';
! 37: my $secidx = &Apache::loncoursedata::CL_SECTION();
! 38:
! 39: foreach my $cnum (@courses) {
! 40: my $cid = $cdom.'_'.$cnum;
! 41: my $act_table = $cnum.'_'.$cdom.'_activity';
! 42: my $res_table = $cnum.'_'.$cdom.'_resource';
! 43: my $user_table = $cnum.'_'.$cdom.'_students';
! 44: my %coursepersonnel = &Apache::lonnet::get_course_adv_roles($cid,1);
! 45: my %allstaff;
! 46: foreach my $role (keys(%coursepersonnel)) {
! 47: my @staff = split(',',$coursepersonnel{$role});
! 48: foreach my $person (@staff) {
! 49: $allstaff{$person} = 1;
! 50: }
! 51: }
! 52: my ($fh,$statusfh,$namesfh);
! 53: unless(open $fh,'>/root/timeontask_'.$cnum.'.csv') {
! 54: print "Could not open /root/timeontask_'.$cnum.'.csv for writing\n";
! 55: next;
! 56: }
! 57: unless(open $statusfh,'>/root/status_'.$cnum.'.csv') {
! 58: print "Could not open /root/status_'.$cnum.'.csv for writing\n";
! 59: next;
! 60: }
! 61: unless(open $namesfh,'>/root/names_'.$cnum.'.csv') {
! 62: print "Could not open /root/names_'.$cnum.'.csv for writing\n";
! 63: next;
! 64: }
! 65: my %position;
! 66: my $subdir = &propath($cnum);
! 67: unless (open my $seqfh,"</home/httpd/lonUsers/$cdom/$subdir/userfiles/$folder") {
! 68: while (<$seqfh>) {
! 69: chomp();
! 70: if (m{^<resource id=\"\d+\" src=\"/res/([^"]+)\" type=\"start\" title=\"Problem (\d+)\" />$}) {
! 71: $position{$1} = $2;
! 72: }
! 73: }
! 74: }
! 75: my %users;
! 76: my (%post,%cstore,%ordered,%unsubmitted,%unviewed,%times,%hists,%status,%parts);
! 77:
! 78: my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
! 79:
! 80: my $sth=$dbh->prepare("SELECT student,student_id FROM $user_table");
! 81: $sth->execute();
! 82: while ( my($user,$pid) = $sth->fetchrow_array ) {
! 83: 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') {
! 84: next if ($allstaff{$user});
! 85: $users{$pid} = $user;
! 86: }
! 87: }
! 88: $sth->finish;
! 89: if (keys(%users) == 0) {
! 90: 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";
! 91: next;
! 92: }
! 93:
! 94: $sth = $dbh->prepare("SELECT resource FROM $res_table WHERE resource LIKE 'uploaded/$cdom/$cnum/$folder%'");
! 95: $sth->execute();
! 96: while (my $resource = $sth->fetchrow_array ) {
! 97: if ($resource =~ /sequence___(\d+)___/) {
! 98: $ordered{$1} = $resource;
! 99: }
! 100: }
! 101:
! 102: print $fh ',';
! 103: print $statusfh ',';
! 104: foreach my $res (sort { $a <=> $b } (keys(%ordered))) {
! 105: my $resource = $ordered{$res};
! 106: my ($name) = ($resource =~ m{([^/]+)\.problem$});
! 107: print $fh $name.',';
! 108: print $statusfh $name.',';
! 109: }
! 110: print $fh "\n";
! 111: print $statusfh "\n";
! 112:
! 113: foreach my $pid (sort(keys(%users))) {
! 114: 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";
! 115: $sth = $dbh->prepare($query);
! 116: $sth->execute();
! 117: while ( my($resource,$time) = $sth->fetchrow_array ) {
! 118: my $timestamp = &unsqltime($time);
! 119: push(@{$post{$users{$pid}}{$resource}},$timestamp);
! 120: }
! 121: $sth->finish;
! 122: $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";
! 123: $sth = $dbh->prepare($query);
! 124: $sth->execute();
! 125: while ( my($resource,$time,$action) = $sth->fetchrow_array ) {
! 126: next if ($action =~ /regrader=emgward/);
! 127: $resource = &URI::Escape::uri_unescape($resource);
! 128: my $timestamp = &unsqltime($time);
! 129: push(@{$cstore{$users{$pid}}{$resource}},$timestamp);
! 130: }
! 131: $sth->finish;
! 132: }
! 133:
! 134: foreach my $user (sort(keys(%post))) {
! 135: $status{$user} = {};
! 136: $parts{$user} = {};
! 137: my ($uname,$udom) = split(':',$user);
! 138: my $home = &Apache::lonnet::homeserver($uname,$udom);
! 139: my $sec;
! 140: if (ref($classlist) eq 'HASH') {
! 141: if (ref($classlist->{$user}) eq 'ARRAY') {
! 142: $sec=$classlist->{$user}->[$secidx];
! 143: }
! 144: }
! 145: my @symbs = &walk_course($user,$cid,$home,$folder,$role,$sec,$parts{$user});
! 146: my ($lastcstore,$lastpost);
! 147: foreach my $resource (@symbs) {
! 148: my (@posts,@cstores);
! 149: if (ref($post{$user}{$resource}) eq 'ARRAY') {
! 150: @posts = @{$post{$user}{$resource}};
! 151: }
! 152: if (ref($cstore{$user}{$resource}) eq 'ARRAY') {
! 153: @cstores = @{$cstore{$user}{$resource}};
! 154: }
! 155: if (!@cstores) {
! 156: unless (ref($hists{$user}) eq 'HASH') {
! 157: my ($uname,$udom) = split(':',$user);
! 158: my $subdir = &propath($uname);
! 159: if (open(my $histfh,"</home/httpd/lonUsers/$udom/$subdir/".$cdom.'_'.$cnum.'.hist')) {
! 160: while(<$histfh>) {
! 161: chomp();
! 162: my ($action,$stamp,$res,$submission) = split(/:/);
! 163: if (($action eq 'S') && ($submission =~ /tries=1/)) {
! 164: $res = &URI::Escape::uri_unescape($res);
! 165: push(@{$hists{$user}{$res}},$stamp);
! 166: }
! 167: }
! 168: close($histfh);
! 169: }
! 170: }
! 171: if (ref($hists{$user}) eq 'HASH') {
! 172: if (ref($hists{$user}{$resource}) eq 'ARRAY') {
! 173: push(@{$times{$user}{$resource}},$hists{$user}{$resource});
! 174: @cstores = @{$hists{$user}{$resource}};
! 175: }
! 176: }
! 177: }
! 178: if (@cstores) {
! 179: my %record=&Apache::lonnet::restore($resource,$cid,$udom,$uname);
! 180: if (ref($parts{$user}) eq 'HASH') {
! 181: if (ref($parts{$user}{$resource}) eq 'ARRAY') {
! 182: my $numcorrect = 0;
! 183: my $partscount = 0;
! 184: foreach my $part (@{$parts{$user}{$resource}}) {
! 185: if ($record{'resource.'.$part.'.solved'} =~ /^correct/) {
! 186: $numcorrect ++ ;
! 187: }
! 188: $partscount ++;
! 189: }
! 190: if (($numcorrect) && ($numcorrect == $partscount)) {
! 191: $status{$user}{$resource} = 1;
! 192: }
! 193: } elsif ($record{'resource.0.solved'} =~ /^correct/) {
! 194: $status{$user}{$resource} = 1;
! 195: }
! 196: } elsif ($record{'resource.0.solved'} =~ /^correct/) {
! 197: $status{$user}{$resource} = 1;
! 198: }
! 199: my $count = 0;
! 200: foreach my $cstore (@cstores) {
! 201: $count ++;
! 202: if (@posts) {
! 203: my $gotpost = 0;
! 204: foreach my $post (@posts) {
! 205: my $diff = $cstore-$post;
! 206: if ($diff >= 0) {
! 207: push(@{$times{$resource}{$user}},$diff);
! 208: $gotpost = 1;
! 209: } else {
! 210: my $showpost = &sqltime($post);
! 211: my $showcstore = &sqltime($cstore);
! 212: # print "$user $resource $diff FROM $showpost AND $showcstore\n";
! 213: }
! 214: }
! 215: unless ($gotpost) {
! 216: if ($lastcstore) {
! 217: my $diff = $cstore - $lastcstore;
! 218: if ($diff > 0) {
! 219: push(@{$times{$resource}{$user}},$diff);
! 220: }
! 221: } elsif ($lastpost) {
! 222: my $diff = $cstore - $lastpost;
! 223: if ($diff > 0) {
! 224: push(@{$times{$resource}{$user}},$diff);
! 225: }
! 226: }
! 227: }
! 228: } else {
! 229: if ($lastcstore) {
! 230: my $diff = $cstore - $lastcstore;
! 231: if ($diff > 0) {
! 232: push(@{$times{$resource}{$user}},$diff);
! 233: }
! 234: } elsif ($lastpost) {
! 235: my $diff = $cstore - $lastpost;
! 236: if ($diff > 0) {
! 237: push(@{$times{$resource}{$user}},$diff);
! 238: }
! 239: }
! 240: }
! 241: $lastpost = $posts[-1];
! 242: }
! 243: $lastcstore = $cstores[-1];
! 244: } else {
! 245: if (!@posts) {
! 246: $unviewed{$user}{$resource} = 1;
! 247: } else {
! 248: $unsubmitted{$user}{$resource} = 1;
! 249: }
! 250: }
! 251: }
! 252: }
! 253:
! 254: my $num = 0;
! 255: foreach my $user (keys(%post)) {
! 256: $num ++;
! 257: print $namesfh $num.','.$user."\n";
! 258: print $fh $num.',';
! 259: print $statusfh $num.',';
! 260: foreach my $res (sort { $a <=> $b } (keys(%ordered))) {
! 261: my $resource = $ordered{$res};
! 262: if (ref($times{$resource}) eq 'HASH') {
! 263: if (ref($times{$resource}{$user}) eq 'ARRAY') {
! 264: print $fh $times{$resource}{$user}[-1];
! 265: # print $fh join(':',@{$times{$resource}{$user}});
! 266: }
! 267: }
! 268: print $fh ',';
! 269: if (ref($status{$user}) eq 'HASH') {
! 270: print $statusfh $status{$user}{$resource};
! 271: }
! 272: print $statusfh ',';
! 273: }
! 274: print $fh "\n";
! 275: print $statusfh "\n";
! 276: }
! 277: close($fh);
! 278: close($statusfh);
! 279: close($namesfh);
! 280: }
! 281:
! 282: sub sqltime {
! 283: my ($timestamp) = @_;
! 284: my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
! 285: localtime($timestamp);
! 286: $mon++; $year+=1900;
! 287: return "$year-$mon-$mday $hour:$min:$sec";
! 288: }
! 289:
! 290: sub unsqltime {
! 291: my $timestamp=shift;
! 292: if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
! 293: $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
! 294: 'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
! 295: }
! 296: return $timestamp;
! 297: }
! 298:
! 299: sub maketime {
! 300: my %th=@_;
! 301: return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
! 302: $th{'day'},$th{'month'}-1,
! 303: $th{'year'}-1900,0,0,$th{'dlsav'}));
! 304: }
! 305:
! 306: sub propath {
! 307: my ($cnum)=@_;
! 308: my $subdir=$cnum.'__';
! 309: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
! 310: my $proname="$subdir/$cnum";
! 311: return $proname;
! 312: }
! 313:
! 314: sub walk_course {
! 315: my ($user,$cid,$home,$folder,$role,$sec,$parts) = @_;
! 316: my ($uname,$udom) = split(':',$user);
! 317: my $cookie =
! 318: &Apache::loncommon::init_user_environment(undef, $uname, $udom,
! 319: $home, undef,
! 320: {'robot' => 'walkcourse',});
! 321: my @symbs;
! 322: if ($cookie) {
! 323: if (keys(%env) > 0) {
! 324: my ($cdom,$cnum) = split('_',$cid);
! 325: my ($furl,$ferr) =
! 326: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
! 327: return if ($ferr ne '');
! 328: my $rolecode = $role.'./'.$cdom.'/'.$cnum;
! 329: if ($sec ne '') {
! 330: $rolecode .= '/'.$sec;
! 331: }
! 332: &Apache::lonnet::appenv(
! 333: {
! 334: 'request.course.id' => $cid,
! 335: 'request.role' => $rolecode,
! 336: 'request.role.domain' => $cdom,
! 337: });
! 338: if ($sec ne '') {
! 339: &Apache::lonnet::appenv(
! 340: {'request.course.sec' => $sec,
! 341: 'user.priv.'.$rolecode.'./'.$cdom.'/'.$cnum.'/'.$sec => ':bre&RXL',
! 342: },[$role]);
! 343: } else {
! 344: &Apache::lonnet::appenv(
! 345: {'user.priv.'.$rolecode.'./'.$cdom.'/'.$cnum => ':bre&RXL',
! 346: },[$role]);
! 347: }
! 348: my $navmap = Apache::lonnavmaps::navmap->new();
! 349: if (ref($navmap)) {
! 350: my $mapurl = '/uploaded/'.$cdom.'/'.$cnum.'/'.$folder;
! 351: my $map = $navmap->getResourceByUrl($mapurl);
! 352: my $firstResource = $map->map_start();
! 353: my $finishResource = $map->map_finish();
! 354: if (ref($firstResource) && ref($finishResource)) {
! 355: my $it = $navmap->getIterator($firstResource, $finishResource,undef,1);
! 356: my $curRes;
! 357: while ($curRes = $it->next()) {
! 358: if (ref($curRes)) {
! 359: unless ($curRes->is_sequence() || $curRes->is_page()) {
! 360: my $symb = $curRes->symb();
! 361: if (ref($parts) eq 'HASH') {
! 362: $parts->{$symb} = $curRes->parts();
! 363: }
! 364: unless ($curRes->randomout()) {
! 365: if ($symb) {
! 366: push(@symbs,$symb);
! 367: }
! 368: }
! 369: }
! 370: }
! 371: }
! 372: undef($navmap);
! 373: } else {
! 374: print "No navmap object\n";
! 375: }
! 376: }
! 377: }
! 378: }
! 379: undef(%env);
! 380: return @symbs;
! 381: }
! 382:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>