Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.449 and 1.452

version 1.449, 2003/11/12 20:32:04 version 1.452, 2003/12/04 20:09:35
Line 848  sub getsection { Line 848  sub getsection {
     return '-1';      return '-1';
 }  }
   
   
   my $disk_caching_disabled=1;
   
 sub devalidate_cache {  sub devalidate_cache {
     my ($cache,$id,$name) = @_;      my ($cache,$id,$name) = @_;
     delete $$cache{$id.'.time'};      delete $$cache{$id.'.time'};
     delete $$cache{$id};      delete $$cache{$id};
       if ($disk_caching_disabled) { return; }
     my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     open(DB,"$filename.lock");      open(DB,"$filename.lock");
     flock(DB,LOCK_EX);      flock(DB,LOCK_EX);
Line 907  sub do_cache { Line 911  sub do_cache {
   
 sub save_cache_item {  sub save_cache_item {
     my ($cache,$name,$id)=@_;      my ($cache,$name,$id)=@_;
       if ($disk_caching_disabled) { return; }
     my $starttime=&Time::HiRes::time();      my $starttime=&Time::HiRes::time();
 #    &logthis("Saving :$name:$id");  #    &logthis("Saving :$name:$id");
     my %hash;      my %hash;
Line 936  EVALBLOCK Line 941  EVALBLOCK
   
 sub load_cache_item {  sub load_cache_item {
     my ($cache,$name,$id)=@_;      my ($cache,$name,$id)=@_;
       if ($disk_caching_disabled) { return; }
     my $starttime=&Time::HiRes::time();      my $starttime=&Time::HiRes::time();
 #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));  #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));
     my %hash;      my %hash;
Line 1153  sub ssi_body { Line 1159  sub ssi_body {
     my ($filelink,%form)=@_;      my ($filelink,%form)=@_;
     my $output=($filelink=~/^http\:/?&externalssi($filelink):      my $output=($filelink=~/^http\:/?&externalssi($filelink):
                                      &ssi($filelink,%form));                                       &ssi($filelink,%form));
     $output=~s/^.*\<body[^\>]*\>//si;      $output=~s/^.*?\<body[^\>]*\>//si;
     $output=~s/\<\/body\s*\>.*$//si;      $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;
     $output=~      $output=~
             s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;              s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;
     return $output;      return $output;
Line 1336  sub flushcourselogs { Line 1342  sub flushcourselogs {
 #  #
     foreach my $entry (keys(%accesshash)) {      foreach my $entry (keys(%accesshash)) {
         my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);          my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
         my %temphash=($entry => $accesshash{$entry});  
         if ($type eq 'count'){          if ($type eq 'count'){
               my $value = $accesshash{$entry};
               my (undef,$url,undef) = ($entry =~ /^(.*)___(.*)___count$/);
               my %temphash=($url => $value);
             my $result = &inc('nohist_accesscount',\%temphash,$dom,$name);              my $result = &inc('nohist_accesscount',\%temphash,$dom,$name);
             if ($result eq 'ok') {              if ($result eq 'ok') {
                 delete $accesshash{$entry};                  delete $accesshash{$entry};
             } elsif ($result eq 'unknown_cmd') {              } elsif ($result eq 'unknown_cmd') {
                 # Target server has old code running on it.                  # Target server has old code running on it.
                   my %temphash=($entry => $value);
                 if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {                  if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                     delete $accesshash{$entry};                      delete $accesshash{$entry};
                 }                  }
             }              }
  &logthis('incrementing '.$entry.' by '.$accesshash{$entry}.' result is '.$result);  
         } else {          } else {
               my %temphash=($entry => $accesshash{$entry});
             if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {              if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                 delete $accesshash{$entry};                  delete $accesshash{$entry};
             }              }
Line 1388  sub courselog { Line 1397  sub courselog {
     } else {      } else {
  $courselogs{$ENV{'request.course.id'}}.=$what;   $courselogs{$ENV{'request.course.id'}}.=$what;
     }      }
     if (length($courselogs{$ENV{'request.course.id'}})>4048) {  #    if (length($courselogs{$ENV{'request.course.id'}})>4048) {
       if (length($courselogs{$ENV{'request.course.id'}})>48) {
  &flushcourselogs();   &flushcourselogs();
     }      }
 }  }
Line 1413  sub countacc { Line 1423  sub countacc {
     unless ($ENV{'request.course.id'}) { return ''; }      unless ($ENV{'request.course.id'}) { return ''; }
     $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;      $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
     my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';      my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
     if (defined($accesshash{$key})) {      $accesshash{$key}++;
  $accesshash{$key}++;  
     } else {  
         $accesshash{$key}=1;  
     }  
 }  }
   
 sub linklog {  sub linklog {

Removed from v.1.449  
changed lines
  Added in v.1.452


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