--- loncom/lonnet/perl/lonnet.pm 2007/12/21 04:32:49 1.934 +++ loncom/lonnet/perl/lonnet.pm 2008/04/04 16:58:44 1.941.2.2 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.934 2007/12/21 04:32:49 raeburn Exp $ +# $Id: lonnet.pm,v 1.941.2.2 2008/04/04 16:58:44 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1631,12 +1631,21 @@ sub ssi_body { if (! exists($form{'LONCAPA_INTERNAL_no_discussion'})) { $form{'LONCAPA_INTERNAL_no_discussion'}='true'; } - my $output=($filelink=~/^http\:/?&externalssi($filelink): - &ssi($filelink,%form)); + my $output=''; + my $response; + if ($filelink=~/^http\:/) { + ($output,$response)=&externalssi($filelink); + } else { + ($output,$response)=&ssi($filelink,%form); + } $output=~s|//(\s*)?\s||gs; $output=~s/^.*?\]*\>//si; $output=~s/\<\/body\s*\>.*?$//si; - return $output; + if (wantarray) { + return ($output, $response); + } else { + return $output; + } } # --------------------------------------------------------- Server Side Include @@ -1650,12 +1659,20 @@ 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. +# Returns: +# Scalar context: The content of the response. +# Array context: 2 element list of the content and the full response object. +# sub ssi { my ($fn,%form)=@_; - my $ua=new LWP::UserAgent; - my $request; $form{'no_update_last_known'}=1; @@ -1670,7 +1687,11 @@ sub ssi { $request->header(Cookie => $ENV{'HTTP_COOKIE'}); my $response=$ua->request($request); - return $response->content; + if (wantarray) { + return ($response->content, $response); + } else { + return $response->content; + } } sub externalssi { @@ -1678,7 +1699,11 @@ sub externalssi { my $ua=new LWP::UserAgent; my $request=new HTTP::Request('GET',$url); my $response=$ua->request($request); - return $response->content; + if (wantarray) { + return ($response->content, $response); + } else { + return $response->content; + } } # -------------------------------- Allow a /uploaded/ URI to be vouched for @@ -2200,10 +2225,10 @@ sub flushcourselogs { } } $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = { - 'description' => &escape($coursedescrbuf{$crsid}), - 'inst_code' => &escape($courseinstcodebuf{$crsid}), - 'type' => &escape($coursetypebuf{$crsid}), - 'owner' => &escape($courseownerbuf{$crsid}), + 'description' => $coursedescrbuf{$crsid}, + 'inst_code' => $courseinstcodebuf{$crsid}, + 'type' => $coursetypebuf{$crsid}, + 'owner' => $courseownerbuf{$crsid}, }; } # @@ -2399,7 +2424,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 +2456,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 +2487,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 +2525,12 @@ sub get_my_roles { } } } + if ($hidepriv) { + if ((&privileged($username,$domain)) && + (!$nothide{$username.':'.$domain})) { + next; + } + } if ($withsec) { $returnhash{$username.':'.$domain.':'.$role.':'.$section} = $tstart.':'.$tend; @@ -2555,7 +2600,7 @@ sub courseidput { foreach my $cid (keys(%$storehash)) { $what .= &escape($cid).'='; foreach my $item ('description','inst_code','owner','type') { - $what .= &escape($storehash->{$item}).':'; + $what .= &escape($storehash->{$cid}{$item}).':'; } $what =~ s/\:$/&/; } @@ -3507,7 +3552,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 +6742,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 +6776,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 { @@ -8867,7 +8916,7 @@ explanation of a user role term =item * -get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) : +get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) : All arguments are optional. Returns a hash of a roles, either for co-author/assistant author roles for a user's Construction Space (default), or if $context is 'userroles', roles for the user himself,