--- loncom/lonnet/perl/lonnet.pm 2006/12/09 23:33:56 1.813 +++ loncom/lonnet/perl/lonnet.pm 2006/12/28 17:36:51 1.815 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.813 2006/12/09 23:33:56 albertel Exp $ +# $Id: lonnet.pm,v 1.815 2006/12/28 17:36:51 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,7 +53,6 @@ use Time::HiRes qw( gettimeofday tv_inte use Cache::Memcached; use Digest::MD5; use Math::Random; -use lib '/home/httpd/lib/perl'; use LONCAPA qw(:DEFAULT :match); use LONCAPA::Configuration; @@ -878,6 +877,25 @@ sub devalidate_getsection_cache { &devalidate_cache_new('getsection',$hashid); } +sub courseid_to_courseurl { + my ($courseid) = @_; + #already url style courseid + return $courseid if ($courseid =~ m{^/}); + + if (exists($env{'course.'.$courseid.'.num'})) { + my $cnum = $env{'course.'.$courseid.'.num'}; + my $cdom = $env{'course.'.$courseid.'.domain'}; + return "/$cdom/$cnum"; + } + + my %courseinfo=&Apache::lonnet::coursedescription($courseid); + if (exists($courseinfo{'num'})) { + return "/$courseinfo{'domain'}/$courseinfo{'num'}"; + } + + return undef; +} + sub getsection { my ($udom,$unam,$courseid)=@_; my $cachetime=1800; @@ -901,6 +919,7 @@ sub getsection { # If there is more than one expired role, choose the one which ended last. # If there is a role which has expired, return it. # + $courseid = &courseid_to_courseurl($courseid); foreach my $line (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles', &homeserver($unam,$udom)))) { my ($key,$value)=split(/\=/,$line,2); @@ -3303,6 +3322,22 @@ sub portfolio_access { my ($requrl) = @_; my (undef,$udom,$unum,$file_name,$group) = &parse_portfolio_url($requrl); my $result = &get_portfolio_access($udom,$unum,$file_name,$group); + if ($result) { + my %setters; + if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') { + my ($startblock,$endblock) = + &Apache::loncommon::blockcheck(\%setters,'port',$unum,$udom); + if ($startblock && $endblock) { + return 'B'; + } + } else { + my ($startblock,$endblock) = + &Apache::loncommon::blockcheck(\%setters,'port'); + if ($startblock && $endblock) { + return 'B'; + } + } + } if ($result eq 'ok') { return 'F'; } elsif ($result =~ /^[^:]+:guest_/) { @@ -3583,7 +3618,14 @@ sub allowed { my ($space,$domain,$name,@dir)=split('/',$uri); if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && ($env{'user.domain'} eq $domain) && ('portfolio' eq $dir[0])) { - return 'F'; + my %setters; + my ($startblock,$endblock) = + &Apache::loncommon::blockcheck(\%setters,'port'); + if ($startblock && $endblock) { + return 'B'; + } else { + return 'F'; + } } # bre access to group portfolio for rgf priv in group, or mdg or vcg in course. @@ -3859,6 +3901,8 @@ sub allowed { unless ($env{'request.course.id'}) { if ($thisallowed eq 'A') { return 'A'; + } elsif ($thisallowed eq 'B') { + return 'B'; } else { return '1'; } @@ -3926,6 +3970,8 @@ sub allowed { if ($thisallowed eq 'A') { return 'A'; + } elsif ($thisallowed eq 'B') { + return 'B'; } return 'F'; }