--- loncom/lonnet/perl/lonnet.pm 2001/07/27 20:17:14 1.134 +++ loncom/lonnet/perl/lonnet.pm 2001/08/04 20:13:17 1.139 @@ -121,7 +121,8 @@ # 5/26,5/28 Gerd Kortemeyer # 5/30 H. K. Ng # 6/1 Gerd Kortemeyer -# +# July Guy Albertelli +# 8/4 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/)) { $adv=1; } if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; } map { if ($_ ne '') { @@ -1851,11 +1852,51 @@ sub metadata { my $token; 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'}; + } + if (defined($token->[2]->{'id'})) { + $keyroot.='_'.$token->[2]->{'id'}; + } + if ($metacache{$uri.':packages'}) { + $metacache{$uri.':packages'}.=','.$package.$keyroot; + } else { + $metacache{$uri.':packages'}=$package.$keyroot; + } + undef %thispackagekeys; + map { + if ($_=~/^$package\&/) { + my ($pack,$name,$subp)=split(/\&/,$_); + my $value=$packagetab{$_}; + if ($subp eq 'display') { + my $part=$keyroot; + $part=~s/^\_//; + $value.=' [Part: '.$part.']'; + } + my $unikey='parameter'.$keyroot.'_'.$name; + $thispackagekeys{$unikey}=1; + $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; 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'}; } @@ -1872,7 +1913,8 @@ sub metadata { ) { $metacache{$uri.':'.$unikey}= $metacache{$uri.':'.$unikey.'.default'}; } - } + } + } } } return $metacache{$uri.':'.$what}; @@ -2154,6 +2196,17 @@ 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); + if ($plain ne '') { $packagetab{$short}=$plain; } + } +} + # ------------------------------------------------------------- Read file types { my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");