Annotation of modules/gci/buildlastlogindb.pl, revision 1.1
1.1 ! gci 1: #! /usr/bin/perl
! 2:
! 3: #
! 4: # Stuart Raeburn, 08/11/2010
! 5: #
! 6:
! 7: use strict;
! 8: use lib '/home/httpd/lib/perl/';
! 9: use Apache::lonnet;
! 10: use Apache::loncommon;
! 11: use Apache::lonuserstate;
! 12: use Apache::loncoursedata;
! 13: use Apache::lonnavmaps;
! 14: use LONCAPA qw(:DEFAULT :match);
! 15:
! 16: exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
! 17:
! 18:
! 19: # Make sure this process is running from user=www
! 20: my $wwwid=getpwnam('www');
! 21: if ($wwwid!=$<) {
! 22: my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}";
! 23: my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
! 24: system("echo 'User ID mismatch. refresh_courseids_db.pl must be run as user www.' |\
! 25: mail -s '$subj' $emailto > /dev/null");
! 26: exit 1;
! 27: }
! 28: #
! 29: # Let people know we are running
! 30: open(my $fh,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/buildlastlogin.log');
! 31: print $fh "==== buildlastlogindb.pl Run ".localtime()."====\n";
! 32:
! 33: my @domains = sort(&Apache::lonnet::current_machine_domains());
! 34:
! 35: my (%users,%gotdbs);
! 36: $env{'allowed.bre'} = 'F';
! 37:
! 38: foreach my $dom (@domains) {
! 39: next unless ($dom eq 'gcitest');
! 40: my %courseshash;
! 41: my @ids=&Apache::lonnet::current_machine_ids();
! 42: my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.');
! 43: foreach my $cid (sort(keys(%currhash))) {
! 44: my ($cdom,$cnum) = split(/_/,$cid);
! 45: my $path =&propath($cdom,$cnum);
! 46: my %advrolehash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,
! 47: ['previous','active','future']);
! 48: $env{'request.course.id'} = $cid;
! 49: $env{'request.role'} = 'cc./'.$cdom.'/'.$cnum;
! 50: my ($furl,$ferr)=
! 51: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
! 52: my $navmap = Apache::lonnavmaps::navmap->new();
! 53: my (%symbs,%surveys,%stusubmissions);
! 54: if (defined($navmap)) {
! 55: foreach my $res ($navmap->retrieveResources('/uploaded/'.$cdom.'/'.$cnum.'/default_1261144274.sequence',sub { $_[0]->is_problem() },1,0)) {
! 56: my $symb = $res->symb();
! 57: $symbs{$symb} = $res->parts();
! 58: if ($res->is_survey()) {
! 59: $surveys{$symb} = 1;
! 60: }
! 61: }
! 62: }
! 63: foreach my $user (keys(%advrolehash)) {
! 64: my ($uname,$udom,$rest) = split(/:/,$user,3);
! 65: if (&check_for_gci_dc($uname,$udom)) {
! 66: next;
! 67: }
! 68: $users{$uname.':'.$udom} = 1;
! 69: }
! 70: my $classlist=&Apache::loncoursedata::get_classlist($cdom,$cnum);
! 71: if (ref($classlist) eq 'HASH') {
! 72: foreach my $student (keys(%{$classlist})) {
! 73: if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
! 74: my ($tuname,$tudom)=($1,$2);
! 75: if (&check_for_gci_dc($tuname,$tudom)) {
! 76: next;
! 77: }
! 78: $users{$student} = 1;
! 79: my %StudentsData;
! 80: my @tmp = &Apache::loncoursedata::get_current_state($tuname,$tudom,undef,$cid);
! 81: if ((scalar @tmp > 0) && ($tmp[0] !~ /^error:/)) {
! 82: %StudentsData = @tmp;
! 83: }
! 84: foreach my $symb (keys(%symbs)) {
! 85: my $resource_data = $StudentsData{$symb};
! 86: if (ref($symbs{$symb}) eq 'ARRAY') {
! 87: foreach my $partnum (@{$symbs{$symb}}) {
! 88: if (exists($resource_data->{'resource.'.$partnum.'.solved'})) {
! 89: if ($resource_data->{'resource.'.$partnum.'.solved'} =~ /^correct_/) {
! 90: $stusubmissions{$student."\0correct"} ++;
! 91: }
! 92: }
! 93: if (exists($resource_data->{'resource.'.$partnum.'.tries'})) {
! 94: if ($surveys{$symb}) {
! 95: $stusubmissions{$student."\0surveysubs"} += $resource_data->{'resource.'.$partnum.'.tries'};
! 96: } else {
! 97: $stusubmissions{$student."\0attempts"} += $resource_data->{'resource.'.$partnum.'.tries'};
! 98: }
! 99: }
! 100: }
! 101: }
! 102: }
! 103: }
! 104: }
! 105: }
! 106: undef($navmap);
! 107: if (keys(%stusubmissions) > 0) {
! 108: my $putresult = &Apache::lonnet::put('nohist_submissiontracker',\%stusubmissions,
! 109: $cdom,$cnum);
! 110: if ($putresult eq 'ok') {
! 111: print $fh "stored stusubmission data for $cdom".'_'."$cnum\n";
! 112: }
! 113: }
! 114: }
! 115: }
! 116:
! 117: delete($env{'allowed.bre'});
! 118: delete($env{'request.course.id'});
! 119: delete($env{'request.role'});
! 120:
! 121: my %lastlogin;
! 122: foreach my $user (sort(keys(%users))) {
! 123: my ($uname,$udom) = split(/:/,$user);
! 124: &readactivitylog($uname,$udom,\%lastlogin,\%gotdbs);
! 125: }
! 126:
! 127: foreach my $key (sort(keys(%lastlogin))) {
! 128: if (ref($lastlogin{$key}) eq 'HASH') {
! 129: if ($key =~ /^($match_domain)_($match_courseid)$/) {
! 130: my $cdom = $1;
! 131: my $cnum = $2;
! 132: my $putresult = &Apache::lonnet::put('nohist_crslastlogin',$lastlogin{$key},
! 133: $cdom,$cnum);
! 134: if ($putresult eq 'ok') {
! 135: print $fh "stored lastalogin data for $key\n";
! 136: }
! 137: }
! 138: }
! 139: }
! 140:
! 141: ## Finished!
! 142: print $fh "==== buildlastlogindb.pl completed ".localtime()." ====\n";
! 143: close($fh);
! 144: exit;
! 145:
! 146: sub readactivitylog {
! 147: my($uname,$udom,$lastlogin,$gotdbs) = @_;
! 148: my $path = &propath($udom,$uname);
! 149: if (-e "$path/activity.log") {
! 150: if (open(my $fh,"<$path/activity.log")) {
! 151: while (<$fh>) {
! 152: chomp();
! 153: if (m{^(\d+):\w+:Role\s+(cc|in|ta|ep|st|ad)\./(gcitest)/($match_courseid)/?([^/]*)}) {
! 154: next if ($gotdbs->{$3.'_'.$4});
! 155: $lastlogin->{$3.'_'.$4}{$uname.':'.$udom.':'.$5.':'.$2} = $1;
! 156: }
! 157: }
! 158: close($fh);
! 159: }
! 160: }
! 161: }
! 162:
! 163: sub check_for_gci_dc {
! 164: my ($uname,$udom) = @_;
! 165: my $now=time;
! 166: my $numdc = 0;
! 167: my %roles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',undef,['dc']);
! 168: foreach my $dom ('gci','gcitest') {
! 169: if ($roles{':'.$dom.':dc'}) {
! 170: $numdc++;
! 171: }
! 172: }
! 173: return $numdc;
! 174: }
! 175:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>