--- loncom/lonnet/perl/lonnet.pm 2006/10/13 04:23:15 1.791 +++ loncom/lonnet/perl/lonnet.pm 2006/10/18 02:39:12 1.796 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.791 2006/10/13 04:23:15 raeburn Exp $ +# $Id: lonnet.pm,v 1.796 2006/10/18 02:39:12 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -413,17 +413,6 @@ sub delenv { return 'ok'; } -=pod - -=item * get_env_multiple($name) - -gets $name from the %env hash, it seemlessly handles the cases where multiple -values may be defined and end up as an array ref. - -returns an array of values - -=cut - sub get_env_multiple { my ($name) = @_; my @values; @@ -4217,13 +4206,14 @@ sub auto_photoupdate { } sub auto_instcode_format { - my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_; + my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles, + $cat_order) = @_; my $courses = ''; my @homeservers; if ($caller eq 'global') { - foreach my $tryserver (keys %libserv) { + foreach my $tryserver (keys(%libserv)) { if ($hostdom{$tryserver} eq $codedom) { - if (!grep/^\Q$tryserver\E$/,@homeservers) { + if (!grep(/^\Q$tryserver\E$/,@homeservers)) { push(@homeservers,$tryserver); } } @@ -4231,8 +4221,8 @@ sub auto_instcode_format { } else { push(@homeservers,&homeserver($caller,$codedom)); } - foreach (keys %{$instcodes}) { - $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&'; + foreach my $code (keys(%{$instcodes})) { + $courses .= &escape($code).'='.&escape($$instcodes{$code}).'&'; } chop($courses); my $ok_response = 0; @@ -4242,7 +4232,7 @@ sub auto_instcode_format { $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server); if ($response !~ /(con_lost|error|no_such_host|refused)/) { my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = - split/:/,$response; + split/:/,$response; %{$codes} = (%{$codes},&str2hash($codes_str)); push(@{$codetitles},&str2array($codetitles_str)); %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str)); @@ -4257,6 +4247,40 @@ sub auto_instcode_format { } } +sub auto_instcode_defaults { + my ($domain,$returnhash,$code_order) = @_; + my @homeservers; + foreach my $tryserver (keys(%libserv)) { + if ($hostdom{$tryserver} eq $domain) { + if (!grep(/^\Q$tryserver\E$/,@homeservers)) { + push(@homeservers,$tryserver); + } + } + } + my $ok_response = 0; + my $response; + while (@homeservers > 0 && $ok_response == 0) { + my $server = shift(@homeservers); + $response=&reply('autoinstcodedefaults:'.$domain,$server); + if ($response !~ /(con_lost|error|no_such_host|refused)/) { + foreach my $pair (split(/\&/,$response)) { + my ($name,$value)=split(/\=/,$pair); + if ($name eq 'code_order') { + @{$code_order} = split(/\&/,&unescape($value)); + } else { + $returnhash->{&unescape($name)}=&unescape($value); + } + } + } + $ok_response = 1; + } + if ($ok_response) { + return 'ok'; + } else { + return $response; + } +} + sub auto_validate_class_sec { my ($cdom,$cnum,$owner,$inst_class) = @_; my $homeserver = &homeserver($cnum,$cdom); @@ -7320,7 +7344,9 @@ sub get_iphost { } -$memcache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']}); +$memcache=new Cache::Memcached({'servers' => ['127.0.0.1:11211'], + 'compress_threshold'=> 20_000, + }); $processmarker='_'.time.'_'.$perlvar{'lonHostID'}; $dumpcount=0; @@ -7517,6 +7543,13 @@ B: removes all items fr environment file that matches the regular expression in $regexp. The values are also delted from the current processes %env. +=item * get_env_multiple($name) + +gets $name from the %env hash, it seemlessly handles the cases where multiple +values may be defined and end up as an array ref. + +returns an array of values + =back =head2 User Information