--- loncom/lonnet/perl/lonnet.pm 2003/03/01 15:13:58 1.332 +++ loncom/lonnet/perl/lonnet.pm 2003/03/07 23:37:09 1.335 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.332 2003/03/01 15:13:58 www Exp $ +# $Id: lonnet.pm,v 1.335 2003/03/07 23:37:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -729,8 +729,8 @@ sub subscribe { $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); my $home=homeserver($uname,$udom); - if ($home eq 'no_host') { - return 'not_found'; + if ($home eq 'no_host') { + return 'not_found'; } my $answer=reply("sub:$fname",$home); if (($answer eq 'con_lost') || ($answer eq 'rejected')) { @@ -2855,8 +2855,12 @@ sub EXT { if ($realm eq 'user') { # --------------------------------------------------------------- user.resource if ($space eq 'resource') { - my %restored=&restore(undef,undef,$udom,$uname); - return $restored{$qualifierrest}; + if (defined($Apache::lonhomework::parsing_a_problem)) { + return $Apache::lonhomework::history{$qualifierrest}; + } else { + my %restored=&restore($symbparm,$courseid,$udom,$uname); + return $restored{$qualifierrest}; + } # ----------------------------------------------------------------- user.access } elsif ($space eq 'access') { # FIXME - not supporting calls for a specific user @@ -2891,9 +2895,8 @@ sub EXT { return $uname; # ---------------------------------------------------- Any other user namespace } else { - my $item=($rest)?$qualifier.'.'.$rest:$qualifier; - my %reply=&get($space,[$item]); - return $reply{$item}; + my %reply=&get($space,[$qualifierrest],$udom,$uname); + return $reply{$qualifierrest}; } } elsif ($realm eq 'query') { # ---------------------------------------------- pull stuff out of query string @@ -3010,7 +3013,7 @@ sub EXT { # ------------------------------------------------------------------ Cascade up unless ($space eq '0') { - my ($part,$id)=split(/\_/,$space); + my ($part,$id)=split(/_/,$space); if ($id) { my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, $symbparm,$udom,$uname); @@ -3041,6 +3044,22 @@ sub EXT { return ''; } +sub add_prefix_and_part { + my ($prefix,$part)=@_; + my $keyroot; + if (defined($prefix) && $prefix !~ /^__/) { + # prefix that has a part already + $keyroot=$prefix; + } elsif (defined($prefix)) { + # prefix that is missing a part + if (defined($part)) { $keyroot='_'.$part.substr($prefix,1); } + } else { + # no prefix at all + if (defined($part)) { $keyroot='_'.$part; } + } + return $keyroot; +} + # ---------------------------------------------------------------- Get metadata sub metadata { @@ -3069,7 +3088,7 @@ sub metadata { } my %metathesekeys=(); unless ($filename=~/\.meta$/) { $filename.='.meta'; } - my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename); + my $metastring=&getfile(&filelocation('',&clutter($filename))); my $parser=HTML::LCParser->new(\$metastring); my $token; undef %metathesekeys; @@ -3080,14 +3099,7 @@ sub metadata { # This is a package - get package info # my $package=$token->[2]->{'package'}; - my $keyroot=''; - if ($prefix) { - $keyroot.=$prefix; - } else { - if (defined($token->[2]->{'part'})) { - $keyroot.='_'.$token->[2]->{'part'}; - } - } + my $keyroot=&add_prefix_and_part($prefix,$token->[2]->{'part'}); if (defined($token->[2]->{'id'})) { $keyroot.='_'.$token->[2]->{'id'}; } @@ -3128,13 +3140,8 @@ sub metadata { } else { $unikey=$entry; } - if ($prefix) { - $unikey.=$prefix; - } else { - if (defined($token->[2]->{'part'})) { - $unikey.='_'.$token->[2]->{'part'}; - } - } + $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'}); + if (defined($token->[2]->{'id'})) { $unikey.='_'.$token->[2]->{'id'}; }