--- loncom/lonnet/perl/lonnet.pm 2003/12/09 16:22:06 1.458 +++ loncom/lonnet/perl/lonnet.pm 2004/03/19 16:48:37 1.459.2.4 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.458 2003/12/09 16:22:06 matthew Exp $ +# $Id: lonnet.pm,v 1.459.2.4 2004/03/19 16:48:37 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3703,12 +3703,13 @@ sub EXT { if ($$result{$courselevel}) { return $$result{$courselevel}; } } else { - if ($tmp!~/No such file/) { + #error 2 occurs when the .db doesn't exist + if ($tmp!~/error: 2 /) { &logthis("WARNING:". " Trying to get resource data for ". $uname." at ".$udom.": ". $tmp.""); - } elsif ($tmp=~/error:No such file/) { + } elsif ($tmp=~/error: 2 /) { &EXT_cache_set($udom,$uname); } elsif ($tmp =~ /^(con_lost|no_such_host)/) { return $tmp; @@ -3791,7 +3792,9 @@ sub packages_tab_default { foreach my $package (split(/,/,$packages)) { my ($pack_type,$pack_part)=split(/_/,$package,2); if ($pack_part eq $part) { - return $packagetab{"$pack_type&$name&default"}; + if (defined($packagetab{"$pack_type&$name&default"})) { + return $packagetab{"$pack_type&$name&default"}; + } } } return undef; @@ -4012,7 +4015,7 @@ sub metadata_generate_part0 { my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name. '.display'}; my $expr='\\[Part: '.$allnames{$name}.'\\]'; - $olddis=~s/$expr/\[Part: 0\]/; + $olddis=~s/\Q$expr\E/\[Part: 0\]/; $$metacache{"$key.display"}=$olddis; } } @@ -4426,7 +4429,7 @@ sub filelocation { $location=$file; } else { $file=~s/^$perlvar{'lonDocRoot'}//; - $file=~s:^/*res::; + $file=~s:^/res/:/:; if ( !( $file =~ m:^/:) ) { $location = $dir. '/'.$file; } else { @@ -4450,6 +4453,31 @@ sub hreflocation { } } + +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 {