--- loncom/lonnet/perl/lonnet.pm 2001/07/27 20:17:14 1.134 +++ loncom/lonnet/perl/lonnet.pm 2001/08/09 16:43:06 1.146 @@ -121,7 +121,8 @@ # 5/26,5/28 Gerd Kortemeyer # 5/30 H. K. Ng # 6/1 Gerd Kortemeyer -# +# July Guy Albertelli +# 8/4,8/7,8/8,8/9 Gerd Kortemeyer package Apache::lonnet; @@ -130,7 +131,7 @@ use Apache::File; use LWP::UserAgent(); use HTTP::Headers; use vars -qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache); +qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -895,7 +896,7 @@ sub rolesinit { my $author=0; map { %thesepriv=(); - if ($_!~/^st/) { $adv=1; } + if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; } if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; } map { if ($_ ne '') { @@ -1734,6 +1735,10 @@ sub EXT { $spacequalifierrest}; } elsif ($realm eq 'resource') { if ($ENV{'request.course.id'}) { + +# print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; + + # ----------------------------------------------------- Cascading lookup scheme my $symbp=&symbread(); my $mapp=(split(/\_\_\_/,$symbp))[0]; @@ -1823,6 +1828,19 @@ 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); + if ($partgeneral) { return $partgeneral; } + } else { + my $resourcegeneral=&EXT('resource.0.'.$qualifierrest); + if ($resourcegeneral) { return $resourcegeneral; } + } + } + # ---------------------------------------------------- Any other user namespace } elsif ($realm eq 'environment') { # ----------------------------------------------------------------- environment @@ -1845,25 +1863,59 @@ 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 $keyroot=''; + if (defined($token->[2]->{'part'})) { + $keyroot.='_'.$token->[2]->{'part'}; + } + if (defined($token->[2]->{'id'})) { + $keyroot.='_'.$token->[2]->{'id'}; + } + if ($metacache{$uri.':packages'}) { + $metacache{$uri.':packages'}.=','.$package.$keyroot; + } else { + $metacache{$uri.':packages'}=$package.$keyroot; + } + map { + if ($_=~/^$package\&/) { + my ($pack,$name,$subp)=split(/\&/,$_); + 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; + } else { my $entry=$token->[1]; my $unikey=$entry; if (defined($token->[2]->{'part'})) { $unikey.='_'.$token->[2]->{'part'}; } + if (defined($token->[2]->{'id'})) { + $unikey.='_'.$token->[2]->{'id'}; + } 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]}; @@ -1872,8 +1924,10 @@ sub metadata { ) { $metacache{$uri.':'.$unikey}= $metacache{$uri.':'.$unikey.'.default'}; } - } + } + } } + $metacache{$uri.':keys'}=join(',',keys %metathesekeys); } return $metacache{$uri.':'.$what}; } @@ -2154,6 +2208,21 @@ if ($readit ne 'done') { } } +# ---------------------------------------------------------- Read package table +{ + my $config=Apache::File->new("$perlvar{'lonTabDir'}/packages.tab"); + + while (my $configline=<$config>) { + chomp($configline); + my ($short,$plain)=split(/:/,$configline); + my ($pack,$name)=split(/\&/,$short); + if ($plain ne '') { + $packagetab{$pack.'&'.$name.'&name'}=$name; + $packagetab{$short}=$plain; + } + } +} + # ------------------------------------------------------------- Read file types { my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");