[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.545.2.1 and 1.545.2.2

version 1.545.2.1, 2004/09/22 18:31:12 version 1.545.2.2, 2004/10/12 20:26:48
Line 116  sub logperm { Line 116  sub logperm {
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
 sub subreply {  sub subreply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
       my $t0_f=[&Time::HiRes::gettimeofday()];
     my $peerfile="$perlvar{'lonSockDir'}/$server";      my $peerfile="$perlvar{'lonSockDir'}/$server";
     my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",      my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                      Type    => SOCK_STREAM,                                       Type    => SOCK_STREAM,
Line 125  sub subreply { Line 126  sub subreply {
     my $answer=<$client>;      my $answer=<$client>;
     if (!$answer) { $answer="con_lost"; }      if (!$answer) { $answer="con_lost"; }
     chomp($answer);      chomp($answer);
       my $td=&Time::HiRes::tv_interval($t0_f);
       &Apache::lonnet::logthis("\n $td seconds for $cmd");
     return $answer;      return $answer;
 }  }
   
Line 1012  EVALBLOCK Line 1015  EVALBLOCK
 sub devalidate_cache_new {  sub devalidate_cache_new {
     my ($cache,$name,$id) = @_;      my ($cache,$name,$id) = @_;
     if (0) { &Apache::lonnet::logthis("deleting $name:$id"); }      if (0) { &Apache::lonnet::logthis("deleting $name:$id"); }
     $cache->delete($name.':'.$id);      $cache->delete(&escape($name.':'.$id));
 }  }
   
 my $lastone;  my $lastone;
Line 1020  my $lastname; Line 1023  my $lastname;
 sub is_cached_new {  sub is_cached_new {
     my ($cache,$name,$id,$debug) = @_;      my ($cache,$name,$id,$debug) = @_;
     $debug=0;      $debug=0;
     $id=$name.':'.$id;      $id=&escape($name.':'.$id);
     if ($lastname eq $id) {      if ($lastname eq $id) {
  if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $lastone <= $lastname "); }   if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $lastone <= $lastname "); }
  return ($lastone,1);   return ($lastone,1);
Line 1045  sub is_cached_new { Line 1048  sub is_cached_new {
 sub do_cache_new {  sub do_cache_new {
     my ($cache,$name,$id,$value,$time,$debug) = @_;      my ($cache,$name,$id,$value,$time,$debug) = @_;
     $debug=0;      $debug=0;
     $id=$name.':'.$id;      $id=&escape($name.':'.$id);
     my $setvalue=$value;      my $setvalue=$value;
     if (!defined($setvalue)) {      if (!defined($setvalue)) {
  $setvalue='__undef__';   $setvalue='__undef__';
Line 2253  sub tmprestore { Line 2256  sub tmprestore {
 }  }
   
 # ----------------------------------------------------------------------- Store  # ----------------------------------------------------------------------- Store
 my $memcache_store=0;  
 sub store {  sub store {
     my ($storehash,$symb,$namespace,$domain,$stuname) = @_;      my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
     my $home='';      my $home='';
Line 2268  sub store { Line 2270  sub store {
   
     &devalidate($symb,$stuname,$domain);      &devalidate($symb,$stuname,$domain);
     $symb=escape($symb);      $symb=escape($symb);
     $memcache_store &&  
  $metacache->delete("store:".$symb.":".$stuname.":".$domain.':'.$namespace);  
     if (!$namespace) {       if (!$namespace) { 
        unless ($namespace=$ENV{'request.course.id'}) {          unless ($namespace=$ENV{'request.course.id'}) { 
           return '';             return ''; 
Line 2305  sub cstore { Line 2305  sub cstore {
   
     &devalidate($symb,$stuname,$domain);      &devalidate($symb,$stuname,$domain);
     $symb=escape($symb);      $symb=escape($symb);
     $memcache_store &&  
  $metacache->delete("store:".$symb.":".$stuname.":".$domain.':'.$namespace);  
     if (!$namespace) {       if (!$namespace) { 
        unless ($namespace=$ENV{'request.course.id'}) {          unless ($namespace=$ENV{'request.course.id'}) { 
           return '';             return ''; 
Line 2348  sub restore { Line 2346  sub restore {
     if (!$domain) { $domain=$ENV{'user.domain'}; }      if (!$domain) { $domain=$ENV{'user.domain'}; }
     if (!$stuname) { $stuname=$ENV{'user.name'}; }      if (!$stuname) { $stuname=$ENV{'user.name'}; }
     if (!$home) { $home=$ENV{'user.home'}; }      if (!$home) { $home=$ENV{'user.home'}; }
     if ($memcache_store) {  
  my $rethash=$metacache->get("store:".$symb.":".$stuname.":".  
     $domain.':'.$namespace);  
  if ($rethash) { return %{$rethash}; }  
     }  
     my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");      my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");
   
     my %returnhash=();      my %returnhash=();
Line 2366  sub restore { Line 2360  sub restore {
           $returnhash{$_}=$returnhash{$version.':'.$_};            $returnhash{$_}=$returnhash{$version.':'.$_};
        }         }
     }      }
     if ($memcache_store) {  
  $metacache->set("store:".$symb.":".$stuname.":".$domain.':'.$namespace,  
  \%returnhash);  
     }  
     return %returnhash;      return %returnhash;
 }  }
   
Line 2849  sub allowed { Line 2839  sub allowed {
     }      }
   
 # Free bre to public access  # Free bre to public access
   
     if ($priv eq 'bre') {      if ($priv eq 'bre') {
         my $copyright=&metadata($uri,'copyright');          my $copyright=&metadata($uri,'copyright');
  if (($copyright eq 'public') && (!$ENV{'request.course.id'})) {    if (($copyright eq 'public') && (!$ENV{'request.course.id'})) { 
Removed from v.1.545.2.1  
changed lines
  Added in v.1.545.2.2

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>