--- loncom/lonnet/perl/lonnet.pm 2011/07/04 09:25:06 1.1117 +++ loncom/lonnet/perl/lonnet.pm 2011/07/31 22:55:53 1.1121 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1117 2011/07/04 09:25:06 foxr Exp $ +# $Id: lonnet.pm,v 1.1121 2011/07/31 22:55:53 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -306,6 +306,44 @@ sub get_server_homeID { return &do_cache_new('serverhomeID',$hostname,$serverhomeID,$cachetime); } +sub get_remote_globals { + my ($lonhost,$whathash,$ignore_cache) = @_; + my (%returnhash,%whatneeded); + if (ref($whathash) eq 'ARRAY') { + foreach my $what (sort(keys(%{$whathash}))) { + my $type = $whathash->{$what}; + my $hashid = $lonhost.'-'.$what; + my ($result,$cached); + unless ($ignore_cache) { + ($result,$cached)=&is_cached_new('lonnetglobal',$hashid); + $returnhash{$what} = $result; + } + if (defined($cached)) { + $returnhash{$what} = $result; + } else { + $whatneeded{$what} = $type; + } + } + if (keys(%whatneeded) > 0) { + my $requested = &freeze_escape(\%whatneeded); + my $rep=&reply('readlonnetglobal:'.$requested,$lonhost); + unless (($rep=~/^refused/) || ($rep=~/^rejected/) || $rep eq 'con_lost')) { + my @pairs=split(/\&/,$rep); + if ($rep !~ /^error/) { + foreach my $item (@pairs) { + my ($key,$value)=split(/=/,$item,2); + my $what = &unescape($key); + my $hashid = $lonhost.'-'.$what; + $returnhash{$what}=&thaw_unescape($value); + &do_cache_new('lonnetglobal',$hashid,$returnhash{$what},600); + } + } + } + } + } + return %returnhash; +} + # -------------------------------------------------- Non-critical communication sub subreply { my ($cmd,$server)=@_; @@ -1035,15 +1073,19 @@ sub can_host_session { } if ($canhost) { if (ref($hostedsessions) eq 'HASH') { + my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); + my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id); if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') { - if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'excludedomain'}})) { + if (($uint_dom ne '') && + (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) { $canhost = 0; } else { $canhost = 1; } } if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') { - if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'includedomain'}})) { + if (($uint_dom ne '') && + (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'includedomain'}}))) { $canhost = 1; } else { $canhost = 0; @@ -3998,6 +4040,8 @@ sub restore { } # ---------------------------------------------------------- Course Description +# +# sub coursedescription { my ($courseid,$args)=@_; @@ -4027,7 +4071,8 @@ sub coursedescription { return %returnhash; } - # get the data agin + # get the data again + if (!$args->{'one_time'}) { $envhash{'course.'.$normalid.'.last_cache'}=time; } @@ -4035,6 +4080,10 @@ sub coursedescription { if ($chome ne 'no_host') { %returnhash=&dump('environment',$cdomain,$cnum); if (!exists($returnhash{'con_lost'})) { + my $username = $env{'user.name'}; # Defult username + if(defined $args->{'user'}) { + $username = $args->{'user'}; + } $returnhash{'home'}= $chome; $returnhash{'domain'} = $cdomain; $returnhash{'num'} = $cnum; @@ -4046,7 +4095,7 @@ sub coursedescription { } $returnhash{'url'}=&clutter($returnhash{'url'}); $returnhash{'fn'}=LONCAPA::tempdir() . - $env{'user.name'}.'_'.$cdomain.'_'.$cnum; + $username.'_'.$cdomain.'_'.$cnum; $envhash{'course.'.$normalid.'.home'}=$chome; $envhash{'course.'.$normalid.'.domain'}=$cdomain; $envhash{'course.'.$normalid.'.num'}=$cnum; @@ -11038,11 +11087,32 @@ revokecustomrole($udom,$uname,$url,$role =item * -coursedescription($courseid) : returns a hash of information about the +coursedescription($courseid,$options) : returns a hash of information about the specified course id, including all environment settings for the course, the description of the course will be in the hash under the key 'description' +$options is an optional parameter that if supplied is a hash reference that controls +what how this function works. It has the following key/values: + +=over 4 + +=item freshen_cache + +If defined, and the environment cache for the course is valid, it is +returned in the returned hash. + +=item one_time + +If defined, the last cache time is set to _now_ + +=item user + +If defined, the supplied username is used instead of the current user. + + +=back + =item * resdata($name,$domain,$type,@which) : request for current parameter @@ -11435,11 +11505,12 @@ splitting on '&', supports elements that =head2 Logging Routines -=over 4 These routines allow one to make log messages in the lonnet.log and lonnet.perm logfiles. +=over 4 + =item * logtouch() : make sure the logfile, lonnet.log, exists @@ -11455,6 +11526,7 @@ logperm() : append a permanent message t file never gets deleted by any automated portion of the system, only messages of critical importance should go in here. + =back =head2 General File Helper Routines