[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.259 and 1.263

version 1.259, 2002/08/01 15:26:23 version 1.263, 2002/08/08 13:42:01
Line 608  sub userenvironment { Line 608  sub userenvironment {
     return %returnhash;      return %returnhash;
 }  }
   
   # -------------------------------------------------------------------- New chat
   
   sub chatsend {
       my ($newentry,$anon)=@_;
       my $cnum=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       my $chome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
       &reply('chatsend:'.$cdom.':'.$cnum.':'.
      &escape($ENV{'user.domain'}.':'.$ENV{'user.name'}.':'.$anon.':'.
      &escape($newentry)),$chome);
   }
   
 # ----------------------------- Subscribe to a resource, return URL if possible  # ----------------------------- Subscribe to a resource, return URL if possible
   
 sub subscribe {  sub subscribe {
Line 766  sub userfileupload { Line 778  sub userfileupload {
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
 # FIXME - this still needs to happen      if 
   (&reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome) eq 'ok') 
       {
 #  #
 # Return the URL to it  # Return the URL to it
     return '/uploaded/'.$path.$fname;              return '/uploaded/'.$path.$fname;
       } else {
           return '/adm/notfound.html';
       }    
 }  }
   
 # ------------------------------------------------------------------------- Log  # ------------------------------------------------------------------------- Log
Line 1580  sub allowed { Line 1597  sub allowed {
  return '';   return '';
             }              }
         }          }
           if ($ENV{'request.role'}=~ /li\.\//) {
               # Library role, so allow browsing of resources in this domain.
               return 'F';
           }
     }      }
   
     my $thisallowed='';      my $thisallowed='';
Line 2703  sub metadata { Line 2724  sub metadata {
 # the next is the end of "start tag"  # the next is the end of "start tag"
  }   }
        }         }
    &metadata_generate_part0(\%metathesekeys,\%metacache,$uri);
        $metacache{$uri.':keys'}=join(',',keys %metathesekeys);         $metacache{$uri.':keys'}=join(',',keys %metathesekeys);
        $metacache{$uri.':cachedtimestamp'}=time;         $metacache{$uri.':cachedtimestamp'}=time;
 # this is the end of "was not already recently cached  # this is the end of "was not already recently cached
Line 2710  sub metadata { Line 2732  sub metadata {
     return $metacache{$uri.':'.$what};      return $metacache{$uri.':'.$what};
 }  }
   
   sub metadata_generate_part0 {
       my ($metadata,$metacache,$uri) = @_;
       my %allnames;
       foreach my $metakey (sort keys %$metadata) {
    if ($metakey=~/^parameter\_(.*)/) {
     my $part=$$metacache{$uri.':'.$metakey.'.part'};
     my $name=$$metacache{$uri.':'.$metakey.'.name'};
     if (! exists($$metadata{'parameter_0_'.$name})) {
       $allnames{$name}=$part;
     }
    }
       }
       foreach my $name (keys(%allnames)) {
         $$metadata{"parameter_0_$name"}=1;
         my $key="$uri:parameter_0_$name";
         $$metacache{"$key.part"}='0';
         $$metacache{"$key.name"}=$name;
         $$metacache{"$key.type"}=$$metacache{$uri.':parameter_'.
      $allnames{$name}.'_'.$name.
      '.type'};
         my $olddis=$$metacache{$uri.':parameter_'.$allnames{$name}.'_'.$name.
        '.display'};
         my $expr='\\[Part: '.$allnames{$name}.'\\]';
         $olddis=~s/$expr/\[Part: 0\]/;
         $$metacache{"$key.display"}=$olddis;
       }
   }
   
 # ------------------------------------------------- Update symbolic store links  # ------------------------------------------------- Update symbolic store links
   
 sub symblist {  sub symblist {
Line 2918  sub ireceipt { Line 2968  sub ireceipt {
 }  }
   
 sub receipt {  sub receipt {
     return &ireceipt($ENV{'user.name'},$ENV{'user.domain'},    my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
                      $ENV{'request.course.id'},&symbread());    return &ireceipt($name,$domain,$courseid,$symb);
 }  }
     
 # ------------------------------------------------------------ Serves up a file  # ------------------------------------------------------------ Serves up a file
 # returns either the contents of the file or a -1  # returns either the contents of the file or a -1
 sub getfile {  sub getfile {
Removed from v.1.259  
changed lines
  Added in v.1.263

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