[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.332 and 1.335

version 1.332, 2003/03/01 15:13:58 version 1.335, 2003/03/07 23:37:09
Line 729  sub subscribe { Line 729  sub subscribe {
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
     my $home=homeserver($uname,$udom);      my $home=homeserver($uname,$udom);
     if ($home eq 'no_host') {       if ($home eq 'no_host') {
         return 'not_found';           return 'not_found';
     }      }
     my $answer=reply("sub:$fname",$home);      my $answer=reply("sub:$fname",$home);
     if (($answer eq 'con_lost') || ($answer eq 'rejected')) {      if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
Line 2855  sub EXT { Line 2855  sub EXT {
     if ($realm eq 'user') {      if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource  # --------------------------------------------------------------- user.resource
  if ($space eq 'resource') {   if ($space eq 'resource') {
     my %restored=&restore(undef,undef,$udom,$uname);      if (defined($Apache::lonhomework::parsing_a_problem)) {
             return $restored{$qualifierrest};   return $Apache::lonhomework::history{$qualifierrest};
       } else {
    my %restored=&restore($symbparm,$courseid,$udom,$uname);
    return $restored{$qualifierrest};
       }
 # ----------------------------------------------------------------- user.access  # ----------------------------------------------------------------- user.access
         } elsif ($space eq 'access') {          } elsif ($space eq 'access') {
     # FIXME - not supporting calls for a specific user      # FIXME - not supporting calls for a specific user
Line 2891  sub EXT { Line 2895  sub EXT {
             return $uname;              return $uname;
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
         } else {          } else {
             my $item=($rest)?$qualifier.'.'.$rest:$qualifier;              my %reply=&get($space,[$qualifierrest],$udom,$uname);
             my %reply=&get($space,[$item]);              return $reply{$qualifierrest};
             return $reply{$item};  
         }          }
     } elsif ($realm eq 'query') {      } elsif ($realm eq 'query') {
 # ---------------------------------------------- pull stuff out of query string  # ---------------------------------------------- pull stuff out of query string
Line 3010  sub EXT { Line 3013  sub EXT {
   
 # ------------------------------------------------------------------ Cascade up  # ------------------------------------------------------------------ Cascade up
  unless ($space eq '0') {   unless ($space eq '0') {
     my ($part,$id)=split(/\_/,$space);      my ($part,$id)=split(/_/,$space);
     if ($id) {      if ($id) {
  my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,   my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
      $symbparm,$udom,$uname);       $symbparm,$udom,$uname);
Line 3041  sub EXT { Line 3044  sub EXT {
     return '';      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  # ---------------------------------------------------------------- Get metadata
   
 sub metadata {  sub metadata {
Line 3069  sub metadata { Line 3088  sub metadata {
         }          }
         my %metathesekeys=();          my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }          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 $parser=HTML::LCParser->new(\$metastring);
         my $token;          my $token;
         undef %metathesekeys;          undef %metathesekeys;
Line 3080  sub metadata { Line 3099  sub metadata {
 # This is a package - get package info  # This is a package - get package info
 #  #
       my $package=$token->[2]->{'package'};        my $package=$token->[2]->{'package'};
       my $keyroot='';        my $keyroot=&add_prefix_and_part($prefix,$token->[2]->{'part'});
               if ($prefix) {  
   $keyroot.=$prefix;  
               } else {  
                 if (defined($token->[2]->{'part'})) {   
                    $keyroot.='_'.$token->[2]->{'part'};   
         }  
       }  
               if (defined($token->[2]->{'id'})) {                 if (defined($token->[2]->{'id'})) { 
                  $keyroot.='_'.$token->[2]->{'id'};                    $keyroot.='_'.$token->[2]->{'id'}; 
       }        }
Line 3128  sub metadata { Line 3140  sub metadata {
               } else {                } else {
                  $unikey=$entry;                   $unikey=$entry;
       }        }
               if ($prefix) {        $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'});
   $unikey.=$prefix;  
               } else {  
                 if (defined($token->[2]->{'part'})) {   
                    $unikey.='_'.$token->[2]->{'part'};   
         }  
       }  
               if (defined($token->[2]->{'id'})) {                 if (defined($token->[2]->{'id'})) { 
                  $unikey.='_'.$token->[2]->{'id'};                    $unikey.='_'.$token->[2]->{'id'}; 
       }        }
Removed from v.1.332  
changed lines
  Added in v.1.335

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>