--- loncom/lonnet/perl/lonnet.pm 2008/01/01 20:27:20 1.937 +++ 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.937 2008/01/01 20:27:20 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; } @@ -2462,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)) { @@ -3527,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); @@ -6717,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); @@ -6751,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 {