--- loncom/lonnet/perl/lonnet.pm 2004/03/19 16:48:37 1.459.2.4 +++ loncom/lonnet/perl/lonnet.pm 2004/01/12 19:53:54 1.460 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.459.2.4 2004/03/19 16:48:37 albertel Exp $ +# $Id: lonnet.pm,v 1.460 2004/01/12 19:53:54 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3792,9 +3792,7 @@ sub packages_tab_default { foreach my $package (split(/,/,$packages)) { my ($pack_type,$pack_part)=split(/_/,$package,2); 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; @@ -4015,7 +4013,7 @@ sub metadata_generate_part0 { my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name. '.display'}; my $expr='\\[Part: '.$allnames{$name}.'\\]'; - $olddis=~s/\Q$expr\E/\[Part: 0\]/; + $olddis=~s/$expr/\[Part: 0\]/; $$metacache{"$key.display"}=$olddis; } } @@ -4429,7 +4427,7 @@ sub filelocation { $location=$file; } else { $file=~s/^$perlvar{'lonDocRoot'}//; - $file=~s:^/res/:/:; + $file=~s:^/*res::; if ( !( $file =~ m:^/:) ) { $location = $dir. '/'.$file; } else { @@ -4443,41 +4441,18 @@ sub filelocation { sub hreflocation { my ($dir,$file)=@_; - unless (($file=~/^http:\/\//i) || ($file=~/^\//)) { - my $finalpath=filelocation($dir,$file); - $finalpath=~s/^\/home\/httpd\/html//; - $finalpath=~s-/home/(\w+)/public_html/-/~$1/-; - return $finalpath; - } else { - return $file; + unless (($file=~m-^http://-i) || ($file=~m-^/-)) { + my $finalpath=filelocation($dir,$file); + $finalpath=~s-^/home/httpd/html--; + $finalpath=~s-/home/(\w+)/public_html/-/~$1/-; + return $finalpath; + } elsif ($file=~m-^/home-) { + $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 sub declutter {