Return to refresh_courseids_db.pl CVS log

Up to [LON-CAPA] / loncom / misc

- &build_release_hashes() moved from misc/refresh_courseids_db.pl to
  interface/loncommn.pm to facilitate re-use.

    1: #!/usr/bin/perl
    2: # The LearningOnline Network
    3: #
    4: # $Id: refresh_courseids_db.pl,v 1.10 2010/12/24 07:58:09 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: #################################################
   29: 
   30: =pod
   31: 
   32: =head1 NAME
   33: 
   34: refresh_courseids_db.pl
   35: 
   36: =head1 SYNOPSIS
   37: 
   38: refresh_courseids_db.pl is run on a library server and gathers 
   39: course information for each course for which the current server is
   40: the home server.  Entries (excluding last access time) for each course 
   41: in nohist_courseids.db are updated.   
   42: 
   43: =head1 DESCRIPTION
   44: 
   45: refresh_courseids_db.pl will update course information, apart 
   46: from last access time, in nohist_courseids.db, using course data   
   47: from each course's environment.db file.
   48: 
   49: =cut
   50: 
   51: #################################################
   52: 
   53: use strict;
   54: use lib '/home/httpd/lib/perl/';
   55: use Apache::lonnet;
   56: use Apache::loncommon;
   57: use Apache::lonuserstate;
   58: use Apache::loncoursedata;
   59: use Apache::lonnavmaps;
   60: use LONCAPA qw(:DEFAULT :match);
   61: 
   62: exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
   63: 
   64: use vars qw( %checkparms %checkresponsetypes %checkcrstypes %anonsurvey %randomizetry );
   65: 
   66: #  Make sure this process is running from user=www
   67: my $wwwid=getpwnam('www');
   68: if ($wwwid!=$<) {
   69:     my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}";
   70:     my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
   71:     system("echo 'User ID mismatch. refresh_courseids_db.pl must be run as user www.' |\
   72:  mail -s '$subj' $emailto > /dev/null");
   73:     exit 1;
   74: }
   75: #
   76: # Let people know we are running
   77: open(my $fh,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/refreshcourseids_db.log');
   78: print $fh "==== refresh_courseids_db.pl Run ".localtime()."====\n";
   79: 
   80: my @domains = sort(&Apache::lonnet::current_machine_domains());
   81: my @ids=&Apache::lonnet::current_machine_ids();
   82: 
   83: &Apache::loncommon::build_release_hashes(\%checkparms,\%checkresponsetypes,
   84:                                          \%checkcrstypes,\%anonsurvey,\%randomizetry);
   85: $env{'allowed.bre'} = 'F';
   86: 
   87: foreach my $dom (@domains) {
   88:     my %courseshash;
   89:     my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.');
   90:     my %lastaccess = &Apache::lonnet::courselastaccess($dom,undef,\@ids);
   91:     my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
   92:     my %domdesign = &Apache::loncommon::get_domainconf($dom);
   93:     my $autoassign = $domdesign{$dom.'.autoassign.co-owners'};
   94:     &recurse_courses($dom,$dir,0,\%courseshash,\%currhash,\%lastaccess,$autoassign,$fh);
   95:     foreach my $lonhost (keys(%courseshash)) {
   96:         if (ref($courseshash{$lonhost}) eq 'HASH') {
   97:             if (&Apache::lonnet::courseidput($dom,$courseshash{$lonhost},$lonhost,'notime') eq 'ok') {
   98:                 print $fh "nohist_courseids.db updated successfully for domain $dom on lonHostID $lonhost\n";
   99:             } else {
  100:                 print $fh "Error occurred when updating nohist_courseids.db for domain $dom on lonHostID $lonhost\n";
  101:             }
  102:         }
  103:     }
  104: }
  105: 
  106: delete($env{'allowed.bre'});
  107: 
  108: ## Finished!
  109: print $fh "==== refresh_courseids.db completed ".localtime()." ====\n";
  110: close($fh);
  111: 
  112: sub recurse_courses {
  113:     my ($cdom,$dir,$depth,$courseshash,$currhash,$lastaccess,$autoassign,$fh) = @_;
  114:     next unless (ref($currhash) eq 'HASH');
  115:     if (-d $dir) {
  116:         opendir(DIR,$dir);
  117:         my @contents = grep(!/^\./,readdir(DIR));
  118:         closedir(DIR);
  119:         $depth ++;
  120:         foreach my $item (@contents) {
  121:             if ($depth < 4) {
  122:                 &recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash,
  123:                                  $currhash,$lastaccess,$autoassign,$fh);
  124:             } elsif ($item =~ /^$match_courseid$/) {
  125:                 my $cnum = $item;
  126:                 my $cid = $cdom.'_'.$cnum;
  127:                 unless (ref($currhash->{$cid}) eq 'HASH') {
  128:                     my $is_course = 0;
  129:                     if (-e "$dir/$cnum/passwd") {
  130:                         if (open(my $pwfh,"<$dir/$cnum/passwd")) {
  131:                             while (<$pwfh>) {
  132:                                 if (/^none:/) {
  133:                                     $is_course = 1;
  134:                                     last;
  135:                                 }
  136:                             } 
  137:                         }
  138:                     }
  139:                     next unless ($is_course);
  140:                     my @stats = stat("$dir/$cnum/passwd");
  141:                     print $fh "Course missing from nohist_courseids.db: $cid, created:".localtime($stats[9])."\n";
  142:                 }
  143:                 my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
  144:                 my %changes = ();
  145:                 my $crstype = $courseinfo{'type'};
  146:                 if ($crstype eq '') {
  147:                     if ($cnum =~ /^$match_community$/) {
  148:                         $crstype = 'Community';
  149:                     } else {
  150:                         $crstype = 'Course';
  151:                     }
  152:                     $changes{'type'} = $crstype;
  153:                 }
  154:                 my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
  155:                 my $owner = $courseinfo{'internal.courseowner'};
  156:                 my $twodaysago = time - 172800;
  157:                 my (%roleshash,$gotcc,$reqdmajor,$reqdminor);
  158:                 if ($owner eq '') {
  159:                     %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
  160:                     $gotcc = 1;
  161:                     if (keys(%roleshash) == 1) {
  162:                         foreach my $key (keys(%roleshash)) {
  163:                             if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
  164:                                 $owner = $1;
  165:                                 $changes{'internal.courseowner'} = $owner;
  166:                             }
  167:                         }
  168:                     }
  169:                 } elsif ($owner !~ /:/) {
  170:                     if ($owner =~ /^$match_username$/) {
  171:                         my $ownerhome=&Apache::lonnet::homeserver($owner,$cdom);
  172:                         unless (($ownerhome eq '') || ($ownerhome eq 'no_host')) {
  173:                             $owner .= ':'.$cdom;
  174:                             $changes{'internal.courseowner'} = $owner;
  175:                         }
  176:                     }
  177:                 }
  178:                 my $created = $courseinfo{'internal.created'};
  179:                 my $creator = $courseinfo{'internal.creator'};
  180:                 my $creationcontext = $courseinfo{'internal.creationcontext'};
  181:                 my $inst_code = $courseinfo{'internal.coursecode'};
  182:                 my $releaserequired = $courseinfo{'internal.releaserequired'};
  183:                 $inst_code = '' if (!defined($inst_code));
  184:                 $owner = '' if (!defined($owner));
  185:                 if ($created eq '') {
  186:                     if (ref($currhash->{$cid}) eq 'HASH') {
  187:                         $created = $currhash->{$cid}{'created'};
  188:                         $creator = $currhash->{$cid}{'creator'};
  189:                         $creationcontext = $currhash->{$cid}{'context'};
  190:                         unless ($created eq '') {
  191:                             $changes{'internal.created'} = $created;
  192:                         }
  193:                         if ($creator =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/) {
  194:                              $changes{'internal.creator'} = $creator;
  195:                         }
  196:                         unless ($creationcontext eq '') {
  197:                             $changes{'internal.creationcontext'} = $creationcontext;
  198:                         }
  199:                     }
  200:                     if ($created eq '') {
  201:                         if (-e "$dir/$cnum/passwd") {
  202:                             my @stats = stat("$dir/$cnum/passwd");
  203:                             $created = $stats[9];
  204:                         }
  205:                         if ($lastaccess->{$cid}) {
  206:                             if ($created eq '') {
  207:                                 $created = $lastaccess->{$cid};
  208:                             } elsif ($lastaccess->{$cid} < $created) {
  209:                                 $created = $lastaccess->{$cid};
  210:                             }
  211:                         }
  212:                         unless ($created eq '') {
  213:                             $changes{'internal.created'} = $created;
  214:                         }
  215:                     }
  216:                 }
  217:                  
  218:                 if (($chome ne '')  && ($lastaccess->{$cid} > $twodaysago)) {
  219:                     $env{'request.course.id'} = $cdom.'_'.$cnum;
  220:                     $env{'request.role'} = 'cc./'.$cdom.'/'.$cnum;
  221:                     &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
  222: 
  223:                     # check all parameters
  224:                     ($reqdmajor,$reqdminor) = &parameter_constraints($cnum,$cdom);
  225: 
  226:                     # check course type
  227:                     ($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype,
  228:                                                                       $reqdmajor,
  229:                                                                       $reqdminor);
  230:                     # check course contents
  231:                     ($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom,
  232:                                                                          $reqdmajor,
  233:                                                                          $reqdminor);
  234:                     delete($env{'request.course.id'});
  235:                     delete($env{'request.role'});
  236:                 } elsif ($releaserequired) {
  237:                     ($reqdmajor,$reqdminor) = split(/\./,$releaserequired);
  238:                 }
  239: 
  240:                 unless ($chome eq 'no_host') {
  241:                     $courseshash->{$chome}{$cid} = {
  242:                         description => $courseinfo{'description'},
  243:                         inst_code   => $inst_code,
  244:                         owner       => $owner,
  245:                         type        => $crstype,
  246:                     };
  247:                     if ($creator ne '') {
  248:                         $courseshash->{$chome}{$cid}{'creator'} = $creator;
  249:                     }
  250:                     if ($created ne '') {
  251:                         $courseshash->{$chome}{$cid}{'created'} = $created;
  252:                     }
  253:                     if ($creationcontext ne '') {
  254:                         $courseshash->{$chome}{$cid}{'context'} = $creationcontext;
  255:                     }
  256:                     if (($inst_code ne '') && ($autoassign)) {
  257:                         unless ($gotcc) {
  258:                             %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
  259:                         }
  260:                         my @currcoowners;
  261:                         my @newcoowners;
  262:                         if ($courseinfo{'internal.co-owners'} ne '') {
  263:                             @currcoowners = split(',',$courseinfo{'internal.co-owners'});
  264:                         }
  265:                         foreach my $key (keys(%roleshash)) {
  266:                             if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
  267:                                 my $cc = $1;
  268:                                 unless ($cc eq $owner) {
  269:                                     my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc);
  270:                                     if ($result eq 'valid') {
  271:                                         if (@newcoowners > 0) {
  272:                                             unless (grep(/^\Q$cc\E$/,@newcoowners)) { 
  273:                                                 push(@newcoowners,$cc);
  274:                                             }
  275:                                         } else {
  276:                                             push(@newcoowners,$cc);
  277:                                         }
  278:                                     }
  279:                                 }
  280:                             }
  281:                         }
  282:                         my @diffs = &Apache::loncommon::compare_arrays(\@currcoowners,\@newcoowners);
  283:                         if (@diffs > 0) {
  284:                             if (@newcoowners > 0) {
  285:                                 $changes{'internal.co-owners'} = join(',',@newcoowners);
  286:                                 $courseshash->{$chome}{$cid}{'co-owners'} = $changes{'internal.co-owners'};
  287:                             } else {
  288:                                 if ($courseinfo{'internal.co-owners'} ne '') {
  289:                                     if (&Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum) eq 'ok') {
  290:                                         print $fh "Former co-owner(s): $courseinfo{'internal.co-owners'} for official course: $inst_code (".$cdom."_".$cnum.") no longer active CCs, co-ownership status deleted.\n";
  291:                                     }
  292:                                 } else {
  293:                                     print $fh "Error occurred when updating co-ownership in course's environment.db for ".$cdom."_".$cnum."\n";
  294:                                 }
  295:                             }
  296:                         } elsif (@currcoowners > 0) {
  297:                             $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
  298:                         }
  299:                     } elsif ($courseinfo{'internal.co-owners'} ne '') {
  300:                         $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
  301:                     }
  302:                     foreach my $item ('categories','cloners','hidefromcat') {
  303:                         if ($courseinfo{$item} ne '') {
  304:                             $courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; 
  305:                         }
  306:                     }
  307:                     foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date') {
  308:                         if ($courseinfo{'internal.'.$item} ne '') {
  309:                             $courseshash->{$chome}{$cid}{$item} =
  310:                                 $courseinfo{'internal.'.$item};
  311:                         }
  312:                     }
  313:                     if ($reqdmajor eq '' && $reqdminor eq '') {
  314:                         if ($courseinfo{'internal.releaserequired'} ne '') {
  315:                             $changes{'internal.releaserequired'} = '';
  316:                         }
  317:                     } else {
  318:                         my $releasereq =  $reqdmajor.'.'.$reqdminor;
  319:                         $courseshash->{$chome}{$cid}{'releaserequired'} = $releasereq;
  320:                         if ($courseinfo{'internal.releaserequired'} eq '') {
  321:                             $changes{'internal.releaserequired'} = $releasereq;
  322:                         } else {
  323:                             if ($courseinfo{'internal.releaserequired'} ne $releasereq) {
  324:                         
  325:                                 $changes{'internal.releaserequired'} = $releasereq;
  326:                             }
  327:                         }
  328:                     }
  329:                     if (keys(%changes)) {
  330:                         if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') {
  331:                             print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: ";
  332:                             foreach my $key (sort(keys(%changes))) {
  333:                                 print $fh "$key => $changes{$key} ";
  334:                             }
  335:                             print $fh "\n";
  336:                         } else {
  337:                             print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n";
  338:                         }
  339:                     }
  340:                 }
  341:             }
  342:         }
  343:     }
  344:     return;
  345: }
  346: 
  347: sub parameter_constraints {
  348:     my ($cnum,$cdom) = @_;
  349:     my ($reqdmajor,$reqdminor);
  350:     my $resourcedata=&read_paramdata($cnum,$cdom);
  351:     if (ref($resourcedata) eq 'HASH') {
  352:         foreach my $key (keys(%{$resourcedata})) { 
  353:             foreach my $item (keys(%checkparms)) {
  354:                 if ($key =~ /(\Q$item\E)$/) {
  355:                     if (ref($checkparms{$item}) eq 'ARRAY') {
  356:                         my $value = $resourcedata->{$key};
  357:                         if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) {
  358:                             my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value});
  359:                             ($reqdmajor,$reqdminor) = 
  360:                                 &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  361:                         }
  362:                     }
  363:                 }
  364:             }
  365:         }
  366:     }
  367:     return ($reqdmajor,$reqdminor);
  368: }
  369: 
  370: sub coursetype_constraints {
  371:     my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_;
  372:     if (defined($checkcrstypes{$crstype})) {
  373:         my ($major,$minor) = split(/\./,$checkcrstypes{$crstype});
  374:         ($reqdmajor,$reqdminor) = 
  375:             &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  376:     }
  377:     return ($reqdmajor,$reqdminor);
  378: }
  379: 
  380: sub coursecontent_constraints {
  381:     my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
  382:     my $navmap = Apache::lonnavmaps::navmap->new();
  383:     if (defined($navmap)) {
  384:         my %anonsubmissions =  &Apache::lonnet::dump('nohist_anonsurveys',
  385:                                                      $cdom,$cnum);
  386:         my %randomizetrysubm = &Apache::lonnet::dump('nohist_randomizetry',
  387:                                                      $cdom,$cnum);
  388:         my %allresponses;
  389:         my ($anonsurv_subm,$randbytry_subm);
  390:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
  391:             my %responses = $res->responseTypes();
  392:             foreach my $key (keys(%responses)) {
  393:                 next unless(exists($checkresponsetypes{$key}));
  394:                 $allresponses{$key} += $responses{$key};
  395:             }
  396:             my @parts = @{$res->parts()};
  397:             my $symb = $res->symb();
  398:             foreach my $part (@parts) {
  399:                 if (exists($anonsubmissions{$symb."\0".$part})) {
  400:                     $anonsurv_subm = 1;
  401:                 }
  402:                 if (exists($randomizetrysubm{$symb."\0".$part})) {
  403:                     $randbytry_subm = 1;
  404:                 }
  405:             }
  406:         }
  407:         foreach my $key (keys(%allresponses)) {
  408:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
  409:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  410:         }
  411:         if ($anonsurv_subm) {
  412:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($anonsurvey{major},
  413:                                           $anonsurvey{minor},$reqdmajor,$reqdminor);
  414:         }
  415:         if ($randbytry_subm) {
  416:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($randomizetry{major},
  417:                                           $randomizetry{minor},$reqdmajor,$reqdminor);
  418:         }
  419:     }
  420:     return ($reqdmajor,$reqdminor);
  421: }
  422: 
  423: sub update_reqd_loncaparev {
  424:     my ($major,$minor,$reqdmajor,$reqdminor) = @_;
  425:     if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) {
  426:         if ($reqdmajor eq '' || $reqdminor eq '') {
  427:             $reqdmajor = $major;
  428:             $reqdminor = $minor;
  429:         } elsif (($major > $reqdmajor) ||
  430:             ($major == $reqdmajor && $minor > $reqdminor))  {
  431:             $reqdmajor = $major;
  432:             $reqdminor = $minor;
  433:         }
  434:     }
  435:     return ($reqdmajor,$reqdminor);
  436: }
  437: 
  438: sub read_paramdata {
  439:     my ($cnum,$dom)=@_;
  440:     my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$dom);
  441:     my $classlist=&Apache::loncoursedata::get_classlist();
  442:     foreach my $student (keys(%{$classlist})) {
  443:         if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
  444:             my ($tuname,$tudom)=($1,$2);
  445:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
  446:             foreach my $userkey (keys(%{$useropt})) {
  447:                 if ($userkey=~/^$env{'request.course.id'}/) {
  448:                     my $newkey=$userkey;
  449:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
  450:                     $$resourcedata{$newkey}=$$useropt{$userkey};
  451:                 }
  452:             }
  453:          }
  454:     }
  455:     return $resourcedata;
  456: }
  457: