--- loncom/lonnet/perl/lonnet.pm 2009/10/24 03:24:25 1.1035 +++ loncom/lonnet/perl/lonnet.pm 2009/10/29 03:23:58 1.1038 @@ -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.1038 2009/10/29 03:23:58 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; } @@ -6073,24 +6090,31 @@ sub plaintext { if (!defined($cid)) { $cid = $env{'request.course.id'}; } - if (defined($cid) && ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '')) { - unless ($forcedefault) { - my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'}; - &Apache::lonlocal::mt_escape(\$roletext); - return &Apache::lonlocal::mt($roletext); - } - } my %rolenames = ( Course => 'std', Community => 'alt1', ); - if (defined($type) && - defined($rolenames{$type}) && - defined($prp{$short}{$rolenames{$type}})) { + if ($cid ne '') { + if ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '') { + unless ($forcedefault) { + my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'}; + &Apache::lonlocal::mt_escape(\$roletext); + return &Apache::lonlocal::mt($roletext); + } + } + } + if ((defined($type)) && (defined($rolenames{$type})) && + (defined($rolenames{$type})) && + (defined($prp{$short}{$rolenames{$type}}))) { return &Apache::lonlocal::mt($prp{$short}{$rolenames{$type}}); - } else { - return &Apache::lonlocal::mt($prp{$short}{'std'}); + } elsif ($cid ne '') { + my $crstype = $env{'course.'.$cid.'.type'}; + if (($crstype ne '') && (defined($rolenames{$crstype})) && + (defined($prp{$short}{$rolenames{$crstype}}))) { + return &Apache::lonlocal::mt($prp{$short}{$rolenames{$crstype}}); + } } + return &Apache::lonlocal::mt($prp{$short}{'std'}); } # ----------------------------------------------------------------- Assign Role @@ -6530,10 +6554,10 @@ sub createcourse { if (($chome eq '') || ($chome eq 'no_host')) { $uname = $cnum; } else { - $uname = &generate_coursenum($udom); + $uname = &generate_coursenum($udom,$crstype); } } else { - $uname = &generate_coursenum($udom); + $uname = &generate_coursenum($udom,$crstype); } return $uname if ($uname =~ /^error/); # -------------------------------------------------- Check supplied server name @@ -6593,17 +6617,28 @@ ENDINITMAP # ------------------------------------------------------------------- Create ID sub generate_coursenum { - my ($udom) = @_; + my ($udom,$crstype) = @_; my $domdesc = &domain($udom); return 'error: invalid domain' if ($domdesc eq ''); - my $uname=int(1+rand(9)). + my $first; + if ($crstype eq 'Community') { + $first = '0'; + } else { + $first = int(1+rand(9)); + } + my $uname=$first. ('a'..'z','A'..'Z','0'..'9')[int(rand(62))]. substr($$.time,0,5).unpack("H8",pack("I32",time)). unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'}; # ----------------------------------------------- Make sure that does not exist my $uhome=&homeserver($uname,$udom,'true'); unless (($uhome eq '') || ($uhome eq 'no_host')) { - $uname=int(1+rand(9)). + if ($crstype eq 'Community') { + $first = '0'; + } else { + $first = int(1+rand(9)); + } + $uname=$first. ('a'..'z','A'..'Z','0'..'9')[int(rand(62))]. substr($$.time,0,5).unpack("H8",pack("I32",time)). unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'}; @@ -10187,7 +10222,7 @@ createcourse($udom,$description,$url,$co =item * -generate_coursenum($udom) : get a unique (unused) course number in domain $udom +generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community). =back