[LON-CAPA-cvs] cvs: loncom /auth blockedaccess.pm /interface loncommon.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Sat Mar 31 19:10:55 EDT 2012
raeburn Sat Mar 31 23:10:55 2012 EDT
Modified files:
/loncom/interface loncommon.pm
/loncom/auth blockedaccess.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Bug 6518
- Exam blocks can also block access to specified folders and/or resources
for the duration of an exam.
- Start time for blocking can be based on activation of the timer for
a specific timed quiz item (map or resource-specific). End time for
blocking is then start time plus the duration of the timed interval.
lonnet.pm:
- &rolesinit() now returns an array containing references to hashes
for the following: userroles, firstaccenv, timerintenv.
- New db file: timerinterval.db contains interval which applied when
user activated timer for a map or resource for which time limit applied.
- needed to determine end time for exam blocks which are triggered by
timer activation.
- New routine &get_comm_blocks() used to get communication/collaboration
blocks from a course. Now cached for 10 minutes in memcached.
- New routine: &has_comm_blocking() used to determine if exam block
applies to display of requested content item in a course. Used by
&allowed().
- new routine: &check_docs_block() used by &has_comm_blocking().
loncommon.pm:
- new items added to user's environment by &init_user_environment()
- $env{'course.courseid.firstaccess.symb'} and
$env{'course.courseid.timerinterval.symb'} where symb is the symb
of the resource or map which provides the activation-based block
for access to specific content.
blockedaccess.pm:
- now called when access to content is blocked by an exam block.
duration, and setter of block now available in pop-up from:
&loncommon::blocking_status() for this type of access control.
-------------- next part --------------
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1061 loncom/interface/loncommon.pm:1.1062
--- loncom/interface/loncommon.pm:1.1061 Sat Mar 24 23:35:25 2012
+++ loncom/interface/loncommon.pm Sat Mar 31 23:10:39 2012
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1061 2012/03/24 23:35:25 raeburn Exp $
+# $Id: loncommon.pm,v 1.1062 2012/03/31 23:10:39 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -4076,7 +4076,7 @@
###############################################
sub blockcheck {
- my ($setters,$activity,$uname,$udom) = @_;
+ my ($setters,$activity,$uname,$udom,$url) = @_;
if (!defined($udom)) {
$udom = $env{'user.domain'};
@@ -4088,13 +4088,14 @@
# If uname and udom are for a course, check for blocks in the course.
if (&Apache::lonnet::is_course($udom,$uname)) {
- my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
- my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
- return ($startblock,$endblock);
+ my ($startblock,$endblock,$triggerblock) =
+ &get_blocks($setters,$activity,$udom,$uname,$url);
+ return ($startblock,$endblock,$triggerblock);
}
my $startblock = 0;
my $endblock = 0;
+ my $triggerblock = '';
my %live_courses = &findallcourses(undef,$uname,$udom);
# If uname is for a user, and activity is course-specific, i.e.,
@@ -4209,46 +4210,139 @@
# Retrieve blocking times and identity of locker for course
# of specified user, unless user has 'evb' privilege.
- my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
+ my ($start,$end,$trigger) =
+ &get_blocks($setters,$activity,$cdom,$cnum,$url);
if (($start != 0) &&
(($startblock == 0) || ($startblock > $start))) {
$startblock = $start;
+ if ($trigger ne '') {
+ $triggerblock = $trigger;
+ }
}
if (($end != 0) &&
(($endblock == 0) || ($endblock < $end))) {
$endblock = $end;
+ if ($trigger ne '') {
+ $triggerblock = $trigger;
+ }
}
}
- return ($startblock,$endblock);
+ return ($startblock,$endblock,$triggerblock);
}
sub get_blocks {
- my ($setters,$activity,$cdom,$cnum) = @_;
+ my ($setters,$activity,$cdom,$cnum,$url) = @_;
my $startblock = 0;
my $endblock = 0;
+ my $triggerblock = '';
my $course = $cdom.'_'.$cnum;
$setters->{$course} = {};
$setters->{$course}{'staff'} = [];
$setters->{$course}{'times'} = [];
- my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
- foreach my $record (keys(%records)) {
- my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
- if ($start <= time && $end >= time) {
- my ($staff_name,$staff_dom,$title,$blocks) =
- &parse_block_record($records{$record});
- if ($blocks->{$activity} eq 'on') {
- push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
- push(@{$$setters{$course}{'times'}}, [$start,$end]);
- if ( ($startblock == 0) || ($startblock > $start) ) {
- $startblock = $start;
+ $setters->{$course}{'triggers'} = [];
+ my (@blockers,%triggered);
+ my $now = time;
+ my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
+ if ($activity eq 'docs') {
+ @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
+ foreach my $block (@blockers) {
+ if ($block =~ /^firstaccess____(.+)$/) {
+ my $item = $1;
+ my $type = 'map';
+ my $timersymb = $item;
+ if ($item eq 'course') {
+ $type = 'course';
+ } elsif ($item =~ /___\d+___/) {
+ $type = 'resource';
+ } else {
+ $timersymb = &Apache::lonnet::symbread($item);
+ }
+ my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
+ my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
+ $triggered{$block} = {
+ start => $start,
+ end => $end,
+ type => $type,
+ };
+ }
+ }
+ } else {
+ foreach my $block (keys(%commblocks)) {
+ if ($block =~ m/^(\d+)____(\d+)$/) {
+ my ($start,$end) = ($1,$2);
+ if ($start <= time && $end >= time) {
+ if (ref($commblocks{$block}) eq 'HASH') {
+ if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
+ if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
+ unless(grep(/^\Q$block\E$/, at blockers)) {
+ push(@blockers,$block);
+ }
+ }
+ }
+ }
+ }
+ } elsif ($block =~ /^firstaccess____(.+)$/) {
+ my $item = $1;
+ my $timersymb = $item;
+ my $type = 'map';
+ if ($item eq 'course') {
+ $type = 'course';
+ } elsif ($item =~ /___\d+___/) {
+ $type = 'resource';
+ } else {
+ $timersymb = &Apache::lonnet::symbread($item);
+ }
+ my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
+ my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
+ if ($start && $end) {
+ if (($start <= time) && ($end >= time)) {
+ unless (grep(/^\Q$block\E$/, at blockers)) {
+ push(@blockers,$block);
+ $triggered{$block} = {
+ start => $start,
+ end => $end,
+ type => $type,
+ };
+ }
+ }
}
- if ( ($endblock == 0) || ($endblock < $end) ) {
- $endblock = $end;
+ }
+ }
+ }
+ foreach my $blocker (@blockers) {
+ my ($staff_name,$staff_dom,$title,$blocks) =
+ &parse_block_record($commblocks{$blocker});
+ push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
+ my ($start,$end,$triggertype);
+ if ($blocker =~ m/^(\d+)____(\d+)$/) {
+ ($start,$end) = ($1,$2);
+ } elsif (ref($triggered{$blocker}) eq 'HASH') {
+ $start = $triggered{$blocker}{'start'};
+ $end = $triggered{$blocker}{'end'};
+ $triggertype = $triggered{$blocker}{'type'};
+ }
+ if ($start) {
+ push(@{$$setters{$course}{'times'}}, [$start,$end]);
+ if ($triggertype) {
+ push(@{$$setters{$course}{'triggers'}},$triggertype);
+ } else {
+ push(@{$$setters{$course}{'triggers'}},0);
+ }
+ if ( ($startblock == 0) || ($startblock > $start) ) {
+ $startblock = $start;
+ if ($triggertype) {
+ $triggerblock = $blocker;
}
}
+ if ( ($endblock == 0) || ($endblock < $end) ) {
+ $endblock = $end;
+ if ($triggertype) {
+ $triggerblock = $blocker;
+ }
+ }
}
}
- return ($startblock,$endblock);
+ return ($startblock,$endblock,$triggerblock);
}
sub parse_block_record {
@@ -4272,13 +4366,16 @@
}
sub blocking_status {
- my ($activity,$uname,$udom) = @_;
+ my ($activity,$uname,$udom,$url) = @_;
my %setters;
# check for active blocking
- my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
-
- my $blocked = $startblock && $endblock ? 1 : 0;
+ my ($startblock,$endblock,$triggerblock) =
+ &blockcheck(\%setters,$activity,$uname,$udom,$url);
+ my $blocked = 0;
+ if ($startblock && $endblock) {
+ $blocked = 1;
+ }
# caller just wants to know whether a block is active
if (!wantarray) { return $blocked; }
@@ -4286,8 +4383,12 @@
# build a link to a popup window containing the details
my $querystring = "?activity=$activity";
# $uname and $udom decide whose portfolio the user is trying to look at
- $querystring .= "&udom=$udom" if $udom;
- $querystring .= "&uname=$uname" if $uname;
+ if ($activity eq 'port') {
+ $querystring .= "&udom=$udom" if $udom;
+ $querystring .= "&uname=$uname" if $uname;
+ } elsif ($activity eq 'docs') {
+ $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
+ }
my $output .= <<'END_MYBLOCK';
function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
@@ -4302,7 +4403,10 @@
$output = Apache::lonhtmlcommon::scripttag($output);
my $popupUrl = "/adm/blockingstatus/$querystring";
- my $text = mt('Communication Blocked');
+ my $text = &mt('Communication Blocked');
+ if ($activity eq 'docs') {
+ $text = &mt('Content Access Blocked');
+ }
$output .= <<"END_BLOCK";
<div class='LC_comblock'>
@@ -12622,7 +12726,7 @@
# See if old ID present, if so, remove
- my ($filename,$cookie,$userroles);
+ my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
my $now=time;
if ($public) {
@@ -12660,7 +12764,8 @@
# Initialize roles
- $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
+ ($userroles,$firstaccenv,$timerintenv) =
+ &Apache::lonnet::rolesinit($domain,$username,$authhost);
}
# ------------------------------------ Check browser type and MathML capability
@@ -12735,12 +12840,18 @@
}
$env{'user.environment'} = "$lonids/$cookie.id";
-
+
if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
&GDBM_WRCREAT(),0640)) {
&_add_to_env(\%disk_env,\%initial_env);
&_add_to_env(\%disk_env,\%userenv,'environment.');
&_add_to_env(\%disk_env,$userroles);
+ if (ref($firstaccenv) eq 'HASH') {
+ &_add_to_env(\%disk_env,$firstaccenv);
+ }
+ if (ref($timerintenv) eq 'HASH') {
+ &_add_to_env(\%disk_env,$timerintenv);
+ }
if (ref($args->{'extra_env'})) {
&_add_to_env(\%disk_env,$args->{'extra_env'});
}
Index: loncom/auth/blockedaccess.pm
diff -u loncom/auth/blockedaccess.pm:1.3 loncom/auth/blockedaccess.pm:1.4
--- loncom/auth/blockedaccess.pm:1.3 Fri Feb 13 17:20:26 2009
+++ loncom/auth/blockedaccess.pm Sat Mar 31 23:10:47 2012
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Information about blocking status for Portfolio files
#
-# $Id: blockedaccess.pm,v 1.3 2009/02/13 17:20:26 bisitz Exp $
+# $Id: blockedaccess.pm,v 1.4 2012/03/31 23:10:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,16 +36,27 @@
sub handler {
my $r = shift;
- my $origurl = $r->uri;
- my ($type,$udom,$uname,$file_name,$group) =
- &Apache::lonnet::parse_portfolio_url($origurl);
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK if $r->header_only;
&Apache::lonlocal::get_language_handle($r);
- my ($blocked,$blocktext) =
- &Apache::loncommon::blocking_status('port',$uname,$udom);
+ my $origurl = $r->uri;
+ my ($blocked,$blocktext);
+
+ if (&Apache::lonnet::is_portfolio_url($origurl)) {
+ my ($type,$udom,$uname,$file_name,$group) =
+ &Apache::lonnet::parse_portfolio_url($origurl);
+ ($blocked,$blocktext) =
+ &Apache::loncommon::blocking_status('port',$uname,$udom);
+ } else {
+ if ($env{'request.course.id'}) {
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ ($blocked,$blocktext) =
+ &Apache::loncommon::blocking_status('docs',$cnum,$cdom,$origurl);
+ }
+ }
if ($blocked) {
$r->print(&Apache::loncommon::start_page('Access Temporarily Blocked'));
$r->print($blocktext);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1161 loncom/lonnet/perl/lonnet.pm:1.1162
--- loncom/lonnet/perl/lonnet.pm:1.1161 Tue Mar 20 13:36:22 2012
+++ loncom/lonnet/perl/lonnet.pm Sat Mar 31 23:10:55 2012
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1161 2012/03/20 13:36:22 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 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 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 @@
$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 @@
($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 @@
} 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 @@
$userroles{'user.author'} = $author;
$env{'user.adv'}=$adv;
}
- return \%userroles;
+ return (\%userroles,\%firstaccenv,\%timerintenv);
}
sub set_arearole {
@@ -5997,7 +6044,12 @@
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 @@
$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 @@
$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 @@
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 @@
}
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$/, at 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$/, at 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$/, at 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.
More information about the LON-CAPA-cvs
mailing list