--- loncom/lonnet/perl/lonnet.pm 2012/03/16 21:16:46 1.1160
+++ loncom/lonnet/perl/lonnet.pm 2012/03/31 23:10:55 1.1162
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1160 2012/03/16 21:16:46 www Exp $
+# $Id: lonnet.pm,v 1.1162 2012/03/31 23:10:55 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3907,10 +3907,11 @@ sub load_all_first_access {
}
sub get_first_access {
- my ($type,$argsymb)=@_;
+ my ($type,$argsymb,$argmap)=@_;
my ($symb,$courseid,$udom,$uname)=&whichuser();
if ($argsymb) { $symb=$argsymb; }
my ($map,$id,$res)=&decode_symb($symb);
+ if ($argmap) { $map = $argmap; }
if ($type eq 'course') {
$res='course';
} elsif ($type eq 'map') {
@@ -3923,7 +3924,7 @@ sub get_first_access {
}
sub set_first_access {
- my ($type)=@_;
+ my ($type,$interval)=@_;
my ($symb,$courseid,$udom,$uname)=&whichuser();
my ($map,$id,$res)=&decode_symb($symb);
if ($type eq 'course') {
@@ -3934,9 +3935,22 @@ sub set_first_access {
$res=$symb;
}
$cachedkey='';
- my $firstaccess=&get_first_access($type,$symb);
+ my $firstaccess=&get_first_access($type,$symb,$map);
if (!$firstaccess) {
- return &put('firstaccesstimes',{"$courseid\0$res"=>time},$udom,$uname);
+ my $start = time;
+ my $putres = &put('firstaccesstimes',{"$courseid\0$res"=>$start},
+ $udom,$uname);
+ if ($putres eq 'ok') {
+ &put('timerinterval',{"$courseid\0$res"=>$interval},
+ $udom,$uname);
+ &appenv(
+ {
+ 'course.'.$courseid.'.firstaccess.'.$res => $start,
+ 'course.'.$courseid.'.timerinterval.'.$res => $interval,
+ }
+ );
+ }
+ return $putres;
}
return 'already_set';
}
@@ -4569,8 +4583,20 @@ sub rolesinit {
($rolesdump =~ /^error:/)) {
return \%userroles;
}
+ my %firstaccess = &dump('firstaccesstimes',$domain,$username);
+ my %timerinterval = &dump('timerinterval',$domain,$username);
+ my (%coursetimerstarts,%firstaccchk,%firstaccenv,
+ %coursetimerintervals,%timerintchk,%timerintenv);
+ foreach my $key (keys(%firstaccess)) {
+ my ($cid,$rest) = split(/\0/,$key);
+ $coursetimerstarts{$cid}{$rest} = $firstaccess{$key};
+ }
+ foreach my $key (keys(%timerinterval)) {
+ my ($cid,$rest) = split(/\0/,$key);
+ $coursetimerintervals{$cid}{$rest} = $timerinterval{$key};
+ }
my %allroles=();
- my %allgroups=();
+ my %allgroups=();
if ($rolesdump ne '') {
foreach my $entry (split(/&/,$rolesdump)) {
@@ -4608,6 +4634,27 @@ sub rolesinit {
} else {
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
}
+ if ($trole ne 'gr') {
+ my $cid = $tdomain.'_'.$trest;
+ unless ($firstaccchk{$cid}) {
+ if (ref($coursetimerstarts{$cid}) eq 'HASH') {
+ foreach my $item (keys(%{$coursetimerstarts{$cid}})) {
+ $firstaccenv{'course.'.$cid.'.firstaccess.'.$item} =
+ $coursetimerstarts{$cid}{$item};
+ }
+ }
+ $firstaccchk{$cid} = 1;
+ }
+ unless ($timerintchk{$cid}) {
+ if (ref($coursetimerintervals{$cid}) eq 'HASH') {
+ foreach my $item (keys(%{$coursetimerintervals{$cid}})) {
+ $timerintenv{'course.'.$cid.'.timerinterval.'.$item} =
+ $coursetimerintervals{$cid}{$item};
+ }
+ }
+ $timerintchk{$cid} = 1;
+ }
+ }
}
}
}
@@ -4616,7 +4663,7 @@ sub rolesinit {
$userroles{'user.author'} = $author;
$env{'user.adv'}=$adv;
}
- return \%userroles;
+ return (\%userroles,\%firstaccenv,\%timerintenv);
}
sub set_arearole {
@@ -5997,7 +6044,12 @@ sub allowed {
if ($match) {
if ($env{'user.priv.'.$env{'request.role'}.'./'}
=~/\Q$priv\E\&([^\:]*)/) {
- $thisallowed.=$1;
+ my @blockers = &has_comm_blocking($priv,$symb,$uri);
+ if (@blockers > 0) {
+ $thisallowed = 'B';
+ } else {
+ $thisallowed.=$1;
+ }
}
} else {
my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri};
@@ -6008,7 +6060,12 @@ sub allowed {
$refuri=&declutter($refuri);
my ($match) = &is_on_map($refuri);
if ($match) {
- $thisallowed='F';
+ my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+ if (@blockers > 0) {
+ $thisallowed = 'B';
+ } else {
+ $thisallowed='F';
+ }
}
}
}
@@ -6060,7 +6117,17 @@ sub allowed {
$statecond=$cond;
if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid}
=~/\Q$priv\E\&([^\:]*)/) {
- $thisallowed.=$1;
+ my $value = $1;
+ if ($priv eq 'bre') {
+ my @blockers = &has_comm_blocking($priv,$symb,$uri);
+ if (@blockers > 0) {
+ $thisallowed = 'B';
+ } else {
+ $thisallowed.=$value;
+ }
+ } else {
+ $thisallowed.=$value;
+ }
$checkreferer=0;
}
}
@@ -6088,7 +6155,17 @@ sub allowed {
my $refstatecond=$cond;
if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid}
=~/\Q$priv\E\&([^\:]*)/) {
- $thisallowed.=$1;
+ my $value = $1;
+ if ($priv eq 'bre') {
+ my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+ if (@blockers > 0) {
+ $thisallowed = 'B';
+ } else {
+ $thisallowed.=$value;
+ }
+ } else {
+ $thisallowed.=$value;
+ }
$uri=$refuri;
$statecond=$refstatecond;
}
@@ -6247,6 +6324,152 @@ sub allowed {
}
return 'F';
}
+
+sub get_comm_blocks {
+ my ($cdom,$cnum) = @_;
+ if ($cdom eq '' || $cnum eq '') {
+ return unless ($env{'request.course.id'});
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ }
+ my %commblocks;
+ my $hashid=$cdom.'_'.$cnum;
+ my ($blocksref,$cached)=&is_cached_new('comm_block',$hashid);
+ if ((defined($cached)) && (ref($blocksref) eq 'HASH')) {
+ %commblocks = %{$blocksref};
+ } else {
+ %commblocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
+ my $cachetime = 600;
+ &do_cache_new('comm_block',$hashid,\%commblocks,$cachetime);
+ }
+ return %commblocks;
+}
+
+sub has_comm_blocking {
+ my ($priv,$symb,$uri,$blocks) = @_;
+ return unless ($env{'request.course.id'});
+ return unless ($priv eq 'bre');
+ return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
+ my %commblocks;
+ if (ref($blocks) eq 'HASH') {
+ %commblocks = %{$blocks};
+ } else {
+ %commblocks = &get_comm_blocks();
+ }
+ return unless (keys(%commblocks) > 0);
+ if (!$symb) { $symb=&symbread($uri,1); }
+ my ($map,$resid,undef)=&decode_symb($symb);
+ my %tocheck = (
+ maps => $map,
+ resources => $symb,
+ );
+ my @blockers;
+ my $now = time;
+ foreach my $block (keys(%commblocks)) {
+ if ($block =~ /^(\d+)____(\d+)$/) {
+ my ($start,$end) = ($1,$2);
+ if ($start <= $now && $end >= $now) {
+ if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
+ if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
+ if (ref($commblocks{$block}{'blocks'}{'docs'}{'maps'}) eq 'HASH') {
+ if ($commblocks{$block}{'blocks'}{'docs'}{'maps'}{$map}) {
+ unless (grep(/^\Q$block\E$/,@blockers)) {
+ push(@blockers,$block);
+ }
+ }
+ }
+ if (ref($commblocks{$block}{'blocks'}{'docs'}{'resources'}) eq 'HASH') {
+ if ($commblocks{$block}{'blocks'}{'docs'}{'resources'}{$symb}) {
+ unless (grep(/^\Q$block\E$/,@blockers)) {
+ push(@blockers,$block);
+ }
+ }
+ }
+ }
+ }
+ }
+ } elsif ($block =~ /^firstaccess____(.+)$/) {
+ my $item = $1;
+ if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
+ if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
+ my $check_interval;
+ if (&check_docs_block($commblocks{$block}{'blocks'}{'docs'},\%tocheck)) {
+ my @interval;
+ my $type = 'map';
+ if ($item eq 'course') {
+ $type = 'course';
+ @interval=&EXT("resource.0.interval");
+ } else {
+ if ($item =~ /___\d+___/) {
+ $type = 'resource';
+ @interval=&EXT("resource.0.interval",$item);
+ } else {
+ my $mapsymb = &symbread($item,1);
+ if ($mapsymb) {
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (ref($navmap)) {
+ my $mapres = $navmap->getBySymb($mapsymb);
+ my @resources = $mapres->retrieveResources($mapres,undef,0,1);
+ foreach my $res (@resources) {
+ my $symb = $res->symb();
+ next if ($symb eq $mapsymb);
+ if ($symb ne '') {
+ @interval=&EXT("resource.0.interval",$symb);
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ if ($interval[0] =~ /\d+/) {
+ my $first_access;
+ if ($type eq 'resource') {
+ $first_access=&get_first_access($interval[1],$item);
+ } elsif ($type eq 'map') {
+ $first_access=&get_first_access($interval[1],undef,$item);
+ } else {
+ $first_access=&get_first_access($interval[1]);
+ }
+ if ($first_access) {
+ my $timesup = $first_access+$interval[0];
+ if ($timesup > $now) {
+ unless (grep(/^\Q$block\E$/,@blockers)) {
+ push(@blockers,$block);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return @blockers;
+}
+
+sub check_docs_block {
+ my ($docsblock,$tocheck) =@_;
+ if ((ref($docsblock) ne 'HASH') || (ref($tocheck) ne 'HASH')) {
+ return;
+ }
+ if (ref($docsblock->{'maps'}) eq 'HASH') {
+ if ($tocheck->{'maps'}) {
+ if ($docsblock->{'maps'}{$tocheck->{'maps'}}) {
+ return 1;
+ }
+ }
+ }
+ if (ref($docsblock->{'resources'}) eq 'HASH') {
+ if ($tocheck->{'resources'}) {
+ if ($docsblock->{'resources'}{$tocheck->{'resources'}}) {
+ return 1;
+ }
+ }
+ }
+ return;
+}
+
#
# Removes the versino from a URI and
# splits it in to its filename and path to the filename.
@@ -9424,6 +9647,7 @@ sub gettitle {
if ($title) {
# Remember both $symb and $title for dynamic metadata
$accesshash{$symb.'___crstitle'}=$title;
+ $accesshash{&declutter($map).'___'.&declutter($url).'___usage'}=time;
# Cache this title and then return it
return &do_cache_new('title',$key,$title,600);
}