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

1.1       raeburn     1: #!/usr/bin/perl
                      2: # The LearningOnline Network
                      3: #
1.12    ! raeburn     4: # $Id: refresh_courseids_db.pl,v 1.11 2012/03/31 22:10:16 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') {
                    245:                     $courseshash->{$chome}{$cid} = {
                    246:                         description => $courseinfo{'description'},
                    247:                         inst_code   => $inst_code,
                    248:                         owner       => $owner,
                    249:                         type        => $crstype,
                    250:                     };
                    251:                     if ($creator ne '') {
                    252:                         $courseshash->{$chome}{$cid}{'creator'} = $creator;
                    253:                     }
                    254:                     if ($created ne '') {
                    255:                         $courseshash->{$chome}{$cid}{'created'} = $created;
                    256:                     }
                    257:                     if ($creationcontext ne '') {
                    258:                         $courseshash->{$chome}{$cid}{'context'} = $creationcontext;
                    259:                     }
1.2       raeburn   260:                     if (($inst_code ne '') && ($autoassign)) {
                    261:                         unless ($gotcc) {
                    262:                             %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                    263:                         }
                    264:                         my @currcoowners;
                    265:                         my @newcoowners;
                    266:                         if ($courseinfo{'internal.co-owners'} ne '') {
                    267:                             @currcoowners = split(',',$courseinfo{'internal.co-owners'});
                    268:                         }
                    269:                         foreach my $key (keys(%roleshash)) {
                    270:                             if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
                    271:                                 my $cc = $1;
                    272:                                 unless ($cc eq $owner) {
                    273:                                     my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc);
                    274:                                     if ($result eq 'valid') {
                    275:                                         if (@newcoowners > 0) {
                    276:                                             unless (grep(/^\Q$cc\E$/,@newcoowners)) { 
                    277:                                                 push(@newcoowners,$cc);
                    278:                                             }
                    279:                                         } else {
                    280:                                             push(@newcoowners,$cc);
                    281:                                         }
                    282:                                     }
                    283:                                 }
                    284:                             }
                    285:                         }
                    286:                         my @diffs = &Apache::loncommon::compare_arrays(\@currcoowners,\@newcoowners);
                    287:                         if (@diffs > 0) {
                    288:                             if (@newcoowners > 0) {
                    289:                                 $changes{'internal.co-owners'} = join(',',@newcoowners);
                    290:                                 $courseshash->{$chome}{$cid}{'co-owners'} = $changes{'internal.co-owners'};
                    291:                             } else {
                    292:                                 if ($courseinfo{'internal.co-owners'} ne '') {
                    293:                                     if (&Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum) eq 'ok') {
                    294:                                         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";
                    295:                                     }
                    296:                                 } else {
                    297:                                     print $fh "Error occurred when updating co-ownership in course's environment.db for ".$cdom."_".$cnum."\n";
                    298:                                 }
                    299:                             }
                    300:                         } elsif (@currcoowners > 0) {
                    301:                             $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    302:                         }
                    303:                     } elsif ($courseinfo{'internal.co-owners'} ne '') {
                    304:                         $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    305:                     }
1.3       raeburn   306:                     foreach my $item ('categories','cloners','hidefromcat') {
                    307:                         if ($courseinfo{$item} ne '') {
                    308:                             $courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; 
                    309:                         }
                    310:                     }
                    311:                     foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date') {
                    312:                         if ($courseinfo{'internal.'.$item} ne '') {
                    313:                             $courseshash->{$chome}{$cid}{$item} =
                    314:                                 $courseinfo{'internal.'.$item};
                    315:                         }
                    316:                     }
1.6       raeburn   317:                     if ($reqdmajor eq '' && $reqdminor eq '') {
                    318:                         if ($courseinfo{'internal.releaserequired'} ne '') {
                    319:                             $changes{'internal.releaserequired'} = '';
                    320:                         }
                    321:                     } else {
                    322:                         my $releasereq =  $reqdmajor.'.'.$reqdminor;
                    323:                         $courseshash->{$chome}{$cid}{'releaserequired'} = $releasereq;
                    324:                         if ($courseinfo{'internal.releaserequired'} eq '') {
                    325:                             $changes{'internal.releaserequired'} = $releasereq;
                    326:                         } else {
                    327:                             if ($courseinfo{'internal.releaserequired'} ne $releasereq) {
                    328:                         
                    329:                                 $changes{'internal.releaserequired'} = $releasereq;
                    330:                             }
                    331:                         }
1.4       raeburn   332:                     }
1.1       raeburn   333:                     if (keys(%changes)) {
1.2       raeburn   334:                         if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') {
                    335:                             print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: ";
                    336:                             foreach my $key (sort(keys(%changes))) {
                    337:                                 print $fh "$key => $changes{$key} ";
                    338:                             }
                    339:                             print $fh "\n";
                    340:                         } else {
                    341:                             print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n";
                    342:                         }
1.1       raeburn   343:                     }
                    344:                 }
                    345:             }
                    346:         }
                    347:     }
                    348:     return;
                    349: }
                    350: 
1.4       raeburn   351: sub parameter_constraints {
                    352:     my ($cnum,$cdom) = @_;
                    353:     my ($reqdmajor,$reqdminor);
                    354:     my $resourcedata=&read_paramdata($cnum,$cdom);
                    355:     if (ref($resourcedata) eq 'HASH') {
                    356:         foreach my $key (keys(%{$resourcedata})) { 
                    357:             foreach my $item (keys(%checkparms)) {
                    358:                 if ($key =~ /(\Q$item\E)$/) {
                    359:                     if (ref($checkparms{$item}) eq 'ARRAY') {
                    360:                         my $value = $resourcedata->{$key};
                    361:                         if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) {
1.5       raeburn   362:                             my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value});
1.4       raeburn   363:                             ($reqdmajor,$reqdminor) = 
                    364:                                 &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    365:                         }
                    366:                     }
                    367:                 }
                    368:             }
                    369:         }
                    370:     }
                    371:     return ($reqdmajor,$reqdminor);
                    372: }
                    373: 
                    374: sub coursetype_constraints {
                    375:     my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_;
                    376:     if (defined($checkcrstypes{$crstype})) {
                    377:         my ($major,$minor) = split(/\./,$checkcrstypes{$crstype});
                    378:         ($reqdmajor,$reqdminor) = 
                    379:             &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    380:     }
                    381:     return ($reqdmajor,$reqdminor);
                    382: }
                    383: 
1.11      raeburn   384: sub commblock_constraints {
                    385:     my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
                    386:     my %comm_blocks =  &Apache::lonnet::dump('commblock',$cdom,$cnum);
                    387:     my $now = time;
                    388:     if (keys(%comm_blocks) > 0) {
                    389:         foreach my $block (keys(%comm_blocks)) {
                    390:             if ($block =~ /^firstaccess____(.+)$/) {
                    391:                 my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course.commblock.timer'});
                    392:                 ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    393:                 last;
1.12    ! raeburn   394:             } elsif ($block =~ /^(\d+)____(\d+)$/) {
1.11      raeburn   395:                 my ($start,$end) = ($1,$2);
                    396:                 next if ($end < $now); 
                    397:             }
                    398:             if (ref($comm_blocks{$block}) eq 'HASH') {
                    399:                 if (ref($comm_blocks{$block}{'blocks'}) eq 'HASH') {
                    400:                     if (ref($comm_blocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
1.12    ! raeburn   401:                         if (keys(%{$comm_blocks{$block}{'blocks'}{'docs'}}) > 0) {
1.11      raeburn   402:                             my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course.commblock.docs'});
                    403:                             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    404:                             last;
                    405:                         }
                    406:                     }
                    407:                 }
                    408:             }
                    409:         }
                    410:     }
                    411:     return;
                    412: }
                    413: 
1.4       raeburn   414: sub coursecontent_constraints {
                    415:     my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
                    416:     my $navmap = Apache::lonnavmaps::navmap->new();
                    417:     if (defined($navmap)) {
1.7       raeburn   418:         my %anonsubmissions =  &Apache::lonnet::dump('nohist_anonsurveys',
1.5       raeburn   419:                                                      $cdom,$cnum);
1.9       raeburn   420:         my %randomizetrysubm = &Apache::lonnet::dump('nohist_randomizetry',
                    421:                                                      $cdom,$cnum);
1.4       raeburn   422:         my %allresponses;
1.9       raeburn   423:         my ($anonsurv_subm,$randbytry_subm);
1.4       raeburn   424:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                    425:             my %responses = $res->responseTypes();
                    426:             foreach my $key (keys(%responses)) {
                    427:                 next unless(exists($checkresponsetypes{$key}));
                    428:                 $allresponses{$key} += $responses{$key};
                    429:             }
1.5       raeburn   430:             my @parts = @{$res->parts()};
                    431:             my $symb = $res->symb();
                    432:             foreach my $part (@parts) {
1.7       raeburn   433:                 if (exists($anonsubmissions{$symb."\0".$part})) {
1.5       raeburn   434:                     $anonsurv_subm = 1;
                    435:                 }
1.9       raeburn   436:                 if (exists($randomizetrysubm{$symb."\0".$part})) {
                    437:                     $randbytry_subm = 1;
                    438:                 }
1.5       raeburn   439:             }
1.4       raeburn   440:         }
                    441:         foreach my $key (keys(%allresponses)) {
                    442:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                    443:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                    444:         }
1.5       raeburn   445:         if ($anonsurv_subm) {
                    446:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($anonsurvey{major},
                    447:                                           $anonsurvey{minor},$reqdmajor,$reqdminor);
                    448:         }
1.9       raeburn   449:         if ($randbytry_subm) {
                    450:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($randomizetry{major},
                    451:                                           $randomizetry{minor},$reqdmajor,$reqdminor);
                    452:         }
1.4       raeburn   453:     }
                    454:     return ($reqdmajor,$reqdminor);
                    455: }
                    456: 
                    457: sub update_reqd_loncaparev {
                    458:     my ($major,$minor,$reqdmajor,$reqdminor) = @_;
                    459:     if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) {
                    460:         if ($reqdmajor eq '' || $reqdminor eq '') {
                    461:             $reqdmajor = $major;
                    462:             $reqdminor = $minor;
                    463:         } elsif (($major > $reqdmajor) ||
                    464:             ($major == $reqdmajor && $minor > $reqdminor))  {
                    465:             $reqdmajor = $major;
                    466:             $reqdminor = $minor;
                    467:         }
                    468:     }
                    469:     return ($reqdmajor,$reqdminor);
                    470: }
                    471: 
                    472: sub read_paramdata {
                    473:     my ($cnum,$dom)=@_;
                    474:     my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$dom);
                    475:     my $classlist=&Apache::loncoursedata::get_classlist();
                    476:     foreach my $student (keys(%{$classlist})) {
                    477:         if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
                    478:             my ($tuname,$tudom)=($1,$2);
                    479:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                    480:             foreach my $userkey (keys(%{$useropt})) {
                    481:                 if ($userkey=~/^$env{'request.course.id'}/) {
                    482:                     my $newkey=$userkey;
                    483:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                    484:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                    485:                 }
                    486:             }
                    487:          }
                    488:     }
                    489:     return $resourcedata;
                    490: }
1.2       raeburn   491: 

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