Annotation of loncom/misc/refresh_courseids_db.pl, revision 1.4

1.1       raeburn     1: #!/usr/bin/perl
                      2: # The LearningOnline Network
                      3: #
1.4     ! raeburn     4: # $Id: refresh_courseids_db.pl,v 1.3 2010/03/17 18:16:56 raeburn Exp $
1.1       raeburn     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;
1.4     ! raeburn    57: use Apache::lonuserstate;
        !            58: use Apache::loncoursedata;
        !            59: use Apache::lonnavmaps;
1.1       raeburn    60: use LONCAPA qw(:DEFAULT :match);
                     61: 
                     62: exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
                     63: 
1.4     ! raeburn    64: use vars qw( %needsrelease %checkparms %checkresponsetypes %checkcrstypes);
        !            65: 
1.1       raeburn    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());
1.4     ! raeburn    81: 
        !            82: &parse_releases_xml();
        !            83: $env{'allowed.bre'} = 'F';
        !            84: 
1.1       raeburn    85: foreach my $dom (@domains) {
                     86:     my %courseshash;
                     87:     my @ids=&Apache::lonnet::current_machine_ids();
                     88:     my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.');
                     89:     my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
1.2       raeburn    90:     my %domdesign = &Apache::loncommon::get_domainconf($dom);
                     91:     my $autoassign = $domdesign{$dom.'.autoassign.co-owners'};
                     92:     &recurse_courses($dom,$dir,0,\%courseshash,\%currhash,$autoassign,$fh);
1.1       raeburn    93:     foreach my $lonhost (keys(%courseshash)) {
                     94:         if (ref($courseshash{$lonhost}) eq 'HASH') {
                     95:             if (&Apache::lonnet::courseidput($dom,$courseshash{$lonhost},$lonhost,'notime') eq 'ok') {
                     96:                 print $fh "nohist_courseids.db updated successfully for domain $dom on lonHostID $lonhost\n";
                     97:             } else {
                     98:                 print $fh "Error occurred when updating nohist_courseids.db for domain $dom on lonHostID $lonhost\n";
                     99:             }
                    100:         }
                    101:     }
                    102: }
                    103: 
1.4     ! raeburn   104: delete($env{'allowed.bre'});
        !           105: 
1.1       raeburn   106: ## Finished!
                    107: print $fh "==== refresh_courseids.db completed ".localtime()." ====\n";
                    108: close($fh);
                    109: 
                    110: sub recurse_courses {
1.2       raeburn   111:     my ($cdom,$dir,$depth,$courseshash,$currhash,$autoassign,$fh) = @_;
1.1       raeburn   112:     next unless (ref($currhash) eq 'HASH');
                    113:     if (-d $dir) {
                    114:         opendir(DIR,$dir);
                    115:         my @contents = grep(!/^\./,readdir(DIR));
                    116:         closedir(DIR);
                    117:         $depth ++;
                    118:         foreach my $item (@contents) {
                    119:             if ($depth < 4) {
1.2       raeburn   120:                 &recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash,
                    121:                                  $currhash,$autoassign,$fh);
1.1       raeburn   122:             } elsif ($item =~ /^$match_courseid$/) {
                    123:                 my $cnum = $item;
                    124:                 my $cid = $cdom.'_'.$cnum;
                    125:                 unless (ref($currhash->{$cid}) eq 'HASH') {
                    126:                     my $is_course = 0;
                    127:                     if (-e "$dir/$cnum/passwd") {
                    128:                         if (open(my $pwfh,"<$dir/$cnum/passwd")) {
                    129:                             while (<$pwfh>) {
                    130:                                 if (/^none:/) {
                    131:                                     $is_course = 1;
                    132:                                     last;
                    133:                                 }
                    134:                             } 
                    135:                         }
                    136:                     }
                    137:                     next unless ($is_course);
                    138:                     my @stats = stat("$dir/$cnum/passwd");
                    139:                     print $fh "Course missing from nohist_courseids.db: $cid, created:".localtime($stats[9])."\n";
                    140:                 }
                    141:                 my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
                    142:                 my %changes = ();
                    143:                 my $crstype = $courseinfo{'type'};
                    144:                 if ($crstype eq '') {
                    145:                     if ($cnum =~ /^$match_community$/) {
                    146:                         $crstype = 'Community';
                    147:                     } else {
                    148:                         $crstype = 'Course';
                    149:                     }
                    150:                     $changes{'type'} = $crstype;
                    151:                 }
                    152:                 my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                    153:                 my $owner = $courseinfo{'internal.courseowner'};
1.4     ! raeburn   154:                 my (%roleshash,$gotcc,$reqdmajor,$reqdminor);
1.1       raeburn   155:                 if ($owner eq '') {
1.2       raeburn   156:                     %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                    157:                     $gotcc = 1;
1.1       raeburn   158:                     if (keys(%roleshash) == 1) {
                    159:                         foreach my $key (keys(%roleshash)) {
                    160:                             if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
                    161:                                 $owner = $1;
                    162:                                 $changes{'internal.courseowner'} = $owner;
                    163:                             }
                    164:                         }
                    165:                     }
                    166:                 } elsif ($owner !~ /:/) {
                    167:                     if ($owner =~ /^$match_username$/) {
                    168:                         my $ownerhome=&Apache::lonnet::homeserver($owner,$cdom);
                    169:                         unless (($ownerhome eq '') || ($ownerhome eq 'no_host')) {
                    170:                             $owner .= ':'.$cdom;
                    171:                             $changes{'internal.courseowner'} = $owner;
                    172:                         }
                    173:                     }
                    174:                 }
                    175:                 my $created = $courseinfo{'internal.created'};
                    176:                 my $creator = $courseinfo{'internal.creator'};
                    177:                 my $creationcontext = $courseinfo{'internal.creationcontext'};
                    178:                 my $inst_code = $courseinfo{'internal.coursecode'};
                    179:                 $inst_code = '' if (!defined($inst_code));
                    180:                 $owner = '' if (!defined($owner));
                    181:                 if ($created eq '') {
1.2       raeburn   182:                     if (ref($currhash->{$cid}) eq 'HASH') {
                    183:                         $created = $currhash->{$cid}{'created'};
                    184:                         $creator = $currhash->{$cid}{'creator'};
                    185:                         $creationcontext = $currhash->{$cid}{'context'};
1.1       raeburn   186:                         unless ($created eq '') {
                    187:                             $changes{'internal.created'} = $created;
                    188:                         }
                    189:                         if ($creator =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/) {
                    190:                              $changes{'internal.creator'} = $creator;
                    191:                         }
                    192:                         unless ($creationcontext eq '') {
                    193:                             $changes{'internal.creationcontext'} = $creationcontext;
                    194:                         }
                    195:                     }
                    196:                     if ($created eq '') {
                    197:                         if (-e "$dir/$cnum/passwd") {
                    198:                             my @stats = stat("$dir/$cnum/passwd");
                    199:                             $created = $stats[9];
                    200:                         }
                    201:                         my %lastaccess = 
                    202:                             &Apache::lonnet::courselastaccess($cdom,$cnum);
                    203:                         if ($lastaccess{$cid}) {
                    204:                             if ($created eq '') {
                    205:                                 $created = $lastaccess{$cid};
                    206:                             } elsif ($lastaccess{$cid} < $created) {
                    207:                                 $created = $lastaccess{$cid};
                    208:                             }
                    209:                         }
                    210:                         unless ($created eq '') {
                    211:                             $changes{'internal.created'} = $created;
                    212:                         }
                    213:                     }
                    214:                 }
1.4     ! raeburn   215:                 
        !           216:                 $env{'request.course.id'} = $cdom.'_'.$cnum;
        !           217:                 $env{'request.role'} = 'cc./'.$cdom.'/'.$cnum;
        !           218:                 &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
        !           219: 
        !           220:                 # check all parameters
        !           221:                 ($reqdmajor,$reqdminor) = &parameter_constraints($cnum,$cdom);
        !           222: 
        !           223:                 # check course type
        !           224:                 ($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype,
        !           225:                                                                  $reqdmajor,
        !           226:                                                                  $reqdminor);
        !           227:                 # check course contents
        !           228:                 ($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom,
        !           229:                                                                      $reqdmajor,
        !           230:                                                                      $reqdminor);
        !           231:                 delete($env{'request.course.id'});
        !           232:                 delete($env{'request.role'});
        !           233: 
1.1       raeburn   234:                 unless ($chome eq 'no_host') {
                    235:                     $courseshash->{$chome}{$cid} = {
                    236:                         description => $courseinfo{'description'},
                    237:                         inst_code   => $inst_code,
                    238:                         owner       => $owner,
                    239:                         type        => $crstype,
                    240:                     };
                    241:                     if ($creator ne '') {
                    242:                         $courseshash->{$chome}{$cid}{'creator'} = $creator;
                    243:                     }
                    244:                     if ($created ne '') {
                    245:                         $courseshash->{$chome}{$cid}{'created'} = $created;
                    246:                     }
                    247:                     if ($creationcontext ne '') {
                    248:                         $courseshash->{$chome}{$cid}{'context'} = $creationcontext;
                    249:                     }
1.2       raeburn   250:                     if (($inst_code ne '') && ($autoassign)) {
                    251:                         unless ($gotcc) {
                    252:                             %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                    253:                         }
                    254:                         my @currcoowners;
                    255:                         my @newcoowners;
                    256:                         if ($courseinfo{'internal.co-owners'} ne '') {
                    257:                             @currcoowners = split(',',$courseinfo{'internal.co-owners'});
                    258:                         }
                    259:                         foreach my $key (keys(%roleshash)) {
                    260:                             if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
                    261:                                 my $cc = $1;
                    262:                                 unless ($cc eq $owner) {
                    263:                                     my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc);
                    264:                                     if ($result eq 'valid') {
                    265:                                         if (@newcoowners > 0) {
                    266:                                             unless (grep(/^\Q$cc\E$/,@newcoowners)) { 
                    267:                                                 push(@newcoowners,$cc);
                    268:                                             }
                    269:                                         } else {
                    270:                                             push(@newcoowners,$cc);
                    271:                                         }
                    272:                                     }
                    273:                                 }
                    274:                             }
                    275:                         }
                    276:                         my @diffs = &Apache::loncommon::compare_arrays(\@currcoowners,\@newcoowners);
                    277:                         if (@diffs > 0) {
                    278:                             if (@newcoowners > 0) {
                    279:                                 $changes{'internal.co-owners'} = join(',',@newcoowners);
                    280:                                 $courseshash->{$chome}{$cid}{'co-owners'} = $changes{'internal.co-owners'};
                    281:                             } else {
                    282:                                 if ($courseinfo{'internal.co-owners'} ne '') {
                    283:                                     if (&Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum) eq 'ok') {
                    284:                                         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";
                    285:                                     }
                    286:                                 } else {
                    287:                                     print $fh "Error occurred when updating co-ownership in course's environment.db for ".$cdom."_".$cnum."\n";
                    288:                                 }
                    289:                             }
                    290:                         } elsif (@currcoowners > 0) {
                    291:                             $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    292:                         }
                    293:                     } elsif ($courseinfo{'internal.co-owners'} ne '') {
                    294:                         $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    295:                     }
1.3       raeburn   296:                     foreach my $item ('categories','cloners','hidefromcat') {
                    297:                         if ($courseinfo{$item} ne '') {
                    298:                             $courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; 
                    299:                         }
                    300:                     }
                    301:                     foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date') {
                    302:                         if ($courseinfo{'internal.'.$item} ne '') {
                    303:                             $courseshash->{$chome}{$cid}{$item} =
                    304:                                 $courseinfo{'internal.'.$item};
                    305:                         }
                    306:                     }
1.4     ! raeburn   307:                     if ($reqdmajor ne '' && $reqdminor ne '') {
        !           308:                         $courseshash->{$chome}{$cid}{'releaserequired'} = $reqdmajor.'.'.$reqdminor;
        !           309:                     }
        !           310:                     if ($courseinfo{'internal.releaserequired'} ne $reqdmajor.'.'.$reqdminor) {
        !           311:                         $changes{'internal.releaserequired'} = $reqdmajor.'.'.$reqdminor;
        !           312:                     }
1.1       raeburn   313:                     if (keys(%changes)) {
1.2       raeburn   314:                         if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') {
                    315:                             print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: ";
                    316:                             foreach my $key (sort(keys(%changes))) {
                    317:                                 print $fh "$key => $changes{$key} ";
                    318:                             }
                    319:                             print $fh "\n";
                    320:                         } else {
                    321:                             print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n";
                    322:                         }
1.1       raeburn   323:                     }
                    324:                 }
                    325:             }
                    326:         }
                    327:     }
                    328:     return;
                    329: }
                    330: 
1.4     ! raeburn   331: sub parameter_constraints {
        !           332:     my ($cnum,$cdom) = @_;
        !           333:     my ($reqdmajor,$reqdminor);
        !           334:     my $resourcedata=&read_paramdata($cnum,$cdom);
        !           335:     if (ref($resourcedata) eq 'HASH') {
        !           336:         foreach my $key (keys(%{$resourcedata})) { 
        !           337:             foreach my $item (keys(%checkparms)) {
        !           338:                 if ($key =~ /(\Q$item\E)$/) {
        !           339:                     if (ref($checkparms{$item}) eq 'ARRAY') {
        !           340:                         my $value = $resourcedata->{$key};
        !           341:                         if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) {
        !           342:                             my ($major,$minor) = split(/\./,$needsrelease{'parameter'}{$item}{$value});
        !           343:                             ($reqdmajor,$reqdminor) = 
        !           344:                                 &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
        !           345:                         }
        !           346:                     }
        !           347:                 }
        !           348:             }
        !           349:         }
        !           350:     }
        !           351:     return ($reqdmajor,$reqdminor);
        !           352: }
        !           353: 
        !           354: sub coursetype_constraints {
        !           355:     my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_;
        !           356:     if (defined($checkcrstypes{$crstype})) {
        !           357:         my ($major,$minor) = split(/\./,$checkcrstypes{$crstype});
        !           358:         ($reqdmajor,$reqdminor) = 
        !           359:             &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
        !           360:     }
        !           361:     return ($reqdmajor,$reqdminor);
        !           362: }
        !           363: 
        !           364: sub coursecontent_constraints {
        !           365:     my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
        !           366:     my $navmap = Apache::lonnavmaps::navmap->new();
        !           367:     if (defined($navmap)) {
        !           368:         my %allresponses;
        !           369:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
        !           370:             my %responses = $res->responseTypes();
        !           371:             foreach my $key (keys(%responses)) {
        !           372:                 next unless(exists($checkresponsetypes{$key}));
        !           373:                 $allresponses{$key} += $responses{$key};
        !           374:             }
        !           375:         }
        !           376:         foreach my $key (keys(%allresponses)) {
        !           377:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
        !           378:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
        !           379:         }
        !           380:     }
        !           381:     return ($reqdmajor,$reqdminor);
        !           382: }
        !           383: 
        !           384: sub update_reqd_loncaparev {
        !           385:     my ($major,$minor,$reqdmajor,$reqdminor) = @_;
        !           386:     if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) {
        !           387:         if ($reqdmajor eq '' || $reqdminor eq '') {
        !           388:             $reqdmajor = $major;
        !           389:             $reqdminor = $minor;
        !           390:         } elsif (($major > $reqdmajor) ||
        !           391:             ($major == $reqdmajor && $minor > $reqdminor))  {
        !           392:             $reqdmajor = $major;
        !           393:             $reqdminor = $minor;
        !           394:         }
        !           395:     }
        !           396:     return ($reqdmajor,$reqdminor);
        !           397: }
        !           398: 
        !           399: sub read_paramdata {
        !           400:     my ($cnum,$dom)=@_;
        !           401:     my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$dom);
        !           402:     my $classlist=&Apache::loncoursedata::get_classlist();
        !           403:     foreach my $student (keys(%{$classlist})) {
        !           404:         if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
        !           405:             my ($tuname,$tudom)=($1,$2);
        !           406:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
        !           407:             foreach my $userkey (keys(%{$useropt})) {
        !           408:                 if ($userkey=~/^$env{'request.course.id'}/) {
        !           409:                     my $newkey=$userkey;
        !           410:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
        !           411:                     $$resourcedata{$newkey}=$$useropt{$userkey};
        !           412:                 }
        !           413:             }
        !           414:          }
        !           415:     }
        !           416:     return $resourcedata;
        !           417: }
1.2       raeburn   418: 
1.4     ! raeburn   419: sub parse_releases_xml {
        !           420:     my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml';
        !           421:     if (-e $file) { 
        !           422:         my $parser = HTML::LCParser->new($file);
        !           423:         while (my $token = $parser->get_token()) {
        !           424:             if ($token->[0] eq 'S') {
        !           425:                 my $item = $token->[1];
        !           426:                 my $name = $token->[2]{'name'};
        !           427:                 my $value = $token->[2]{'value'};
        !           428:                 if ($item ne '' && $name ne '' && $value ne '') {
        !           429:                     my $release = $parser->get_text();
        !           430:                     $release =~ s/(^\s*|\s*$ )//gx;
        !           431:                     $needsrelease{$item}{$name}{$value} = $release;
        !           432:                     if ($item eq 'parameter') {
        !           433:                        if (ref($checkparms{$name}) eq 'ARRAY') {
        !           434:                            unless(grep(/^\Q$name\E$/,@{$checkparms{$name}})) {
        !           435:                                push(@{$checkparms{$name}},$value);
        !           436:                            }
        !           437:                        } else {
        !           438:                            push(@{$checkparms{$name}},$value);
        !           439:                        }
        !           440:                     } elsif ($item eq 'resourcetag') {
        !           441:                         if ($name eq 'responsetype') {
        !           442:                             $checkresponsetypes{$value} = $release;
        !           443:                         }
        !           444:                     } elsif ($item eq 'course') {
        !           445:                         if ($name eq 'crstype') {
        !           446:                             $checkcrstypes{$value} = $release;
        !           447:                         }
        !           448:                     }
        !           449:                 }
        !           450:             }
        !           451:         }
        !           452:     }
        !           453:     return;
        !           454: }
1.2       raeburn   455: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>