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>