--- loncom/lonnet/perl/lonnet.pm 2003/07/25 01:18:04 1.394 +++ loncom/lonnet/perl/lonnet.pm 2003/07/29 05:22:56 1.395 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.394 2003/07/25 01:18:04 bowersj2 Exp $ +# $Id: lonnet.pm,v 1.395 2003/07/29 05:22:56 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3222,7 +3222,7 @@ sub EXT_cache_set { # --------------------------------------------------------- Value of a Variable sub EXT { - my ($varname,$symbparm,$udom,$uname,$usection)=@_; + my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_; unless ($varname) { return ''; } #get real user name/domain, courseid and symb @@ -3323,6 +3323,7 @@ sub EXT { return $ENV{'course.'.$courseid.'.'.$spacequalifierrest}; } elsif ($realm eq 'resource') { + my $section; if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) { #print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; @@ -3335,7 +3336,6 @@ sub EXT { my $symbparm=$symbp.'.'.$spacequalifierrest; my $mapparm=$mapp.'___(all).'.$spacequalifierrest; - my $section; if (($ENV{'user.name'} eq $uname) && ($ENV{'user.domain'} eq $udom)) { $section=$ENV{'request.course.sec'}; @@ -3426,9 +3426,12 @@ sub EXT { my $part=join('_',@parts); if ($part eq '') { $part='0'; } my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, - $symbparm,$udom,$uname); + $symbparm,$udom,$uname,$section,1); 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 } elsif ($realm eq 'environment') { @@ -3449,6 +3452,20 @@ sub EXT { 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 { my ($prefix,$part)=@_; my $keyroot; @@ -3517,6 +3534,9 @@ sub metadata { foreach (keys %packagetab) { if ($_=~/^$package\&/) { 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 $part=$keyroot; $part=~s/^\_//; @@ -3524,13 +3544,8 @@ sub metadata { $value.=' [Part: '.$part.']'; } my $unikey='parameter'.$keyroot.'_'.$name; - if ($subp eq 'default') { - $unikey='parameter_0_'.$name; - $metacache{$uri.':'.$unikey.'.part'}='0'; - } else { - $metacache{$uri.':'.$unikey.'.part'}=$part; - $metathesekeys{$unikey}=1; - } + $metacache{$uri.':'.$unikey.'.part'}=$part; + $metathesekeys{$unikey}=1; unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) { $metacache{$uri.':'.$unikey.'.'.$subp}=$value; }