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

version 1.428, 2003/10/07 07:20:05 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 2796  sub get_symb_from_alias { Line 2805  sub get_symb_from_alias {
         my $rid=$bighash{'mapalias_'.$symb};          my $rid=$bighash{'mapalias_'.$symb};
  if ($rid) {   if ($rid) {
     my ($mapid,$resid)=split(/\./,$rid);      my ($mapid,$resid)=split(/\./,$rid);
     $aliassymb=      $aliassymb=&encode_symb($bighash{'map_id_'.$mapid},
  &declutter($bighash{'map_id_'.$mapid}).      $resid,$bighash{'src_'.$rid});
  '___'.$resid.'___'.  
  &declutter($bighash{'src_'.$rid});  
  }   }
         untie %bighash;          untie %bighash;
     }      }
Line 3612  sub EXT { Line 3619  sub EXT {
    } elsif ($realm eq 'request') {     } elsif ($realm eq 'request') {
 # ------------------------------------------------------------- request.browser  # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {          if ($space eq 'browser') {
     return $ENV{'browser.'.$qualifier};      if ($qualifier eq 'textremote') {
    if (&mt('textual_remote_display') eq 'on') {
       return 1;
    } else {
       return 0;
    }
       } else {
    return $ENV{'browser.'.$qualifier};
       }
 # ------------------------------------------------------------ request.filename  # ------------------------------------------------------------ request.filename
         } else {          } else {
             return $ENV{'request.'.$spacequalifierrest};              return $ENV{'request.'.$spacequalifierrest};
Line 3842  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 4031  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)};
Line 4080  sub symbclean { Line 4103  sub symbclean {
   
 # ---------------------------------------------- Split symb to find map and url  # ---------------------------------------------- Split symb to find map and url
   
   sub encode_symb {
       my ($map,$resid,$url)=@_;
       return &symbclean(&declutter($map).'___'.$resid.'___'.&declutter($url));
   }
   
 sub decode_symb {  sub decode_symb {
     my ($map,$resid,$url)=split(/\_\_\_/,shift);      my ($map,$resid,$url)=split(/\_\_\_/,shift);
     return (&fixversion($map),$resid,&fixversion($url));      return (&fixversion($map),$resid,&fixversion($url));
Removed from v.1.428  
changed lines
  Added in v.1.433

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