--- loncom/lonnet/perl/lonnet.pm 2001/08/04 19:07:31 1.138 +++ loncom/lonnet/perl/lonnet.pm 2001/08/09 19:28:47 1.147 @@ -122,7 +122,7 @@ # 5/30 H. K. Ng # 6/1 Gerd Kortemeyer # July Guy Albertelli -# 8/4 Gerd Kortemeyer +# 8/4,8/7,8/8,8/9 Gerd Kortemeyer package Apache::lonnet; @@ -896,7 +896,7 @@ sub rolesinit { my $author=0; map { %thesepriv=(); - if (($_!~/^st/) && ($_!~/^ta/)) { $adv=1; } + if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; } if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; } map { if ($_ ne '') { @@ -1674,7 +1674,7 @@ sub condval { # --------------------------------------------------------- Value of a Variable sub EXT { - my $varname=shift; + my ($varname,$symbparm)=@_; unless ($varname) { return ''; } my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); my $rest; @@ -1735,8 +1735,17 @@ sub EXT { $spacequalifierrest}; } elsif ($realm eq 'resource') { if ($ENV{'request.course.id'}) { + +# print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; + + # ----------------------------------------------------- Cascading lookup scheme - my $symbp=&symbread(); + my $symbp; + if ($symbparm) { + $symbp=$symbparm; + } else { + $symbp=&symbread(); + } my $mapp=(split(/\_\_\_/,$symbp))[0]; my $symbparm=$symbp.'.'.$spacequalifierrest; @@ -1824,6 +1833,21 @@ sub EXT { 'parameter_'.$spacequalifierrest); if ($metadata) { return $metadata; } +# ------------------------------------------------------------------ Cascade up + + unless ($space eq '0') { + my ($part,$id)=split(/\_/,$space); + if ($id) { + my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, + $symbparm); + if ($partgeneral) { return $partgeneral; } + } else { + my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, + $symbparm); + if ($resourcegeneral) { return $resourcegeneral; } + } + } + # ---------------------------------------------------- Any other user namespace } elsif ($realm eq 'environment') { # ----------------------------------------------------------------- environment @@ -1846,15 +1870,16 @@ sub metadata { my $filename=$uri; $uri=~s/\.meta$//; unless ($metacache{$uri.':keys'}) { + my %metathesekeys=(); unless ($filename=~/\.meta$/) { $filename.='.meta'; } my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename); my $parser=HTML::TokeParser->new(\$metastring); my $token; + undef %metathesekeys; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { if (defined($token->[2]->{'package'})) { my $package=$token->[2]->{'package'}; - my %thispackagekeys=(); my $keyroot=''; if (defined($token->[2]->{'part'})) { $keyroot.='_'.$token->[2]->{'part'}; @@ -1867,21 +1892,24 @@ sub metadata { } else { $metacache{$uri.':packages'}=$package.$keyroot; } - undef %thispackagekeys; map { if ($_=~/^$package\&/) { my ($pack,$name,$subp)=split(/\&/,$_); - my $unikey='parameter_'.$keyroot.'_'.$name; - $thispackagekeys{$unikey}=1; - $metacache{$uri.':'.$unikey.'.'.$subp}=$packagetab{$_}; + my $value=$packagetab{$_}; + my $part=$keyroot; + $part=~s/^\_//; + if ($subp eq 'display') { + $value.=' [Part: '.$part.']'; + } + my $unikey='parameter'.$keyroot.'_'.$name; + $metathesekeys{$unikey}=1; + $metacache{$uri.':'.$unikey.'.part'}=$part; + unless + (defined($metacache{$uri.':'.$unikey.'.'.$subp})) { + $metacache{$uri.':'.$unikey.'.'.$subp}=$value; + } } } keys %packagetab; - my $addpackagekeys=join(',',keys %thispackagekeys); - if ($metacache{$uri.':keys'}) { - $metacache{$uri.':keys'}.=','.$addpackagekeys; - } else { - $metacache{$uri.':keys'}=$addpackagekeys; - } } else { my $entry=$token->[1]; my $unikey=$entry; @@ -1894,11 +1922,7 @@ sub metadata { if (defined($token->[2]->{'name'})) { $unikey.='_'.$token->[2]->{'name'}; } - if ($metacache{$uri.':keys'}) { - $metacache{$uri.':keys'}.=','.$unikey; - } else { - $metacache{$uri.':keys'}=$unikey; - } + $metathesekeys{$unikey}=1; map { $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_}; } @{$token->[3]}; @@ -1908,8 +1932,9 @@ sub metadata { $metacache{$uri.':'.$unikey.'.default'}; } } - } + } } + $metacache{$uri.':keys'}=join(',',keys %metathesekeys); } return $metacache{$uri.':'.$what}; } @@ -2197,7 +2222,11 @@ if ($readit ne 'done') { while (my $configline=<$config>) { chomp($configline); my ($short,$plain)=split(/:/,$configline); - if ($plain ne '') { $packagetab{$short}=$plain; } + my ($pack,$name)=split(/\&/,$short); + if ($plain ne '') { + $packagetab{$pack.'&'.$name.'&name'}=$name; + $packagetab{$short}=$plain; + } } }