--- loncom/lonnet/perl/lonnet.pm 2001/11/16 06:21:39 1.169 +++ loncom/lonnet/perl/lonnet.pm 2001/11/17 18:20:33 1.172 @@ -35,8 +35,10 @@ # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26, # 10/2 Gerd Kortemeyer # 10/5,10/10,11/13,11/15 Scott Harrison +# 11/17 Gerd Kortemeyer +# +# $Id: lonnet.pm,v 1.172 2001/11/17 18:20:33 www Exp $ # -# $Id: lonnet.pm,v 1.169 2001/11/16 06:21:39 harris41 Exp $ ### # Functions for use by content handlers: @@ -1746,6 +1748,7 @@ sub modifyuserauth { unless ($reply eq 'ok') { return 'error: '.$reply; } + return 'ok'; } # --------------------------------------------------------------- Modify a user @@ -2230,12 +2233,24 @@ sub EXT { # ---------------------------------------------------------------- Get metadata sub metadata { - my ($uri,$what)=@_; + my ($uri,$what,$liburi,$prefix)=@_; $uri=&declutter($uri); my $filename=$uri; $uri=~s/\.meta$//; +# +# Is the metadata already cached? +# If "keys" are set, the assumption is that everything is already cached. +# Everything is cached by the main uri, libraries are never directly cached +# unless ($metacache{$uri.':keys'}) { +# +# Is this a recursive call for a library? +# + if ($liburi) { + $liburi=&declutter($liburi); + $filename=$liburi; + } my %metathesekeys=(); unless ($filename=~/\.meta$/) { $filename.='.meta'; } my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename); @@ -2245,10 +2260,17 @@ sub metadata { while ($token=$parser->get_token) { if ($token->[0] eq 'S') { if (defined($token->[2]->{'package'})) { +# +# This is a package - get package info +# my $package=$token->[2]->{'package'}; my $keyroot=''; - if (defined($token->[2]->{'part'})) { - $keyroot.='_'.$token->[2]->{'part'}; + if ($prefix) { + $keyroot.='_'.$prefix; + } else { + if (defined($token->[2]->{'part'})) { + $keyroot.='_'.$token->[2]->{'part'}; + } } if (defined($token->[2]->{'id'})) { $keyroot.='_'.$token->[2]->{'id'}; @@ -2277,10 +2299,25 @@ sub metadata { } } keys %packagetab; } else { - my $entry=$token->[1]; +# +# This is not a package - some other kind of start tag +# + my $entry=$token->[1]; + if ($entry eq 'import') { +# +# Importing a library here +# + my $libid=$token->[2]->{'id'}; + + + } else { my $unikey=$entry; - if (defined($token->[2]->{'part'})) { - $unikey.='_'.$token->[2]->{'part'}; + if ($prefix) { + $unikey.='_'.$prefix; + } else { + if (defined($token->[2]->{'part'})) { + $unikey.='_'.$token->[2]->{'part'}; + } } if (defined($token->[2]->{'id'})) { $unikey.='_'.$token->[2]->{'id'}; @@ -2297,7 +2334,11 @@ sub metadata { ) { $metacache{$uri.':'.$unikey}= $metacache{$uri.':'.$unikey.'.default'}; } - } +# end of not-a-package not-a-library import + } +# end of not-a-package start tag + } +# the next is the end of "start tag" } } $metacache{$uri.':keys'}=join(',',keys %metathesekeys);