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

1.1       raeburn     1: #!/usr/bin/perl
                      2: # The LearningOnline Network
                      3: #
1.13    ! raeburn     4: # $Id: refresh_courseids_db.pl,v 1.12 2012/07/21 20:18:37 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.9       raeburn    64: use vars qw( %checkparms %checkresponsetypes %checkcrstypes %anonsurvey %randomizetry );
1.4       raeburn    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.8       raeburn    81: my @ids=&Apache::lonnet::current_machine_ids();
1.4       raeburn    82: 
1.10      raeburn    83: &Apache::loncommon::build_release_hashes(\%checkparms,\%checkresponsetypes,
                     84:                                          \%checkcrstypes,\%anonsurvey,\%randomizetry);
1.4       raeburn    85: $env{'allowed.bre'} = 'F';
                     86: 
1.1       raeburn    87: foreach my $dom (@domains) {
                     88:     my %courseshash;
                     89:     my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.');
1.8       raeburn    90:     my %lastaccess = &Apache::lonnet::courselastaccess($dom,undef,\@ids);
1.1       raeburn    91:     my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
1.2       raeburn    92:     my %domdesign = &Apache::loncommon::get_domainconf($dom);
                     93:     my $autoassign = $domdesign{$dom.'.autoassign.co-owners'};
1.8       raeburn    94:     &recurse_courses($dom,$dir,0,\%courseshash,\%currhash,\%lastaccess,$autoassign,$fh);
1.1       raeburn    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: 
1.4       raeburn   106: delete($env{'allowed.bre'});
                    107: 
1.1       raeburn   108: ## Finished!
                    109: print $fh "==== refresh_courseids.db completed ".localtime()." ====\n";
                    110: close($fh);
                    111: 
                    112: sub recurse_courses {
1.8       raeburn   113:     my ($cdom,$dir,$depth,$courseshash,$currhash,$lastaccess,$autoassign,$fh) = @_;
1.1       raeburn   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) {
1.2       raeburn   122:                 &recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash,
1.8       raeburn   123:                                  $currhash,$lastaccess,$autoassign,$fh);
1.1       raeburn   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'};
1.8       raeburn   156:                 my $twodaysago = time - 172800;
1.4       raeburn   157:                 my (%roleshash,$gotcc,$reqdmajor,$reqdminor);
1.1       raeburn   158:                 if ($owner eq '') {
1.2       raeburn   159:                     %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                    160:                     $gotcc = 1;
1.1       raeburn   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'};
1.8       raeburn   182:                 my $releaserequired = $courseinfo{'internal.releaserequired'};
1.1       raeburn   183:                 $inst_code = '' if (!defined($inst_code));
                    184:                 $owner = '' if (!defined($owner));
                    185:                 if ($created eq '') {
1.2       raeburn   186:                     if (ref($currhash->{$cid}) eq 'HASH') {
                    187:                         $created = $currhash->{$cid}{'created'};
                    188:                         $creator = $currhash->{$cid}{'creator'};
                    189:                         $creationcontext = $currhash->{$cid}{'context'};
1.1       raeburn   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:                         }
1.8       raeburn   205:                         if ($lastaccess->{$cid}) {
1.1       raeburn   206:                             if ($created eq '') {
1.8       raeburn   207:                                 $created = $lastaccess->{$cid};
                    208:                             } elsif ($lastaccess->{$cid} < $created) {
                    209:                                 $created = $lastaccess->{$cid};
1.1       raeburn   210:                             }
                    211:                         }
                    212:                         unless ($created eq '') {
                    213:                             $changes{'internal.created'} = $created;
                    214:                         }
                    215:                     }
                    216:                 }
1.8       raeburn   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);
1.11      raeburn   230:                     # check communication blocks 
                    231:                     ($reqdmajor,$reqdminor) = &commblock_constraints($cnum,$cdom,
                    232:                                                                      $reqdmajor,
                    233:                                                                      $reqdminor);
1.8       raeburn   234:                     # check course contents
                    235:                     ($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom,
                    236:                                                                          $reqdmajor,
                    237:                                                                          $reqdminor);
                    238:                     delete($env{'request.course.id'});
                    239:                     delete($env{'request.role'});
                    240:                 } elsif ($releaserequired) {
                    241:                     ($reqdmajor,$reqdminor) = split(/\./,$releaserequired);
                    242:                 }
1.4       raeburn   243: 
1.1       raeburn   244:                 unless ($chome eq 'no_host') {
1.13    ! raeburn   245:                     if (($lastaccess->{$cid} eq '') ||
        !           246:                         ($lastaccess->{$cid} > $twodaysago)) {
        !           247:                         my $contentchange;
        !           248:                         if ($courseinfo{'internal.created'} eq '') {
        !           249:                             $contentchange = &last_map_update($cnum,$cdom);
        !           250:                         } else {
        !           251:                             unless ($courseinfo{'internal.created'} > $lastaccess->{$cid}) {
        !           252:                                 $contentchange = &last_map_update($cnum,$cdom);
        !           253:                             }
        !           254:                         }
        !           255:                         if (($contentchange) && ($contentchange > $courseinfo{'internal.contentchange'})) {
        !           256:                             $changes{'internal.contentchange'} = $contentchange;
        !           257:                         }
        !           258:                     }
1.1       raeburn   259:                     $courseshash->{$chome}{$cid} = {
                    260:                         description => $courseinfo{'description'},
                    261:                         inst_code   => $inst_code,
                    262:                         owner       => $owner,
                    263:                         type        => $crstype,
                    264:                     };
                    265:                     if ($creator ne '') {
                    266:                         $courseshash->{$chome}{$cid}{'creator'} = $creator;
                    267:                     }
                    268:                     if ($created ne '') {
                    269:                         $courseshash->{$chome}{$cid}{'created'} = $created;
                    270:                     }
                    271:                     if ($creationcontext ne '') {
                    272:                         $courseshash->{$chome}{$cid}{'context'} = $creationcontext;
                    273:                     }
1.2       raeburn   274:                     if (($inst_code ne '') && ($autoassign)) {
                    275:                         unless ($gotcc) {
                    276:                             %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                    277:                         }
                    278:                         my @currcoowners;
                    279:                         my @newcoowners;
                    280:                         if ($courseinfo{'internal.co-owners'} ne '') {
                    281:                             @currcoowners = split(',',$courseinfo{'internal.co-owners'});
                    282:                         }
                    283:                         foreach my $key (keys(%roleshash)) {
                    284:                             if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
                    285:                                 my $cc = $1;
                    286:                                 unless ($cc eq $owner) {
                    287:                                     my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc);
                    288:                                     if ($result eq 'valid') {
                    289:                                         if (@newcoowners > 0) {
                    290:                                             unless (grep(/^\Q$cc\E$/,@newcoowners)) { 
                    291:                                                 push(@newcoowners,$cc);
                    292:                                             }
                    293:                                         } else {
                    294:                                             push(@newcoowners,$cc);
                    295:                                         }
                    296:                                     }
                    297:                                 }
                    298:                             }
                    299:                         }
                    300:                         my @diffs = &Apache::loncommon::compare_arrays(\@currcoowners,\@newcoowners);
                    301:                         if (@diffs > 0) {
                    302:                             if (@newcoowners > 0) {
                    303:                                 $changes{'internal.co-owners'} = join(',',@newcoowners);
                    304:                                 $courseshash->{$chome}{$cid}{'co-owners'} = $changes{'internal.co-owners'};
                    305:                             } else {
                    306:                                 if ($courseinfo{'internal.co-owners'} ne '') {
                    307:                                     if (&Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum) eq 'ok') {
                    308:                                         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";
                    309:                                     }
                    310:                                 } else {
                    311:                                     print $fh "Error occurred when updating co-ownership in course's environment.db for ".$cdom."_".$cnum."\n";
                    312:                                 }
                    313:                             }
                    314:                         } elsif (@currcoowners > 0) {
                    315:                             $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    316:                         }
                    317:                     } elsif ($courseinfo{'internal.co-owners'} ne '') {
                    318:                         $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    319:                     }
1.3       raeburn   320:                     foreach my $item ('categories','cloners','hidefromcat') {
                    321:                         if ($courseinfo{$item} ne '') {
                    322:                             $courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; 
                    323:                         }
                    324:                     }
                    325:                     foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date') {
                    326:                         if ($courseinfo{'internal.'.$item} ne '') {
                    327:                             $courseshash->{$chome}{$cid}{$item} =
                    328:                                 $courseinfo{'internal.'.$item};
                    329:                         }
                    330:                     }
1.6       raeburn   331:                     if ($reqdmajor eq '' && $reqdminor eq '') {
                    332:                         if ($courseinfo{'internal.releaserequired'} ne '') {
                    333:                             $changes{'internal.releaserequired'} = '';
                    334:                         }
                    335:                     } else {
                    336:                         my $releasereq =  $reqdmajor.'.'.$reqdminor;
                    337:                         $courseshash->{$chome}{$cid}{'releaserequired'} = $releasereq;
                    338:                         if ($courseinfo{'internal.releaserequired'} eq '') {
                    339:                             $changes{'internal.releaserequired'} = $releasereq;
                    340:                         } else {
                    341:                             if ($courseinfo{'internal.releaserequired'} ne $releasereq) {
                    342:                         
                    343:                                 $changes{'internal.releaserequired'} = $releasereq;
                    344:                             }
                    345:                         }
1.4       raeburn   346:                     }
1.1       raeburn   347:                     if (keys(%changes)) {
1.2       raeburn   348:                         if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') {
                    349:                             print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: ";
                    350:                             foreach my $key (sort(keys(%changes))) {
                    351:                                 print $fh "$key => $changes{$key} ";
                    352:                             }
                    353:                             print $fh "\n";
                    354:                         } else {
                    355:                             print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n";
                    356:                         }
1.1       raeburn   357:                     }
                    358:                 }
                    359:             }
                    360:         }
                    361:     }
                    362:     return;
                    363: }
                    364: 
1.4       raeburn   365: sub parameter_constraints {
                    366:     my ($cnum,$cdom) = @_;
                    367:     my ($reqdmajor,$reqdminor);
                    368:     my $resourcedata=&read_paramdata($cnum,$cdom);
                    369:     if (ref($resourcedata) eq 'HASH') {
                    370:         foreach my $key (keys(%{$resourcedata})) { 
                    371:             foreach my $item (keys(%checkparms)) {
                    372:                 if ($key =~ /(\Q$item\E)$/) {
                    373:                     if (ref($checkparms{$item}) eq 'ARRAY') {
                    374:                         my $value = $resourcedata->{$key};
                    375:                         if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) {
1.5       raeburn   376:                             my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value});
1.4       raeburn   377:                             ($reqdmajor,$reqdminor) = 
                    378:                                 &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    379:                         }
                    380:                     }
                    381:                 }
                    382:             }
                    383:         }
                    384:     }
                    385:     return ($reqdmajor,$reqdminor);
                    386: }
                    387: 
                    388: sub coursetype_constraints {
                    389:     my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_;
                    390:     if (defined($checkcrstypes{$crstype})) {
                    391:         my ($major,$minor) = split(/\./,$checkcrstypes{$crstype});
                    392:         ($reqdmajor,$reqdminor) = 
                    393:             &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    394:     }
                    395:     return ($reqdmajor,$reqdminor);
                    396: }
                    397: 
1.11      raeburn   398: sub commblock_constraints {
                    399:     my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
                    400:     my %comm_blocks =  &Apache::lonnet::dump('commblock',$cdom,$cnum);
                    401:     my $now = time;
                    402:     if (keys(%comm_blocks) > 0) {
                    403:         foreach my $block (keys(%comm_blocks)) {
                    404:             if ($block =~ /^firstaccess____(.+)$/) {
                    405:                 my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course.commblock.timer'});
                    406:                 ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    407:                 last;
1.12      raeburn   408:             } elsif ($block =~ /^(\d+)____(\d+)$/) {
1.11      raeburn   409:                 my ($start,$end) = ($1,$2);
                    410:                 next if ($end < $now); 
                    411:             }
                    412:             if (ref($comm_blocks{$block}) eq 'HASH') {
                    413:                 if (ref($comm_blocks{$block}{'blocks'}) eq 'HASH') {
                    414:                     if (ref($comm_blocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
1.12      raeburn   415:                         if (keys(%{$comm_blocks{$block}{'blocks'}{'docs'}}) > 0) {
1.11      raeburn   416:                             my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course.commblock.docs'});
                    417:                             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    418:                             last;
                    419:                         }
                    420:                     }
                    421:                 }
                    422:             }
                    423:         }
                    424:     }
                    425:     return;
                    426: }
                    427: 
1.4       raeburn   428: sub coursecontent_constraints {
                    429:     my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
                    430:     my $navmap = Apache::lonnavmaps::navmap->new();
                    431:     if (defined($navmap)) {
1.7       raeburn   432:         my %anonsubmissions =  &Apache::lonnet::dump('nohist_anonsurveys',
1.5       raeburn   433:                                                      $cdom,$cnum);
1.9       raeburn   434:         my %randomizetrysubm = &Apache::lonnet::dump('nohist_randomizetry',
                    435:                                                      $cdom,$cnum);
1.4       raeburn   436:         my %allresponses;
1.9       raeburn   437:         my ($anonsurv_subm,$randbytry_subm);
1.4       raeburn   438:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                    439:             my %responses = $res->responseTypes();
                    440:             foreach my $key (keys(%responses)) {
                    441:                 next unless(exists($checkresponsetypes{$key}));
                    442:                 $allresponses{$key} += $responses{$key};
                    443:             }
1.5       raeburn   444:             my @parts = @{$res->parts()};
                    445:             my $symb = $res->symb();
                    446:             foreach my $part (@parts) {
1.7       raeburn   447:                 if (exists($anonsubmissions{$symb."\0".$part})) {
1.5       raeburn   448:                     $anonsurv_subm = 1;
                    449:                 }
1.9       raeburn   450:                 if (exists($randomizetrysubm{$symb."\0".$part})) {
                    451:                     $randbytry_subm = 1;
                    452:                 }
1.5       raeburn   453:             }
1.4       raeburn   454:         }
                    455:         foreach my $key (keys(%allresponses)) {
                    456:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                    457:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    458:         }
1.5       raeburn   459:         if ($anonsurv_subm) {
                    460:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($anonsurvey{major},
                    461:                                           $anonsurvey{minor},$reqdmajor,$reqdminor);
                    462:         }
1.9       raeburn   463:         if ($randbytry_subm) {
                    464:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($randomizetry{major},
                    465:                                           $randomizetry{minor},$reqdmajor,$reqdminor);
                    466:         }
1.4       raeburn   467:     }
                    468:     return ($reqdmajor,$reqdminor);
                    469: }
                    470: 
                    471: sub update_reqd_loncaparev {
                    472:     my ($major,$minor,$reqdmajor,$reqdminor) = @_;
                    473:     if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) {
                    474:         if ($reqdmajor eq '' || $reqdminor eq '') {
                    475:             $reqdmajor = $major;
                    476:             $reqdminor = $minor;
                    477:         } elsif (($major > $reqdmajor) ||
                    478:             ($major == $reqdmajor && $minor > $reqdminor))  {
                    479:             $reqdmajor = $major;
                    480:             $reqdminor = $minor;
                    481:         }
                    482:     }
                    483:     return ($reqdmajor,$reqdminor);
                    484: }
                    485: 
                    486: sub read_paramdata {
                    487:     my ($cnum,$dom)=@_;
                    488:     my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$dom);
                    489:     my $classlist=&Apache::loncoursedata::get_classlist();
                    490:     foreach my $student (keys(%{$classlist})) {
                    491:         if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
                    492:             my ($tuname,$tudom)=($1,$2);
                    493:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                    494:             foreach my $userkey (keys(%{$useropt})) {
                    495:                 if ($userkey=~/^$env{'request.course.id'}/) {
                    496:                     my $newkey=$userkey;
                    497:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                    498:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                    499:                 }
                    500:             }
                    501:          }
                    502:     }
                    503:     return $resourcedata;
                    504: }
1.2       raeburn   505: 
1.13    ! raeburn   506: sub last_map_update {
        !           507:     my ($cnum,$cdom) = @_;
        !           508:     my $lastupdate = 0;
        !           509:     my $path = &LONCAPA::propath($cdom,$cnum);
        !           510:     if (-d "$path/userfiles") {
        !           511:         if (opendir(my $dirh, "$path/userfiles")) {
        !           512:             my @maps = grep(/^default_?\d*\.(?:sequence|page)$/,readdir($dirh));
        !           513:             foreach my $map (@maps) {
        !           514:                 my $mtime = (stat("$path/userfiles/$map"))[9];
        !           515:                 if ($mtime > $lastupdate) {
        !           516:                     $lastupdate = $mtime;
        !           517:                 }
        !           518:             }
        !           519:         }
        !           520:     }
        !           521:     return $lastupdate;
        !           522: }
        !           523: 

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