--- loncom/lonnet/perl/lonnet.pm 2007/12/25 04:02:00 1.936 +++ loncom/lonnet/perl/lonnet.pm 2008/02/21 10:04:35 1.942 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.936 2007/12/25 04:02:00 raeburn Exp $ +# $Id: lonnet.pm,v 1.942 2008/02/21 10:04:35 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1650,9 +1650,21 @@ sub absolute_url { return $protocol.$host_name; } +# +# Server side include. +# Parameters: +# fn Possibly encrypted resource name/id. +# form Hash that describes how the rendering should be done +# and other things. +# r Optional reference that will be given the response. +# This is mostly provided so that the caller can implement +# error detection, recovery and retry policies. +# +# Returns: +# The content of the response. sub ssi { - my ($fn,%form)=@_; + my ($fn,%form, $r)=@_; my $ua=new LWP::UserAgent; @@ -1670,6 +1682,10 @@ sub ssi { $request->header(Cookie => $ENV{'HTTP_COOKIE'}); my $response=$ua->request($request); + if ($r) { + $$r = $response; + } + return $response->content; } @@ -2399,7 +2415,11 @@ sub get_course_adv_roles { my %coursehash=&coursedescription($cid); my %nothide=(); foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { - $nothide{join(':',split(/[\@\:]/,$user))}=1; + if ($user !~ /:/) { + $nothide{join(':',split(/[\@]/,$user))}=1; + } else { + $nothide{$user}=1; + } } my %returnhash=(); my %dumphash= @@ -2427,15 +2447,25 @@ sub get_course_adv_roles { } sub get_my_roles { - my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec)=@_; + my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec,$hidepriv)=@_; unless (defined($uname)) { $uname=$env{'user.name'}; } unless (defined($udom)) { $udom=$env{'user.domain'}; } - my %dumphash; + my (%dumphash,%nothide); if ($context eq 'userroles') { %dumphash = &dump('roles',$udom,$uname); } else { %dumphash= &dump('nohist_userroles',$udom,$uname); + if ($hidepriv) { + my %coursehash=&coursedescription($udom.'_'.$uname); + foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { + if ($user !~ /:/) { + $nothide{join(':',split(/[\@]/,$user))} = 1; + } else { + $nothide{$user} = 1; + } + } + } } my %returnhash=(); my $now=time; @@ -2448,7 +2478,7 @@ sub get_my_roles { } if (($tstart) && ($tstart<0)) { next; } my $status = 'active'; - if (($tend) && ($tend<$now)) { + if (($tend) && ($tend<=$now)) { $status = 'previous'; } if (($tstart) && ($now<$tstart)) { @@ -2486,6 +2516,12 @@ sub get_my_roles { } } } + if ($hidepriv) { + if ((&privileged($username,$domain)) && + (!$nothide{$username.':'.$domain})) { + next; + } + } if ($withsec) { $returnhash{$username.':'.$domain.':'.$role.':'.$section} = $tstart.':'.$tend; @@ -3507,7 +3543,7 @@ sub set_userprivs { } foreach my $role (keys(%{$allroles})) { my %thesepriv; - if (($role=~/^au/) || ($role=~/^ca/)) { $author=1; } + if (($role=~/^au/) || ($role=~/^ca/) || ($role=~/^aa/)) { $author=1; } foreach my $item (split(/:/,$$allroles{$role})) { if ($item ne '') { my ($privilege,$restrictions)=split(/&/,$item); @@ -6697,7 +6733,7 @@ sub EXT { if ($part eq '') { $part='0'; } my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, $symbparm,$udom,$uname,$section,1); - if (@partgeneral) { return &get_reply(\@partgeneral); } + if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); } } if ($recurse) { return undef; } my $pack_def=&packages_tab_default($filename,$varname); @@ -6731,10 +6767,14 @@ sub EXT { sub get_reply { my ($reply_value) = @_; - if (wantarray) { - return @$reply_value; + if (ref($reply_value) eq 'ARRAY') { + if (wantarray) { + return @$reply_value; + } + return $reply_value->[0]; + } else { + return $reply_value; } - return $reply_value->[0]; } sub check_group_parms {