--- loncom/lond 2010/08/18 19:25:09 1.452 +++ loncom/lond 2010/08/22 03:44:12 1.453 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.452 2010/08/18 19:25:09 raeburn Exp $ +# $Id: lond,v 1.453 2010/08/22 03:44:12 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -58,7 +58,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.452 $'; #' stupid emacs +my $VERSION='$Revision: 1.453 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -3175,40 +3175,26 @@ sub dump_with_regexp { $clientcheckrole = $extra->{'clientcheckrole'}; } my @ids = &Apache::lonnet::current_machine_ids(); + my (%homecourses,$major,$minor,$now); + if (($namespace eq 'roles') && (!$clientcheckrole)) { + my $loncaparev = $clientversion; + if ($loncaparev eq '') { + $loncaparev = $Apache::lonnet::loncaparevs{$clientname}; + } + if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) { + $major = $1; + $minor = $2; + } + $now = time; + } while (my ($key,$value) = each(%$hashref)) { if ($namespace eq 'roles') { - if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)_(cc|co|in|ta|ep|ad|st|cr)}) { + if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) { my $cdom = $1; my $cnum = $2; unless ($clientcheckrole) { - my $home = &Apache::lonnet::homeserver($cnum,$cdom); - my $loncaparev = $clientversion; - if ($loncaparev eq '') { - $loncaparev = $Apache::lonnet::loncaparevs{$clientname}; - } - my ($major,$minor); - if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) { - $major = $1; - $minor = $2; - } - if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(co|in|ta|ep|ad|st|cr)}) { - if ($major eq '' && $minor eq '') { - next unless (($home ne 'no_host') && grep(/^\Q$home\E$/,@ids)); - } - } - unless ($home eq 'no_host') { - my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); - if (ref($courseinfo) eq 'HASH') { - if (exists($courseinfo->{'releaserequired'})) { - my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); - if ($reqdmajor ne '' && $reqdminor ne '') { - next if (($major eq '' && $minor eq '') || - ($major < $reqdmajor) || - (($major == $reqdmajor) && ($minor < $reqdminor))); - } - } - } - } + next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor, + $now,\%homecourses,\@ids)); } } } @@ -3228,6 +3214,12 @@ sub dump_with_regexp { } } if (&untie_user_hash($hashref)) { + if (($namespace eq 'roles') && (!$clientcheckrole)) { + if (keys(%homecourses) > 0) { + $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count, + $range,$start,$end,$major,$minor); + } + } chop($qresult); &Reply($client, \$qresult, $userinput); } else { @@ -7302,21 +7294,136 @@ sub get_usersession_config { return; } +sub releasereqd_check { + my ($cnum,$cdom,$key,$value,$major,$minor,$now,$homecourses,$ids) = @_; + my $home = &Apache::lonnet::homeserver($cnum,$cdom); + return if ($home eq 'no_host'); + my ($reqdmajor,$reqdminor,$displayrole); + if ($cnum =~ /$LONCAPA::match_community/) { + if ($major eq '' && $minor eq '') { + return unless ((ref($ids) eq 'ARRAY') && + (grep(/^\Q$home\E$/,@{$ids}))); + } else { + $reqdmajor = 2; + $reqdminor = 9; + return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); + } + } + my ($role,$end,$start) = split(/_/,$value); + if (!$end || $end > $now) { + my $hashid = $cdom.':'.$cnum; + my ($courseinfo,$cached) = + &Apache::lonnet::is_cached_new('courseinfo',$hashid); + if (defined($cached)) { + if (ref($courseinfo) eq 'HASH') { + if (exists($courseinfo->{'releaserequired'})) { + my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); + return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); + } + } + } else { + if (ref($ids) eq 'ARRAY') { + if (grep(/^\Q$home\E$/,@{$ids})) { + if (ref($homecourses) eq 'HASH') { + if (ref($homecourses->{$hashid}) eq 'ARRAY') { + push(@{$homecourses->{$hashid}},{$key=>$value}); + } else { + $homecourses->{$hashid} = [{$key=>$value}]; + } + } + return; + } + } + my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); + if (ref($courseinfo) eq 'HASH') { + if (exists($courseinfo->{'releaserequired'})) { + my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); + return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); + } + } + } + } + return 1; +} + sub get_courseinfo_hash { my ($cnum,$cdom,$home) = @_; my $hashid = $cdom.':'.$cnum; - my ($courseinfo,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid); - if (defined($cached)) { - return $courseinfo; - } else { - my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.'); - if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { - return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600); - } + my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.'); + if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { + return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600); } return; } +sub check_homecourses { + my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_; + my ($result,%addtocache); + if (ref($homecourses) eq 'HASH') { + my %okcourses; + my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); + if ($hashref) { + while (my ($key,$value) = each(%$hashref)) { + my $unesc_key = &unescape($key); + next if ($unesc_key =~ /^lasttime:/); + my $items = &Apache::lonnet::thaw_unescape($value); + if (ref($items) eq 'HASH') { + my $hashid = $unesc_key; + $hashid =~ s/_/:/; + &Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600); + if (ref($homecourses->{$hashid}) eq 'ARRAY') { + my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'}); + if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) { + $okcourses{$hashid} = 1; + } + } + } + } + unless (&untie_domain_hash($hashref)) { + &logthis('Failed to untie tied hash for nohist_courseids.db'); + } + } else { + &logthis('Failed to tie hash for nohist_courseids.db'); + return; + } + foreach my $hashid (keys(%okcourses)) { + if (ref($homecourses->{$hashid}) eq 'ARRAY') { + foreach my $role (@{$homecourses->{$hashid}}) { + if (ref($role) eq 'HASH') { + while (my ($key,$value) = each(%{$role})) { + if ($regexp eq '.') { + $count++; + if (defined($range) && $count >= $end) { last; } + if (defined($range) && $count < $start) { next; } + $result.=$key.'='.$value.'&'; + } else { + my $unescapeKey = &unescape($key); + if (eval('$unescapeKey=~/$regexp/')) { + $count++; + if (defined($range) && $count >= $end) { last; } + if (defined($range) && $count < $start) { next; } + $result.="$key=$value&"; + } + } + } + } + } + } + } + } + return $result; +} + +sub useable_role { + my ($reqdmajor,$reqdminor,$major,$minor) = @_; + if ($reqdmajor ne '' && $reqdminor ne '') { + return if (($major eq '' && $minor eq '') || + ($major < $reqdmajor) || + (($major == $reqdmajor) && ($minor < $reqdminor))); + } + return 1; +} + # ----------------------------------- POD (plain old documentation, CPAN style) =head1 NAME