version 1.824.2.1, 2007/01/25 21:10:51
|
version 1.824.2.5, 2007/05/02 22:01:32
|
Line 990 my %remembered;
|
Line 990 my %remembered;
|
my %accessed; |
my %accessed; |
my $kicks=0; |
my $kicks=0; |
my $hits=0; |
my $hits=0; |
|
sub make_key { |
|
my ($name,$id) = @_; |
|
if (length($id) > 65 |
|
&& length(&escape($id)) > 200) { |
|
$id=length($id).':'.&Digest::MD5::md5_hex($id); |
|
} |
|
return &escape($name.':'.$id); |
|
} |
|
|
sub devalidate_cache_new { |
sub devalidate_cache_new { |
my ($name,$id,$debug) = @_; |
my ($name,$id,$debug) = @_; |
if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } |
if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } |
$id=&escape($name.':'.$id); |
$id=&make_key($name,$id); |
$memcache->delete($id); |
$memcache->delete($id); |
delete($remembered{$id}); |
delete($remembered{$id}); |
delete($accessed{$id}); |
delete($accessed{$id}); |
Line 1001 sub devalidate_cache_new {
|
Line 1010 sub devalidate_cache_new {
|
|
|
sub is_cached_new { |
sub is_cached_new { |
my ($name,$id,$debug) = @_; |
my ($name,$id,$debug) = @_; |
$id=&escape($name.':'.$id); |
$id=&make_key($name,$id); |
if (exists($remembered{$id})) { |
if (exists($remembered{$id})) { |
if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); } |
if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); } |
$accessed{$id}=[&gettimeofday()]; |
$accessed{$id}=[&gettimeofday()]; |
Line 1024 sub is_cached_new {
|
Line 1033 sub is_cached_new {
|
|
|
sub do_cache_new { |
sub do_cache_new { |
my ($name,$id,$value,$time,$debug) = @_; |
my ($name,$id,$value,$time,$debug) = @_; |
$id=&escape($name.':'.$id); |
$id=&make_key($name,$id); |
my $setvalue=$value; |
my $setvalue=$value; |
if (!defined($setvalue)) { |
if (!defined($setvalue)) { |
$setvalue='__undef__'; |
$setvalue='__undef__'; |
Line 1033 sub do_cache_new {
|
Line 1042 sub do_cache_new {
|
$time=600; |
$time=600; |
} |
} |
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } |
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } |
$memcache->set($id,$setvalue,$time); |
if (!($memcache->set($id,$setvalue,$time))) { |
|
&logthis("caching of id -> $id failed"); |
|
} |
# need to make a copy of $value |
# need to make a copy of $value |
#&make_room($id,$value,$debug); |
#&make_room($id,$value,$debug); |
return $value; |
return $value; |
Line 3455 sub get_portfolio_access {
|
Line 3466 sub get_portfolio_access {
|
} |
} |
if (@users > 0) { |
if (@users > 0) { |
foreach my $userkey (@users) { |
foreach my $userkey (@users) { |
if (exists($access_hash->{$userkey}{'users'}{$env{'user.name'}.':'.$env{'user.domain'}})) { |
if (ref($access_hash->{$userkey}{'users'}) eq 'ARRAY') { |
return 'ok'; |
foreach my $item (@{$access_hash->{$userkey}{'users'}}) { |
} |
if (ref($item) eq 'HASH') { |
|
if (($item->{'uname'} eq $env{'user.name'}) && |
|
($item->{'udom'} eq $env{'user.domain'})) { |
|
return 'ok'; |
|
} |
|
} |
|
} |
|
} |
} |
} |
} |
} |
my %roleshash; |
my %roleshash; |
Line 7167 sub repcopy_userfile {
|
Line 7185 sub repcopy_userfile {
|
} else { |
} else { |
my $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode); |
my $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode); |
if ($lwpresp ne 'ok') { |
if ($lwpresp ne 'ok') { |
my $ua=new LWP::UserAgent; |
return -1; |
my $request=new HTTP::Request('GET',&tokenwrapper($uri)); |
|
my $response=$ua->request($request); |
|
if ($response->is_success()) { |
|
$info=$response->content; |
|
} else { |
|
return -1; |
|
} |
|
} |
} |
my @parts = ($cdom,$cnum); |
my @parts = ($cdom,$cnum); |
if ($filename =~ m|^(.+)/[^/]+$|) { |
if ($filename =~ m|^(.+)/[^/]+$|) { |