Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.459.2.4 and 1.460

version 1.459.2.4, 2004/03/19 16:48:37 version 1.460, 2004/01/12 19:53:54
Line 3792  sub packages_tab_default { Line 3792  sub packages_tab_default {
     foreach my $package (split(/,/,$packages)) {      foreach my $package (split(/,/,$packages)) {
  my ($pack_type,$pack_part)=split(/_/,$package,2);   my ($pack_type,$pack_part)=split(/_/,$package,2);
  if ($pack_part eq $part) {   if ($pack_part eq $part) {
     if (defined($packagetab{"$pack_type&$name&default"})) {      return $packagetab{"$pack_type&$name&default"};
  return $packagetab{"$pack_type&$name&default"};  
     }  
  }   }
     }      }
     return undef;      return undef;
Line 4015  sub metadata_generate_part0 { Line 4013  sub metadata_generate_part0 {
       my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name.        my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name.
      '.display'};       '.display'};
       my $expr='\\[Part: '.$allnames{$name}.'\\]';        my $expr='\\[Part: '.$allnames{$name}.'\\]';
       $olddis=~s/\Q$expr\E/\[Part: 0\]/;        $olddis=~s/$expr/\[Part: 0\]/;
       $$metacache{"$key.display"}=$olddis;        $$metacache{"$key.display"}=$olddis;
     }      }
 }  }
Line 4429  sub filelocation { Line 4427  sub filelocation {
     $location=$file;      $location=$file;
   } else {    } else {
     $file=~s/^$perlvar{'lonDocRoot'}//;      $file=~s/^$perlvar{'lonDocRoot'}//;
     $file=~s:^/res/:/:;      $file=~s:^/*res::;
     if ( !( $file =~ m:^/:) ) {      if ( !( $file =~ m:^/:) ) {
       $location = $dir. '/'.$file;        $location = $dir. '/'.$file;
     } else {      } else {
Line 4443  sub filelocation { Line 4441  sub filelocation {
   
 sub hreflocation {  sub hreflocation {
     my ($dir,$file)=@_;      my ($dir,$file)=@_;
     unless (($file=~/^http:\/\//i) || ($file=~/^\//)) {      unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
        my $finalpath=filelocation($dir,$file);   my $finalpath=filelocation($dir,$file);
        $finalpath=~s/^\/home\/httpd\/html//;   $finalpath=~s-^/home/httpd/html--;
        $finalpath=~s-/home/(\w+)/public_html/-/~$1/-;   $finalpath=~s-/home/(\w+)/public_html/-/~$1/-;
        return $finalpath;   return $finalpath;
     } else {      } elsif ($file=~m-^/home-) {
        return $file;   $file=~s-^/home/httpd/html--;
     }   $file=~s-/home/(\w+)/public_html/-/~$1/-;
 }   return $file;
   
   
 sub current_machine_domains {  
     my $hostname=$hostname{$perlvar{'lonHostID'}};  
     my @domains;  
     while( my($id, $name) = each(%hostname)) {  
  &logthis("-$id-$name-$hostname-");  
  if ($hostname eq $name) {  
     push(@domains,$hostdom{$id});  
  }  
     }      }
     return @domains;  
 }  }
   
 sub current_machine_ids {  
     my $hostname=$hostname{$perlvar{'lonHostID'}};  
     my @ids;  
     while( my($id, $name) = each(%hostname)) {  
  &logthis("-$id-$name-$hostname-");  
  if ($hostname eq $name) {  
     push(@ids,$id);  
  }  
     }  
     return @ids;  
 }  
     
 # ------------------------------------------------------------- Declutters URLs  # ------------------------------------------------------------- Declutters URLs
   
 sub declutter {  sub declutter {

Removed from v.1.459.2.4  
changed lines
  Added in v.1.460


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