[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.430 and 1.433

version 1.430, 2003/10/12 22:02:44 version 1.433, 2003/10/27 21:59:34
Line 274  sub transfer_profile_to_env { Line 274  sub transfer_profile_to_env {
  $idf->close();   $idf->close();
     }      }
     my $envi;      my $envi;
       my %Remove;
     for ($envi=0;$envi<=$#profile;$envi++) {      for ($envi=0;$envi<=$#profile;$envi++) {
  chomp($profile[$envi]);   chomp($profile[$envi]);
  my ($envname,$envvalue)=split(/=/,$profile[$envi]);   my ($envname,$envvalue)=split(/=/,$profile[$envi]);
  $ENV{$envname} = $envvalue;   $ENV{$envname} = $envvalue;
           if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
               if ($time < time-300) {
                   $Remove{$key}++;
               }
           }
       }
       foreach my $expired_key (keys(%Remove)) {
           &delenv($expired_key);
     }      }
     $ENV{'user.environment'} = "$lonidsdir/$handle.id";      $ENV{'user.environment'} = "$lonidsdir/$handle.id";
 }  }
Line 3848  sub metadata { Line 3857  sub metadata {
  $lcmetacache{':packages'}=$package.$keyroot;   $lcmetacache{':packages'}=$package.$keyroot;
     }      }
     foreach (keys %packagetab) {      foreach (keys %packagetab) {
  if ($_=~/^$package\&/) {   my $part=$keyroot;
    $part=~s/^\_//;
    if ($_=~/^\Q$package\E\&/ || 
       $_=~/^\Q$package\E_0\&/) {
     my ($pack,$name,$subp)=split(/\&/,$_);      my ($pack,$name,$subp)=split(/\&/,$_);
     # ignore package.tab specified default values      # ignore package.tab specified default values
                             # here &package_tab_default() will fetch those                              # here &package_tab_default() will fetch those
     if ($subp eq 'default') { next; }      if ($subp eq 'default') { next; }
     my $value=$packagetab{$_};      my $value=$packagetab{$_};
     my $part=$keyroot;      my $unikey;
     $part=~s/^\_//;      if ($pack =~ /_0$/) {
    $unikey='parameter_0_'.$name;
    $part=0;
       } else {
    $unikey='parameter'.$keyroot.'_'.$name;
       }
     if ($subp eq 'display') {      if ($subp eq 'display') {
  $value.=' [Part: '.$part.']';   $value.=' [Part: '.$part.']';
     }      }
     my $unikey='parameter'.$keyroot.'_'.$name;  
     $lcmetacache{':'.$unikey.'.part'}=$part;      $lcmetacache{':'.$unikey.'.part'}=$part;
     $metathesekeys{$unikey}=1;      $metathesekeys{$unikey}=1;
     unless (defined($lcmetacache{':'.$unikey.'.'.$subp})) {      unless (defined($lcmetacache{':'.$unikey.'.'.$subp})) {
Line 4037  sub symblist { Line 4053  sub symblist {
   
 sub symbverify {  sub symbverify {
     my ($symb,$thisfn)=@_;      my ($symb,$thisfn)=@_;
     $thisfn=&declutter($thisfn);      $thisfn=&symbclean(&declutter($thisfn));
 # direct jump to resource in page or to a sequence - will construct own symbs  # direct jump to resource in page or to a sequence - will construct own symbs
     if ($thisfn=~/\.(page|sequence)$/) { return 1; }      if ($thisfn=~/\.(page|sequence)$/) { return 1; }
 # check URL part  # check URL part
     my ($map,$resid,$url)=&decode_symb($symb);      my ($map,$resid,$url)=&decode_symb($symb);
     unless (&symbclean($url) eq &symbclean($thisfn)) { return 0; }      unless ($url eq $thisfn) { return 0; }
   
     $symb=&symbclean($symb);      $symb=&symbclean($symb);
   
     my %bighash;      my %bighash;
     my $okay=0;      my $okay=0;
   
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',      if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
                             &GDBM_READER(),0640)) {                              &GDBM_READER(),0640)) {
         my $ids=$bighash{'ids_'.&clutter($thisfn)};          my $ids=$bighash{'ids_'.&clutter($thisfn)};
Removed from v.1.430  
changed lines
  Added in v.1.433

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