--- loncom/lonnet/perl/lonnet.pm 2006/10/16 19:39:57 1.793 +++ loncom/lonnet/perl/lonnet.pm 2006/10/23 21:22:44 1.799 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.793 2006/10/16 19:39:57 albertel Exp $ +# $Id: lonnet.pm,v 1.799 2006/10/23 21:22:44 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; @@ -547,10 +536,10 @@ sub compare_server_load { # --------------------------------------------- Try to change a user's password sub changepass { - my ($uname,$udom,$currentpass,$newpass,$server)=@_; + my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_; $currentpass = &escape($currentpass); $newpass = &escape($newpass); - my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass", + my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context", $server); if (! $answer) { &logthis("No reply on password change request to $server ". @@ -1647,7 +1636,14 @@ sub removeuploadedurl { sub removeuserfile { my ($docuname,$docudom,$fname)=@_; my $home=&homeserver($docuname,$docudom); - return &reply("removeuserfile:$docudom/$docuname/$fname",$home); + my $result = &reply("removeuserfile:$docudom/$docuname/$fname",$home); + if ($result eq 'ok') { + if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) { + my $metafile = $fname.'.meta'; + my $metaresult = &removeuserfile($docuname,$docudom,$metafile); + } + } + return $result; } sub mkdiruserfile { @@ -1659,8 +1655,17 @@ sub mkdiruserfile { sub renameuserfile { my ($docuname,$docudom,$old,$new)=@_; my $home=&homeserver($docuname,$docudom); - return &reply("renameuserfile:$docudom:$docuname:".&escape("$old").':'. - &escape("$new"),$home); + my $result = &reply("renameuserfile:$docudom:$docuname:". + &escape("$old").':'.&escape("$new"),$home); + if ($result eq 'ok') { + if (($old !~ /\.meta$/) && (&is_portfolio_file($old))) { + my $oldmeta = $old.'.meta'; + my $newmeta = $new.'.meta'; + my $metaresult = + &renameuserfile($docuname,$docudom,$oldmeta,$newmeta); + } + } + return $result; } # ------------------------------------------------------------------------- Log @@ -3455,6 +3460,15 @@ sub is_portfolio_url { return scalar(&parse_portfolio_url($url)); } +sub is_portfolio_file { + my ($file) = @_; + if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w+\/portfolio/)) { + return 1; + } + return; +} + + # ---------------------------------------------- Custom access rule evaluation sub customaccess { @@ -4277,9 +4291,9 @@ sub auto_instcode_defaults { foreach my $pair (split(/\&/,$response)) { my ($name,$value)=split(/\=/,$pair); if ($name eq 'code_order') { - $code_order = [split(/\&/,&unescape($value))]; + @{$code_order} = split(/\&/,&unescape($value)); } else { - $$returnhash{&unescape($name)}=&unescape($value); + $returnhash->{&unescape($name)}=&unescape($value); } } } @@ -5037,8 +5051,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; @@ -7355,7 +7374,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; @@ -7552,6 +7573,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