version 1.458, 2003/12/09 16:22:06
|
version 1.459.2.3, 2004/02/10 19:23:11
|
Line 3703 sub EXT {
|
Line 3703 sub EXT {
|
if ($$result{$courselevel}) { |
if ($$result{$courselevel}) { |
return $$result{$courselevel}; } |
return $$result{$courselevel}; } |
} else { |
} else { |
if ($tmp!~/No such file/) { |
#error 2 occurs when the .db doesn't exist |
|
if ($tmp!~/error: 2 /) { |
&logthis("<font color=blue>WARNING:". |
&logthis("<font color=blue>WARNING:". |
" Trying to get resource data for ". |
" Trying to get resource data for ". |
$uname." at ".$udom.": ". |
$uname." at ".$udom.": ". |
$tmp."</font>"); |
$tmp."</font>"); |
} elsif ($tmp=~/error:No such file/) { |
} elsif ($tmp=~/error: 2 /) { |
&EXT_cache_set($udom,$uname); |
&EXT_cache_set($udom,$uname); |
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
return $tmp; |
return $tmp; |
Line 3791 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) { |
return $packagetab{"$pack_type&$name&default"}; |
if (defined($packagetab{"$pack_type&$name&default"})) { |
|
return $packagetab{"$pack_type&$name&default"}; |
|
} |
} |
} |
} |
} |
return undef; |
return undef; |
Line 4426 sub filelocation {
|
Line 4429 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 4450 sub hreflocation {
|
Line 4453 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 |
# ------------------------------------------------------------- Declutters URLs |
|
|
sub declutter { |
sub declutter { |