--- loncom/misc/refresh_courseids_db.pl 2010/03/14 23:17:54 1.1 +++ loncom/misc/refresh_courseids_db.pl 2010/08/22 21:14:54 1.8 @@ -1,7 +1,7 @@ #!/usr/bin/perl # The LearningOnline Network # -# $Id: refresh_courseids_db.pl,v 1.1 2010/03/14 23:17:54 raeburn Exp $ +# $Id: refresh_courseids_db.pl,v 1.8 2010/08/22 21:14:54 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -54,10 +54,15 @@ use strict; use lib '/home/httpd/lib/perl/'; use Apache::lonnet; use Apache::loncommon; +use Apache::lonuserstate; +use Apache::loncoursedata; +use Apache::lonnavmaps; use LONCAPA qw(:DEFAULT :match); exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); +use vars qw( %checkparms %checkresponsetypes %checkcrstypes %anonsurvey ); + # Make sure this process is running from user=www my $wwwid=getpwnam('www'); if ($wwwid!=$<) { @@ -73,12 +78,19 @@ open(my $fh,'>>'.$Apache::lonnet::perlva print $fh "==== refresh_courseids_db.pl Run ".localtime()."====\n"; my @domains = sort(&Apache::lonnet::current_machine_domains()); +my @ids=&Apache::lonnet::current_machine_ids(); + +&build_release_hashes(); +$env{'allowed.bre'} = 'F'; + foreach my $dom (@domains) { my %courseshash; - my @ids=&Apache::lonnet::current_machine_ids(); my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.'); + my %lastaccess = &Apache::lonnet::courselastaccess($dom,undef,\@ids); my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom; - &recurse_courses($dom,$dir,0,\%courseshash,\%currhash,$fh); + my %domdesign = &Apache::loncommon::get_domainconf($dom); + my $autoassign = $domdesign{$dom.'.autoassign.co-owners'}; + &recurse_courses($dom,$dir,0,\%courseshash,\%currhash,\%lastaccess,$autoassign,$fh); foreach my $lonhost (keys(%courseshash)) { if (ref($courseshash{$lonhost}) eq 'HASH') { if (&Apache::lonnet::courseidput($dom,$courseshash{$lonhost},$lonhost,'notime') eq 'ok') { @@ -90,12 +102,14 @@ foreach my $dom (@domains) { } } +delete($env{'allowed.bre'}); + ## Finished! print $fh "==== refresh_courseids.db completed ".localtime()." ====\n"; close($fh); sub recurse_courses { - my ($cdom,$dir,$depth,$courseshash,$currhash,$fh) = @_; + my ($cdom,$dir,$depth,$courseshash,$currhash,$lastaccess,$autoassign,$fh) = @_; next unless (ref($currhash) eq 'HASH'); if (-d $dir) { opendir(DIR,$dir); @@ -104,7 +118,8 @@ sub recurse_courses { $depth ++; foreach my $item (@contents) { if ($depth < 4) { - &recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash,$currhash,$fh); + &recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash, + $currhash,$lastaccess,$autoassign,$fh); } elsif ($item =~ /^$match_courseid$/) { my $cnum = $item; my $cid = $cdom.'_'.$cnum; @@ -137,8 +152,11 @@ sub recurse_courses { } my $chome = &Apache::lonnet::homeserver($cnum,$cdom); my $owner = $courseinfo{'internal.courseowner'}; + my $twodaysago = time - 172800; + my (%roleshash,$gotcc,$reqdmajor,$reqdminor); if ($owner eq '') { - my %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1); + %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1); + $gotcc = 1; if (keys(%roleshash) == 1) { foreach my $key (keys(%roleshash)) { if ($key =~ /^($match_username\:$match_domain)\:cc$/) { @@ -160,14 +178,14 @@ sub recurse_courses { my $creator = $courseinfo{'internal.creator'}; my $creationcontext = $courseinfo{'internal.creationcontext'}; my $inst_code = $courseinfo{'internal.coursecode'}; + my $releaserequired = $courseinfo{'internal.releaserequired'}; $inst_code = '' if (!defined($inst_code)); $owner = '' if (!defined($owner)); if ($created eq '') { - my %currdump = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.'); - if (ref($currdump{$cid}) eq 'HASH') { - $created = $currdump{$cid}{'created'}; - $creator = $currdump{$cid}{'creator'}; - $creationcontext = $currdump{$cid}{'context'}; + if (ref($currhash->{$cid}) eq 'HASH') { + $created = $currhash->{$cid}{'created'}; + $creator = $currhash->{$cid}{'creator'}; + $creationcontext = $currhash->{$cid}{'context'}; unless ($created eq '') { $changes{'internal.created'} = $created; } @@ -183,13 +201,11 @@ sub recurse_courses { my @stats = stat("$dir/$cnum/passwd"); $created = $stats[9]; } - my %lastaccess = - &Apache::lonnet::courselastaccess($cdom,$cnum); - if ($lastaccess{$cid}) { + if ($lastaccess->{$cid}) { if ($created eq '') { - $created = $lastaccess{$cid}; - } elsif ($lastaccess{$cid} < $created) { - $created = $lastaccess{$cid}; + $created = $lastaccess->{$cid}; + } elsif ($lastaccess->{$cid} < $created) { + $created = $lastaccess->{$cid}; } } unless ($created eq '') { @@ -197,6 +213,29 @@ sub recurse_courses { } } } + + if (($chome ne '') && ($lastaccess->{$cid} > $twodaysago)) { + $env{'request.course.id'} = $cdom.'_'.$cnum; + $env{'request.role'} = 'cc./'.$cdom.'/'.$cnum; + &Apache::lonuserstate::readmap($cdom.'/'.$cnum); + + # check all parameters + ($reqdmajor,$reqdminor) = ¶meter_constraints($cnum,$cdom); + + # check course type + ($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype, + $reqdmajor, + $reqdminor); + # check course contents + ($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom, + $reqdmajor, + $reqdminor); + delete($env{'request.course.id'}); + delete($env{'request.role'}); + } elsif ($releaserequired) { + ($reqdmajor,$reqdminor) = split(/\./,$releaserequired); + } + unless ($chome eq 'no_host') { $courseshash->{$chome}{$cid} = { description => $courseinfo{'description'}, @@ -204,9 +243,6 @@ sub recurse_courses { owner => $owner, type => $crstype, }; - if ($courseinfo{'internal.co-owners'} ne '') { - $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'}; - } if ($creator ne '') { $courseshash->{$chome}{$cid}{'creator'} = $creator; } @@ -216,21 +252,221 @@ sub recurse_courses { if ($creationcontext ne '') { $courseshash->{$chome}{$cid}{'context'} = $creationcontext; } + if (($inst_code ne '') && ($autoassign)) { + unless ($gotcc) { + %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1); + } + my @currcoowners; + my @newcoowners; + if ($courseinfo{'internal.co-owners'} ne '') { + @currcoowners = split(',',$courseinfo{'internal.co-owners'}); + } + foreach my $key (keys(%roleshash)) { + if ($key =~ /^($match_username\:$match_domain)\:cc$/) { + my $cc = $1; + unless ($cc eq $owner) { + my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc); + if ($result eq 'valid') { + if (@newcoowners > 0) { + unless (grep(/^\Q$cc\E$/,@newcoowners)) { + push(@newcoowners,$cc); + } + } else { + push(@newcoowners,$cc); + } + } + } + } + } + my @diffs = &Apache::loncommon::compare_arrays(\@currcoowners,\@newcoowners); + if (@diffs > 0) { + if (@newcoowners > 0) { + $changes{'internal.co-owners'} = join(',',@newcoowners); + $courseshash->{$chome}{$cid}{'co-owners'} = $changes{'internal.co-owners'}; + } else { + if ($courseinfo{'internal.co-owners'} ne '') { + if (&Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum) eq 'ok') { + 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"; + } + } else { + print $fh "Error occurred when updating co-ownership in course's environment.db for ".$cdom."_".$cnum."\n"; + } + } + } elsif (@currcoowners > 0) { + $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'}; + } + } elsif ($courseinfo{'internal.co-owners'} ne '') { + $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'}; + } + foreach my $item ('categories','cloners','hidefromcat') { + if ($courseinfo{$item} ne '') { + $courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; + } + } + foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date') { + if ($courseinfo{'internal.'.$item} ne '') { + $courseshash->{$chome}{$cid}{$item} = + $courseinfo{'internal.'.$item}; + } + } + if ($reqdmajor eq '' && $reqdminor eq '') { + if ($courseinfo{'internal.releaserequired'} ne '') { + $changes{'internal.releaserequired'} = ''; + } + } else { + my $releasereq = $reqdmajor.'.'.$reqdminor; + $courseshash->{$chome}{$cid}{'releaserequired'} = $releasereq; + if ($courseinfo{'internal.releaserequired'} eq '') { + $changes{'internal.releaserequired'} = $releasereq; + } else { + if ($courseinfo{'internal.releaserequired'} ne $releasereq) { + + $changes{'internal.releaserequired'} = $releasereq; + } + } + } if (keys(%changes)) { - if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') { - print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: "; - foreach my $key (sort(keys(%changes))) { - print $fh "$key => $changes{$key} "; - } - print $fh "\n"; - } else { - print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n"; - } + if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') { + print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: "; + foreach my $key (sort(keys(%changes))) { + print $fh "$key => $changes{$key} "; + } + print $fh "\n"; + } else { + print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n"; + } + } + } + } + } + } + return; +} + +sub parameter_constraints { + my ($cnum,$cdom) = @_; + my ($reqdmajor,$reqdminor); + my $resourcedata=&read_paramdata($cnum,$cdom); + if (ref($resourcedata) eq 'HASH') { + foreach my $key (keys(%{$resourcedata})) { + foreach my $item (keys(%checkparms)) { + if ($key =~ /(\Q$item\E)$/) { + if (ref($checkparms{$item}) eq 'ARRAY') { + my $value = $resourcedata->{$key}; + if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) { + my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value}); + ($reqdmajor,$reqdminor) = + &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor); + } } } } } } + return ($reqdmajor,$reqdminor); +} + +sub coursetype_constraints { + my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_; + if (defined($checkcrstypes{$crstype})) { + my ($major,$minor) = split(/\./,$checkcrstypes{$crstype}); + ($reqdmajor,$reqdminor) = + &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor); + } + return ($reqdmajor,$reqdminor); +} + +sub coursecontent_constraints { + my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_; + my $navmap = Apache::lonnavmaps::navmap->new(); + if (defined($navmap)) { + my %anonsubmissions = &Apache::lonnet::dump('nohist_anonsurveys', + $cdom,$cnum); + my %allresponses; + my $anonsurv_subm; + foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) { + my %responses = $res->responseTypes(); + foreach my $key (keys(%responses)) { + next unless(exists($checkresponsetypes{$key})); + $allresponses{$key} += $responses{$key}; + } + my @parts = @{$res->parts()}; + my $symb = $res->symb(); + foreach my $part (@parts) { + if (exists($anonsubmissions{$symb."\0".$part})) { + $anonsurv_subm = 1; + } + } + } + foreach my $key (keys(%allresponses)) { + my ($major,$minor) = split(/\./,$checkresponsetypes{$key}); + ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor); + } + if ($anonsurv_subm) { + ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($anonsurvey{major}, + $anonsurvey{minor},$reqdmajor,$reqdminor); + } + } + return ($reqdmajor,$reqdminor); +} + +sub update_reqd_loncaparev { + my ($major,$minor,$reqdmajor,$reqdminor) = @_; + if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) { + if ($reqdmajor eq '' || $reqdminor eq '') { + $reqdmajor = $major; + $reqdminor = $minor; + } elsif (($major > $reqdmajor) || + ($major == $reqdmajor && $minor > $reqdminor)) { + $reqdmajor = $major; + $reqdminor = $minor; + } + } + return ($reqdmajor,$reqdminor); +} + +sub read_paramdata { + my ($cnum,$dom)=@_; + my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$dom); + my $classlist=&Apache::loncoursedata::get_classlist(); + foreach my $student (keys(%{$classlist})) { + if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) { + my ($tuname,$tudom)=($1,$2); + my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom); + foreach my $userkey (keys(%{$useropt})) { + if ($userkey=~/^$env{'request.course.id'}/) { + my $newkey=$userkey; + $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./; + $$resourcedata{$newkey}=$$useropt{$userkey}; + } + } + } + } + return $resourcedata; +} + +sub build_release_hashes { + foreach my $key (keys(%Apache::lonnet::needsrelease)) { + my ($item,$name,$value) = split(/:/,$key); + if ($item eq 'parameter') { + if (ref($checkparms{$name}) eq 'ARRAY') { + unless(grep(/^\Q$name\E$/,@{$checkparms{$name}})) { + push(@{$checkparms{$name}},$value); + } + } else { + push(@{$checkparms{$name}},$value); + } + } elsif ($item eq 'resourcetag') { + if ($name eq 'responsetype') { + $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key} + } + } elsif ($item eq 'course') { + if ($name eq 'crstype') { + $checkcrstypes{$value} = $Apache::lonnet::needsrelease{$key}; + } + } + } + ($anonsurvey{major},$anonsurvey{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'}); return; }