--- loncom/lonnet/perl/lonnet.pm 2009/10/24 03:24:25 1.1035 +++ loncom/lonnet/perl/lonnet.pm 2009/10/25 14:49:07 1.1036 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1035 2009/10/24 03:24:25 raeburn Exp $ +# $Id: lonnet.pm,v 1.1036 2009/10/25 14:49:07 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4842,7 +4842,7 @@ sub is_advanced_user { } sub check_can_request { - my ($dom,$can_request) = @_; + my ($dom,$can_request,$request_domains) = @_; my $canreq = 0; my ($types,$typename) = &Apache::loncommon::course_types(); my @options = ('approval','validate','autolimit'); @@ -4853,6 +4853,9 @@ sub check_can_request { $env{'user.domain'}, $type,undef,'requestcourses')) { $canreq ++; + if (ref($request_domains) eq 'HASH') { + push(@{$request_domains->{$type}},$env{'user.domain'}); + } if ($dom eq $env{'user.domain'}) { $can_request->{$type} = 1; } @@ -4860,8 +4863,22 @@ sub check_can_request { if ($env{'environment.reqcrsotherdom.'.$type} ne '') { my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type}); if (@curr > 0) { - $canreq ++; - unless ($dom eq $env{'user.domain'}) { + foreach my $item (@curr) { + if (ref($request_domains) eq 'HASH') { + my ($otherdom) = ($item =~ /^($match_domain):($optregex)(=?\d*)$/); + if ($otherdom ne '') { + if (ref($request_domains->{$type}) eq 'ARRAY') { + unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) { + push(@{$request_domains->{$type}},$otherdom); + } + } else { + push(@{$request_domains->{$type}},$otherdom); + } + } + } + } + unless($dom eq $env{'user.domain'}) { + $canreq ++; if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) { $can_request->{$type} = 1; }