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

1.1       raeburn     1: #!/usr/bin/perl
                      2: # The LearningOnline Network
                      3: #
1.23    ! raeburn     4: # $Id: refresh_courseids_db.pl,v 1.22 2020/04/22 16:43: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.19      raeburn    60: use Apache::lonrelrequtils;
1.1       raeburn    61: use LONCAPA qw(:DEFAULT :match);
                     62: 
                     63: exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
                     64: 
                     65: #  Make sure this process is running from user=www
                     66: my $wwwid=getpwnam('www');
                     67: if ($wwwid!=$<) {
                     68:     my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}";
                     69:     my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
                     70:     system("echo 'User ID mismatch. refresh_courseids_db.pl must be run as user www.' |\
                     71:  mail -s '$subj' $emailto > /dev/null");
                     72:     exit 1;
                     73: }
                     74: #
                     75: # Let people know we are running
                     76: open(my $fh,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/refreshcourseids_db.log');
                     77: print $fh "==== refresh_courseids_db.pl Run ".localtime()."====\n";
                     78: 
                     79: my @domains = sort(&Apache::lonnet::current_machine_domains());
1.8       raeburn    80: my @ids=&Apache::lonnet::current_machine_ids();
1.4       raeburn    81: 
1.19      raeburn    82: &Apache::lonrelrequtils::init_global_hashes();
                     83: my $globals_set = 1;
                     84: 
1.4       raeburn    85: $env{'allowed.bre'} = 'F';
                     86: 
1.1       raeburn    87: foreach my $dom (@domains) {
1.14      raeburn    88:     $env{'user.domain'} = $dom;
                     89:     $env{'user.name'} = &Apache::lonnet::get_domainconfiguser($dom);
1.1       raeburn    90:     my %courseshash;
                     91:     my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.');
1.8       raeburn    92:     my %lastaccess = &Apache::lonnet::courselastaccess($dom,undef,\@ids);
1.1       raeburn    93:     my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
1.2       raeburn    94:     my %domdesign = &Apache::loncommon::get_domainconf($dom);
                     95:     my $autoassign = $domdesign{$dom.'.autoassign.co-owners'};
1.8       raeburn    96:     &recurse_courses($dom,$dir,0,\%courseshash,\%currhash,\%lastaccess,$autoassign,$fh);
1.1       raeburn    97:     foreach my $lonhost (keys(%courseshash)) {
                     98:         if (ref($courseshash{$lonhost}) eq 'HASH') {
                     99:             if (&Apache::lonnet::courseidput($dom,$courseshash{$lonhost},$lonhost,'notime') eq 'ok') {
                    100:                 print $fh "nohist_courseids.db updated successfully for domain $dom on lonHostID $lonhost\n";
                    101:             } else {
                    102:                 print $fh "Error occurred when updating nohist_courseids.db for domain $dom on lonHostID $lonhost\n";
                    103:             }
                    104:         }
                    105:     }
1.15      bisitz    106:     delete($env{'user.name'});
1.14      raeburn   107:     delete($env{'user.domain'});
1.1       raeburn   108: }
                    109: 
1.4       raeburn   110: delete($env{'allowed.bre'});
                    111: 
1.1       raeburn   112: ## Finished!
                    113: print $fh "==== refresh_courseids.db completed ".localtime()." ====\n";
                    114: close($fh);
                    115: 
                    116: sub recurse_courses {
1.8       raeburn   117:     my ($cdom,$dir,$depth,$courseshash,$currhash,$lastaccess,$autoassign,$fh) = @_;
1.1       raeburn   118:     next unless (ref($currhash) eq 'HASH');
                    119:     if (-d $dir) {
                    120:         opendir(DIR,$dir);
                    121:         my @contents = grep(!/^\./,readdir(DIR));
                    122:         closedir(DIR);
                    123:         $depth ++;
                    124:         foreach my $item (@contents) {
1.20      raeburn   125:             if (($depth < 4) && (length($item) == 1)) {
1.2       raeburn   126:                 &recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash,
1.8       raeburn   127:                                  $currhash,$lastaccess,$autoassign,$fh);
1.1       raeburn   128:             } elsif ($item =~ /^$match_courseid$/) {
                    129:                 my $cnum = $item;
                    130:                 my $cid = $cdom.'_'.$cnum;
                    131:                 unless (ref($currhash->{$cid}) eq 'HASH') {
                    132:                     my $is_course = 0;
                    133:                     if (-e "$dir/$cnum/passwd") {
                    134:                         if (open(my $pwfh,"<$dir/$cnum/passwd")) {
                    135:                             while (<$pwfh>) {
                    136:                                 if (/^none:/) {
                    137:                                     $is_course = 1;
                    138:                                     last;
                    139:                                 }
                    140:                             } 
                    141:                         }
                    142:                     }
                    143:                     next unless ($is_course);
                    144:                     my @stats = stat("$dir/$cnum/passwd");
                    145:                     print $fh "Course missing from nohist_courseids.db: $cid, created:".localtime($stats[9])."\n";
                    146:                 }
                    147:                 my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
                    148:                 my %changes = ();
                    149:                 my $crstype = $courseinfo{'type'};
                    150:                 if ($crstype eq '') {
                    151:                     if ($cnum =~ /^$match_community$/) {
                    152:                         $crstype = 'Community';
                    153:                     } else {
                    154:                         $crstype = 'Course';
                    155:                     }
                    156:                     $changes{'type'} = $crstype;
                    157:                 }
                    158:                 my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                    159:                 my $owner = $courseinfo{'internal.courseowner'};
1.8       raeburn   160:                 my $twodaysago = time - 172800;
1.4       raeburn   161:                 my (%roleshash,$gotcc,$reqdmajor,$reqdminor);
1.1       raeburn   162:                 if ($owner eq '') {
1.2       raeburn   163:                     %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                    164:                     $gotcc = 1;
1.1       raeburn   165:                     if (keys(%roleshash) == 1) {
                    166:                         foreach my $key (keys(%roleshash)) {
                    167:                             if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
                    168:                                 $owner = $1;
                    169:                                 $changes{'internal.courseowner'} = $owner;
                    170:                             }
                    171:                         }
                    172:                     }
                    173:                 } elsif ($owner !~ /:/) {
                    174:                     if ($owner =~ /^$match_username$/) {
                    175:                         my $ownerhome=&Apache::lonnet::homeserver($owner,$cdom);
                    176:                         unless (($ownerhome eq '') || ($ownerhome eq 'no_host')) {
                    177:                             $owner .= ':'.$cdom;
                    178:                             $changes{'internal.courseowner'} = $owner;
                    179:                         }
                    180:                     }
                    181:                 }
                    182:                 my $created = $courseinfo{'internal.created'};
                    183:                 my $creator = $courseinfo{'internal.creator'};
                    184:                 my $creationcontext = $courseinfo{'internal.creationcontext'};
                    185:                 my $inst_code = $courseinfo{'internal.coursecode'};
1.23    ! raeburn   186:                 my $xlists = $courseinfo{'internal.crosslistings'};
1.8       raeburn   187:                 my $releaserequired = $courseinfo{'internal.releaserequired'};
1.17      raeburn   188:                 my $uniquecode = $courseinfo{'internal.uniquecode'};
1.1       raeburn   189:                 $inst_code = '' if (!defined($inst_code));
                    190:                 $owner = '' if (!defined($owner));
1.17      raeburn   191:                 $uniquecode = '' if (!defined($uniquecode));
1.1       raeburn   192:                 if ($created eq '') {
1.2       raeburn   193:                     if (ref($currhash->{$cid}) eq 'HASH') {
                    194:                         $created = $currhash->{$cid}{'created'};
                    195:                         $creator = $currhash->{$cid}{'creator'};
                    196:                         $creationcontext = $currhash->{$cid}{'context'};
1.1       raeburn   197:                         unless ($created eq '') {
                    198:                             $changes{'internal.created'} = $created;
                    199:                         }
                    200:                         if ($creator =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/) {
                    201:                              $changes{'internal.creator'} = $creator;
                    202:                         }
                    203:                         unless ($creationcontext eq '') {
                    204:                             $changes{'internal.creationcontext'} = $creationcontext;
                    205:                         }
                    206:                     }
                    207:                     if ($created eq '') {
                    208:                         if (-e "$dir/$cnum/passwd") {
                    209:                             my @stats = stat("$dir/$cnum/passwd");
                    210:                             $created = $stats[9];
                    211:                         }
1.8       raeburn   212:                         if ($lastaccess->{$cid}) {
1.1       raeburn   213:                             if ($created eq '') {
1.8       raeburn   214:                                 $created = $lastaccess->{$cid};
                    215:                             } elsif ($lastaccess->{$cid} < $created) {
                    216:                                 $created = $lastaccess->{$cid};
1.1       raeburn   217:                             }
                    218:                         }
                    219:                         unless ($created eq '') {
                    220:                             $changes{'internal.created'} = $created;
                    221:                         }
                    222:                     }
                    223:                 }
1.8       raeburn   224:                  
                    225:                 if (($chome ne '')  && ($lastaccess->{$cid} > $twodaysago)) {
                    226:                     $env{'request.course.id'} = $cdom.'_'.$cnum;
                    227:                     $env{'request.role'} = 'cc./'.$cdom.'/'.$cnum;
1.22      raeburn   228:                     $env{'request.role.adv'} = 1;
1.8       raeburn   229: 
1.19      raeburn   230:                     my $readmap = 1;
                    231:                     ($reqdmajor,$reqdminor) = &Apache::lonrelrequtils::get_release_req($cnum,$cdom,
                    232:                                                                                        $crstype,$readmap,
                    233:                                                                                        $globals_set);
1.22      raeburn   234:                     delete($env{'request.role.adv'});
1.8       raeburn   235:                     delete($env{'request.course.id'});
                    236:                     delete($env{'request.role'});
                    237:                 } elsif ($releaserequired) {
                    238:                     ($reqdmajor,$reqdminor) = split(/\./,$releaserequired);
                    239:                 }
1.4       raeburn   240: 
1.1       raeburn   241:                 unless ($chome eq 'no_host') {
1.13      raeburn   242:                     if (($lastaccess->{$cid} eq '') ||
                    243:                         ($lastaccess->{$cid} > $twodaysago)) {
                    244:                         my $contentchange;
                    245:                         if ($courseinfo{'internal.created'} eq '') {
                    246:                             $contentchange = &last_map_update($cnum,$cdom);
                    247:                         } else {
                    248:                             unless ($courseinfo{'internal.created'} > $lastaccess->{$cid}) {
                    249:                                 $contentchange = &last_map_update($cnum,$cdom);
                    250:                             }
                    251:                         }
                    252:                         if (($contentchange) && ($contentchange > $courseinfo{'internal.contentchange'})) {
                    253:                             $changes{'internal.contentchange'} = $contentchange;
                    254:                         }
                    255:                     }
1.1       raeburn   256:                     $courseshash->{$chome}{$cid} = {
                    257:                         description => $courseinfo{'description'},
                    258:                         inst_code   => $inst_code,
                    259:                         owner       => $owner,
                    260:                         type        => $crstype,
                    261:                     };
                    262:                     if ($creator ne '') {
                    263:                         $courseshash->{$chome}{$cid}{'creator'} = $creator;
                    264:                     }
                    265:                     if ($created ne '') {
                    266:                         $courseshash->{$chome}{$cid}{'created'} = $created;
                    267:                     }
                    268:                     if ($creationcontext ne '') {
                    269:                         $courseshash->{$chome}{$cid}{'context'} = $creationcontext;
                    270:                     }
1.2       raeburn   271:                     if (($inst_code ne '') && ($autoassign)) {
                    272:                         unless ($gotcc) {
                    273:                             %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                    274:                         }
                    275:                         my @currcoowners;
                    276:                         my @newcoowners;
                    277:                         if ($courseinfo{'internal.co-owners'} ne '') {
                    278:                             @currcoowners = split(',',$courseinfo{'internal.co-owners'});
                    279:                         }
                    280:                         foreach my $key (keys(%roleshash)) {
                    281:                             if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
                    282:                                 my $cc = $1;
                    283:                                 unless ($cc eq $owner) {
                    284:                                     my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc);
1.23    ! raeburn   285:                                     unless ($result eq 'valid') {
        !           286:                                         if ($xlists ne '') {
        !           287:                                             foreach my $xlist (split(',',$xlists)) {
        !           288:                                                 my ($inst_crosslist,$lcsec) = split(':',$xlist);
        !           289:                                                 $result =
        !           290:                                                     &Apache::lonnet::auto_validate_inst_crosslist($cnum,$cdom,$inst_code,
        !           291:                                                                                                   $inst_crosslist,$cc);
        !           292:                                                 last if ($result eq 'valid');
        !           293:                                             }
        !           294:                                         }
        !           295:                                     }
1.2       raeburn   296:                                     if ($result eq 'valid') {
                    297:                                         if (@newcoowners > 0) {
1.23    ! raeburn   298:                                             unless (grep(/^\Q$cc\E$/,@newcoowners)) {
1.2       raeburn   299:                                                 push(@newcoowners,$cc);
                    300:                                             }
                    301:                                         } else {
                    302:                                             push(@newcoowners,$cc);
                    303:                                         }
                    304:                                     }
                    305:                                 }
                    306:                             }
                    307:                         }
                    308:                         my @diffs = &Apache::loncommon::compare_arrays(\@currcoowners,\@newcoowners);
                    309:                         if (@diffs > 0) {
                    310:                             if (@newcoowners > 0) {
                    311:                                 $changes{'internal.co-owners'} = join(',',@newcoowners);
                    312:                                 $courseshash->{$chome}{$cid}{'co-owners'} = $changes{'internal.co-owners'};
                    313:                             } else {
                    314:                                 if ($courseinfo{'internal.co-owners'} ne '') {
                    315:                                     if (&Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum) eq 'ok') {
                    316:                                         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";
                    317:                                     }
                    318:                                 } else {
                    319:                                     print $fh "Error occurred when updating co-ownership in course's environment.db for ".$cdom."_".$cnum."\n";
                    320:                                 }
                    321:                             }
                    322:                         } elsif (@currcoowners > 0) {
                    323:                             $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    324:                         }
                    325:                     } elsif ($courseinfo{'internal.co-owners'} ne '') {
                    326:                         $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    327:                     }
1.3       raeburn   328:                     foreach my $item ('categories','cloners','hidefromcat') {
                    329:                         if ($courseinfo{$item} ne '') {
                    330:                             $courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; 
                    331:                         }
                    332:                     }
1.17      raeburn   333:                     foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date','uniquecode') {
1.3       raeburn   334:                         if ($courseinfo{'internal.'.$item} ne '') {
                    335:                             $courseshash->{$chome}{$cid}{$item} =
                    336:                                 $courseinfo{'internal.'.$item};
                    337:                         }
                    338:                     }
1.6       raeburn   339:                     if ($reqdmajor eq '' && $reqdminor eq '') {
                    340:                         if ($courseinfo{'internal.releaserequired'} ne '') {
                    341:                             $changes{'internal.releaserequired'} = '';
                    342:                         }
                    343:                     } else {
                    344:                         my $releasereq =  $reqdmajor.'.'.$reqdminor;
                    345:                         $courseshash->{$chome}{$cid}{'releaserequired'} = $releasereq;
                    346:                         if ($courseinfo{'internal.releaserequired'} eq '') {
                    347:                             $changes{'internal.releaserequired'} = $releasereq;
                    348:                         } else {
                    349:                             if ($courseinfo{'internal.releaserequired'} ne $releasereq) {
                    350:                                 $changes{'internal.releaserequired'} = $releasereq;
                    351:                             }
                    352:                         }
1.4       raeburn   353:                     }
1.1       raeburn   354:                     if (keys(%changes)) {
1.2       raeburn   355:                         if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') {
                    356:                             print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: ";
                    357:                             foreach my $key (sort(keys(%changes))) {
                    358:                                 print $fh "$key => $changes{$key} ";
                    359:                             }
                    360:                             print $fh "\n";
                    361:                         } else {
                    362:                             print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n";
                    363:                         }
1.1       raeburn   364:                     }
                    365:                 }
                    366:             }
                    367:         }
                    368:     }
                    369:     return;
                    370: }
                    371: 
1.13      raeburn   372: sub last_map_update {
                    373:     my ($cnum,$cdom) = @_;
                    374:     my $lastupdate = 0;
                    375:     my $path = &LONCAPA::propath($cdom,$cnum);
                    376:     if (-d "$path/userfiles") {
                    377:         if (opendir(my $dirh, "$path/userfiles")) {
                    378:             my @maps = grep(/^default_?\d*\.(?:sequence|page)$/,readdir($dirh));
                    379:             foreach my $map (@maps) {
                    380:                 my $mtime = (stat("$path/userfiles/$map"))[9];
                    381:                 if ($mtime > $lastupdate) {
                    382:                     $lastupdate = $mtime;
                    383:                 }
                    384:             }
                    385:         }
                    386:     }
                    387:     return $lastupdate;
                    388: }
                    389: 

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