--- loncom/lonnet/perl/lonnet.pm 2009/10/23 00:20:40 1.1034 +++ loncom/lonnet/perl/lonnet.pm 2009/10/24 03:24:25 1.1035 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1034 2009/10/23 00:20:40 raeburn Exp $ +# $Id: lonnet.pm,v 1.1035 2009/10/24 03:24:25 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4841,6 +4841,38 @@ sub is_advanced_user { return $is_adv; } +sub check_can_request { + my ($dom,$can_request) = @_; + my $canreq = 0; + my ($types,$typename) = &Apache::loncommon::course_types(); + my @options = ('approval','validate','autolimit'); + my $optregex = join('|',@options); + if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) { + foreach my $type (@{$types}) { + if (&usertools_access($env{'user.name'}, + $env{'user.domain'}, + $type,undef,'requestcourses')) { + $canreq ++; + if ($dom eq $env{'user.domain'}) { + $can_request->{$type} = 1; + } + } + if ($env{'environment.reqcrsotherdom.'.$type} ne '') { + my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type}); + if (@curr > 0) { + $canreq ++; + unless ($dom eq $env{'user.domain'}) { + if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) { + $can_request->{$type} = 1; + } + } + } + } + } + } + return $canreq; +} + # ---------------------------------------------- Custom access rule evaluation sub customaccess {