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

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

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