--- loncom/lonnet/perl/lonnet.pm 2004/03/19 16:48:37 1.459.2.4 +++ loncom/lonnet/perl/lonnet.pm 2004/01/26 21:58:34 1.464 @@ -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.464 2004/01/26 21:58:34 albertel 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 { @@ -4015,7 +4045,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; } } @@ -4443,41 +4473,19 @@ 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; } + 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 {