--- loncom/lonnet/perl/lonnet.pm	2009/10/23 00:20:40	1.1034
+++ 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.1034 2009/10/23 00:20:40 raeburn Exp $
+# $Id: lonnet.pm,v 1.1036 2009/10/25 14:49:07 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4841,6 +4841,55 @@ sub is_advanced_user {
     return $is_adv;
 }
 
+sub check_can_request {
+    my ($dom,$can_request,$request_domains) = @_;
+    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 (ref($request_domains) eq 'HASH') {
+                    push(@{$request_domains->{$type}},$env{'user.domain'});
+                }
+                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) {
+                    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;
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return $canreq;
+}
+
 # ---------------------------------------------- Custom access rule evaluation
 
 sub customaccess {