[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