[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.394 and 1.395

version 1.394, 2003/07/25 01:18:04 version 1.395, 2003/07/29 05:22:56
Line 3222  sub EXT_cache_set { Line 3222  sub EXT_cache_set {
   
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
 sub EXT {  sub EXT {
     my ($varname,$symbparm,$udom,$uname,$usection)=@_;      my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
   
     unless ($varname) { return ''; }      unless ($varname) { return ''; }
     #get real user name/domain, courseid and symb      #get real user name/domain, courseid and symb
Line 3323  sub EXT { Line 3323  sub EXT {
         return $ENV{'course.'.$courseid.'.'.$spacequalifierrest};          return $ENV{'course.'.$courseid.'.'.$spacequalifierrest};
     } elsif ($realm eq 'resource') {      } elsif ($realm eq 'resource') {
   
    my $section;
  if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {   if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {
   
     #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;      #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
Line 3335  sub EXT { Line 3336  sub EXT {
     my $symbparm=$symbp.'.'.$spacequalifierrest;      my $symbparm=$symbp.'.'.$spacequalifierrest;
     my $mapparm=$mapp.'___(all).'.$spacequalifierrest;      my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
   
     my $section;  
     if (($ENV{'user.name'} eq $uname) &&      if (($ENV{'user.name'} eq $uname) &&
  ($ENV{'user.domain'} eq $udom)) {   ($ENV{'user.domain'} eq $udom)) {
  $section=$ENV{'request.course.sec'};   $section=$ENV{'request.course.sec'};
Line 3426  sub EXT { Line 3426  sub EXT {
     my $part=join('_',@parts);      my $part=join('_',@parts);
     if ($part eq '') { $part='0'; }      if ($part eq '') { $part='0'; }
     my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,      my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
  $symbparm,$udom,$uname);   $symbparm,$udom,$uname,$section,1);
     if (defined($partgeneral)) { return $partgeneral; }      if (defined($partgeneral)) { return $partgeneral; }
  }   }
    if ($recurse) { return undef; }
    my $pack_def=&packages_tab_default($filename,$varname);
    if (defined($pack_def)) { return $pack_def; }
   
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {      } elsif ($realm eq 'environment') {
Line 3449  sub EXT { Line 3452  sub EXT {
     return '';      return '';
 }  }
   
   sub packages_tab_default {
       my ($uri,$varname)=@_;
       &logthis(" $varname");
       my (undef,$part,$name)=split(/\./,$varname);
       my $packages=&metadata($uri,'packages');
       foreach my $package (split(/,/,$packages)) {
    my ($pack_type,$pack_part)=split(/_/,$package,2);
    if ($pack_part eq $part) {
       return $packagetab{"$pack_type&$name&default"};
    }
       }
       return undef;
   }
   
 sub add_prefix_and_part {  sub add_prefix_and_part {
     my ($prefix,$part)=@_;      my ($prefix,$part)=@_;
     my $keyroot;      my $keyroot;
Line 3517  sub metadata { Line 3534  sub metadata {
     foreach (keys %packagetab) {      foreach (keys %packagetab) {
  if ($_=~/^$package\&/) {   if ($_=~/^$package\&/) {
     my ($pack,$name,$subp)=split(/\&/,$_);      my ($pack,$name,$subp)=split(/\&/,$_);
       # ignore package.tab specified default values
                               # here &package_tab_default() will fetch those
       if ($subp eq 'default') { next; }
     my $value=$packagetab{$_};      my $value=$packagetab{$_};
     my $part=$keyroot;      my $part=$keyroot;
     $part=~s/^\_//;      $part=~s/^\_//;
Line 3524  sub metadata { Line 3544  sub metadata {
  $value.=' [Part: '.$part.']';   $value.=' [Part: '.$part.']';
     }      }
     my $unikey='parameter'.$keyroot.'_'.$name;      my $unikey='parameter'.$keyroot.'_'.$name;
     if ($subp eq 'default') {      $metacache{$uri.':'.$unikey.'.part'}=$part;
  $unikey='parameter_0_'.$name;      $metathesekeys{$unikey}=1;
  $metacache{$uri.':'.$unikey.'.part'}='0';  
     } else {  
  $metacache{$uri.':'.$unikey.'.part'}=$part;  
  $metathesekeys{$unikey}=1;  
     }  
     unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {      unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
  $metacache{$uri.':'.$unikey.'.'.$subp}=$value;   $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
     }      }
Removed from v.1.394  
changed lines
  Added in v.1.395

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