--- loncom/lonnet/perl/lonnet.pm 2006/10/16 19:18:15 1.792 +++ loncom/lonnet/perl/lonnet.pm 2006/10/19 21:23:23 1.797 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.792 2006/10/16 19:18:15 raeburn Exp $ +# $Id: lonnet.pm,v 1.797 2006/10/19 21:23:23 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)); @@ -4260,9 +4250,9 @@ sub auto_instcode_format { sub auto_instcode_defaults { my ($domain,$returnhash,$code_order) = @_; my @homeservers; - foreach my $tryserver (keys %libserv) { + foreach my $tryserver (keys(%libserv)) { if ($hostdom{$tryserver} eq $domain) { - if (!grep/^\Q$tryserver\E$/,@homeservers) { + if (!grep(/^\Q$tryserver\E$/,@homeservers)) { push(@homeservers,$tryserver); } } @@ -4273,12 +4263,12 @@ sub auto_instcode_defaults { my $server = shift(@homeservers); $response=&reply('autoinstcodedefaults:'.$domain,$server); if ($response !~ /(con_lost|error|no_such_host|refused)/) { - foreach (split(/\&/,$response)) { - my ($name,$value)=split(/\=/,$_); + 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); + $returnhash->{&unescape($name)}=&unescape($value); } } } @@ -5036,8 +5026,13 @@ sub modify_access_controls { for (my $i=0; $i<$numnew; $i++) { my $newkey = $newitems[$i]; my $newid = &Apache::loncommon::get_cgi_id(); - $newkey =~ s/^(\d+)/$newid/; - $translation{$1} = $newid; + if ($newkey =~ /^\d+:/) { + $newkey =~ s/^(\d+)/$newid/; + $translation{$1} = $newid; + } elsif ($newkey =~ /^\d+_\d+_\d+:/) { + $newkey =~ s/^(\d+_\d+_\d+)/$newid/; + $translation{$1} = $newid; + } $new_values{$file_name."\0".$newkey} = $$changes{'activate'}{$newitems[$i]}; $new_control{$newkey} = $now; @@ -7354,7 +7349,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; @@ -7551,6 +7548,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