--- loncom/lonnet/perl/lonnet.pm 2004/02/10 19:23:11 1.459.2.3 +++ loncom/lonnet/perl/lonnet.pm 2004/01/13 16:29:41 1.461 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.459.2.3 2004/02/10 19:23:11 albertel Exp $ +# $Id: lonnet.pm,v 1.461 2004/01/13 16:29:41 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2127,6 +2127,36 @@ sub coursedescription { return %returnhash; } +# -------------------------------------------------See if a user is privileged + +sub privileged { + my ($username,$domain)=@_; + my $rolesdump=&reply("dump:$domain:$username:roles", + &homeserver($username,$domain)); + if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; } + my $now=time; + if ($rolesdump ne '') { + foreach (split(/&/,$rolesdump)) { + if ($_!~/^rolesdef\&/) { + my ($area,$role)=split(/=/,$_); + $area=~s/\_\w\w$//; + my ($trole,$tend,$tstart)=split(/_/,$role); + if (($trole eq 'dc') || ($trole eq 'su')) { + my $active=1; + if ($tend) { + if ($tend<$now) { $active=0; } + } + if ($tstart) { + if ($tstart>$now) { $active=0; } + } + if ($active) { return 1; } + } + } + } + } + return 0; +} + # -------------------------------------------------------- Get user privileges sub rolesinit { @@ -3792,9 +3822,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; @@ -4429,7 +4457,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 +4471,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 {