--- loncom/lonnet/perl/lonnet.pm 2006/12/09 23:33:56 1.813 +++ loncom/lonnet/perl/lonnet.pm 2006/12/28 19:59:48 1.816 @@ -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.816 2006/12/28 19:59:48 raeburn 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'; } @@ -4467,7 +4513,8 @@ sub get_users_groups { @usersgroups = split(/:/,$grouplist); } else { $grouplist = ''; - my %roleshash = &dump('roles',$udom,$uname,$courseid); + my $courseurl = &courseid_to_courseurl($courseid); + my %roleshash = &dump('roles',$udom,$uname,$courseurl); my ($tmp) = keys(%roleshash); if ($tmp=~/^error:/) { &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom); @@ -4476,7 +4523,7 @@ sub get_users_groups { '.default_enrollment_end_date'}; my $now = time; foreach my $key (keys(%roleshash)) { - if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) { + if ($key =~ /^\Q$courseurl\E\/(\w+)\_gr$/) { my $group = $1; if ($roleshash{$key} =~ /_(\d+)_(\d+)$/) { my $start = $2;