Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.415 and 1.416

version 1.415, 2003/09/17 17:50:49 version 1.416, 2003/09/19 16:29:09
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 
    %domaindescription %domain_auth_def %domain_auth_arg_def      %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 848  sub getsection { Line 848  sub getsection {
     return '-1';      return '-1';
 }  }
   
   sub devalidate_cache {
       my ($cache,$id) = @_;
       delete $courseresdatacache{$id.'.time'};
       delete $courseresdatacache{$id};
   }
   
   sub is_cached {
       my ($cache,$id,$time) = @_;
       if (!exists($$cache{$id.'.time'})) {
    return undef;
       } else {
    if (time-$$cache{$id.'.time'}>300) {
       &devaidate_cache($cache,$id);
       return undef;
    }
       }
       return $$cache{$id};
   }
   
   sub do_cache {
       my ($cache,$id,$value) = @_;
       $$cache{$id.'.time'}=time;
       # do_cache implictly return the set value
       $$cache{$id}=$value;
   }
   
 sub usection {  sub usection {
     my ($udom,$unam,$courseid)=@_;      my ($udom,$unam,$courseid)=@_;
       my $hashid="$udom:$unam:$courseid";
       
       my $result;
       if ($result=&is_cached(\%usectioncache,$hashid,300)) { return $result; }
     $courseid=~s/\_/\//g;      $courseid=~s/\_/\//g;
     $courseid=~s/^(\w)/\/$1/;      $courseid=~s/^(\w)/\/$1/;
     foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',      foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
Line 868  sub usection { Line 898  sub usection {
             if ($end) {              if ($end) {
                 if ($now>$end) { $notactive=1; }                  if ($now>$end) { $notactive=1; }
             }               } 
             unless ($notactive) { return $section; }              unless ($notactive) {
    return &do_cache(\%usectioncache,$hashid,$section);
       }
         }          }
     }      }
     return '-1';      return &do_cache(\%usectioncache,$hashid,'-1');
 }  }
   
 # ------------------------------------- Read an entry from a user's environment  # ------------------------------------- Read an entry from a user's environment
Line 3291  sub courseresdata { Line 3323  sub courseresdata {
     $courseresdatacache{$hashid}=\%dumpreply;      $courseresdatacache{$hashid}=\%dumpreply;
  } elsif ($tmp =~ /^(con_lost|no_such_host)/) {   } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
     return $tmp;      return $tmp;
    } elsif ($tmp =~ /^(error)/) {
       $courseresdatacache{$hashid.'.time'}=time;
  }   }
     }      }
     foreach my $item (@which) {      foreach my $item (@which) {

Removed from v.1.415  
changed lines
  Added in v.1.416


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