Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.418 and 1.421

version 1.418, 2003/09/19 16:54:12 version 1.421, 2003/09/22 19:32:49
Line 76  qw(%perlvar %hostname %homecache %badSer Line 76  qw(%perlvar %hostname %homecache %badSer
    %libserv %pr %prp %metacache %packagetab %titlecache      %libserv %pr %prp %metacache %packagetab %titlecache 
    %courselogs %accesshash %userrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache      %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache 
    %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def      %userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
    %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir);     %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir);
   
 use IO::Socket;  use IO::Socket;
Line 856  sub devalidate_cache { Line 856  sub devalidate_cache {
   
 sub is_cached {  sub is_cached {
     my ($cache,$id,$time) = @_;      my ($cache,$id,$time) = @_;
       if (!$time) { $time=300; }
     if (!exists($$cache{$id.'.time'})) {      if (!exists($$cache{$id.'.time'})) {
  return (undef,undef);   return (undef,undef);
     } else {      } else {
Line 878  sub usection { Line 879  sub usection {
     my ($udom,$unam,$courseid)=@_;      my ($udom,$unam,$courseid)=@_;
     my $hashid="$udom:$unam:$courseid";      my $hashid="$udom:$unam:$courseid";
           
     my ($result,$cached)=&is_cached(\%usectioncache,$hashid,300);      my ($result,$cached)=&is_cached(\%usectioncache,$hashid);
     if (defined($cached)) { return $result; }      if (defined($cached)) { return $result; }
     $courseid=~s/\_/\//g;      $courseid=~s/\_/\//g;
     $courseid=~s/^(\w)/\/$1/;      $courseid=~s/^(\w)/\/$1/;
Line 3295  sub condval { Line 3296  sub condval {
     return $result;      return $result;
 }  }
   
   # ---------------------------------------------------- Devalidate courseresdata
   
   sub devalidatecourseresdata {
       my ($coursenum,$coursedomain)=@_;
       my $hashid=$coursenum.':'.$coursedomain;
       &devalidate_cache(\%courseresdatacache,$hashid);
   }
   
 # --------------------------------------------------- Course Resourcedata Query  # --------------------------------------------------- Course Resourcedata Query
   
 sub courseresdata {  sub courseresdata {
     my ($coursenum,$coursedomain,@which)=@_;      my ($coursenum,$coursedomain,@which)=@_;
     my $coursehom=&homeserver($coursenum,$coursedomain);      my $coursehom=&homeserver($coursenum,$coursedomain);
     my $hashid=$coursenum.':'.$coursedomain;      my $hashid=$coursenum.':'.$coursedomain;
     my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid,300);      my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid);
     unless (defined($cached)) {      unless (defined($cached)) {
  my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);   my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
  $result=\%dumpreply;   $result=\%dumpreply;
Line 3485  sub EXT { Line 3494  sub EXT {
   
 # ----------------------------------------------------------- first, check user  # ----------------------------------------------------------- first, check user
     #most student don\'t have any data set, check if there is some data      #most student don\'t have any data set, check if there is some data
             #every thirty minutes  
     if (! &EXT_cache_status($udom,$uname)) {      if (! &EXT_cache_status($udom,$uname)) {
  my %resourcedata=&get('resourcedata',   my $hashid="$udom:$uname";
       [$courselevelr,$courselevelm,$courselevel],   my ($result,$cached)=&is_cached(\%userresdatacache,$hashid);
       $udom,$uname);   if (!defined($cached)) { 
  my ($tmp)=keys(%resourcedata);      my %resourcedata=&get('resourcedata',
     [$courselevelr,$courselevelm,
      $courselevel],$udom,$uname);
       $result=\%resourcedata;
    }
    my ($tmp)=keys(%$result);
  if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {   if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
     if ($resourcedata{$courselevelr}) {      &do_cache(\%userresdatacache,$hashid,$result);
  return $resourcedata{$courselevelr}; }      if ($$result{$courselevelr}) {
     if ($resourcedata{$courselevelm}) {   return $$result{$courselevelr}; }
  return $resourcedata{$courselevelm}; }      if ($$result{$courselevelm}) {
     if ($resourcedata{$courselevel}) {   return $$result{$courselevelm}; }
  return $resourcedata{$courselevel}; }      if ($$result{$courselevel}) {
    return $$result{$courselevel}; }
  } else {   } else {
     if ($tmp!~/No such file/) {      if ($tmp!~/No such file/) {
  &logthis("<font color=blue>WARNING:".   &logthis("<font color=blue>WARNING:".
  " Trying to get resource data for ".   " Trying to get resource data for ".
  $uname." at ".$udom.": ".   $uname." at ".$udom.": ".
  $tmp."</font>");   $tmp."</font>");
    &do_cache(\%userresdatacache,$hashid,undef);
     } elsif ($tmp=~/error:No such file/) {      } elsif ($tmp=~/error:No such file/) {
                         &EXT_cache_set($udom,$uname);                          &EXT_cache_set($udom,$uname);
     } elsif ($tmp =~ /^(con_lost|no_such_host)/) {      } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
    &do_cache(\%userresdatacache,$hashid,undef);
  return $tmp;   return $tmp;
     }      }
  }   }
Line 3806  sub gettitle { Line 3822  sub gettitle {
  unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }   unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
         return &metadata($urlsymb,'title');           return &metadata($urlsymb,'title'); 
     }      }
     if ($titlecache{$symb}) {      my ($result,$cached)=&is_cached(\%titlecache,$symb,600);
  if (time < ($titlecache{$symb}[1] + 600)) {      if (defined($cached)) { return $result; }
     return $titlecache{$symb}[0];  
  } else {  
     delete($titlecache{$symb});  
  }  
     }  
     my ($map,$resid,$url)=&decode_symb($symb);      my ($map,$resid,$url)=&decode_symb($symb);
     my $title='';      my $title='';
     my %bighash;      my %bighash;
Line 3824  sub gettitle { Line 3835  sub gettitle {
     }      }
     $title=~s/\&colon\;/\:/gs;      $title=~s/\&colon\;/\:/gs;
     if ($title) {      if ($title) {
         $titlecache{$symb}=[$title,time];          return &do_cache(\%titlecache,$symb,$title);
         return $title;  
     } else {      } else {
  return &metadata($urlsymb,'title');   return &metadata($urlsymb,'title');
     }      }

Removed from v.1.418  
changed lines
  Added in v.1.421


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