--- loncom/interface/loncommon.pm	2006/11/23 00:04:09	1.473
+++ loncom/interface/loncommon.pm	2006/11/29 07:46:39	1.474
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.473 2006/11/23 00:04:09 raeburn Exp $
+# $Id: loncommon.pm,v 1.474 2006/11/29 07:46:39 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2792,8 +2792,9 @@ sub findallcourses {
     my %courses;
     my $now=time;
     foreach my $key (keys(%env)) {
-	if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)} ) {
-	    my ($role,$domain,$id) = ($1,$2,$3);
+	if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)/?(\w*)$} ||
+             $key=~m{^user\.role\.(cr/\w+/\w+/\w+)\./(\w+)/(\w+)}) {
+	    my ($role,$domain,$id,$sec) = ($1,$2,$3,$4);
 	    next if ($role eq 'ca' || $role eq 'aa');
 	    next if (%roles && !exists($roles{$role}));
 	    my ($starttime,$endtime)=split(/\./,$env{$key});
@@ -2804,13 +2805,131 @@ sub findallcourses {
             if ($endtime) {
                 if ($now>$endtime) { $active=0; }
             }
-            if ($active) { $courses{$domain.'_'.$id}=1; }
+            if ($active) {
+                if ($sec eq '') {
+                    $sec = 'none';
+                }
+                $courses{$domain.'_'.$id}{$sec} = 1;
+            }
         }
     }
-    return keys(%courses);
+    return %courses;
 }
 
 ###############################################
+
+sub blockcheck {
+    my ($setters,$activity) = @_;
+    # Retrieve active student roles and active course coordinator/instructor roles
+
+    my %live_courses = &findallcourses();
+
+    # Retrieve blocking times and identity of blocker for active courses
+    # unless user has 'evb' privilege.
+
+    my $startblock = 0;
+    my $endblock = 0;
+
+    foreach my $course (keys(%live_courses)) {
+        my $cdom = $env{'course.'.$course.'.domain'};
+        my $cnum = $env{'course.'.$course.'.num'};
+        my $noblock = 0;
+        foreach my $sec (keys(%{$live_courses{$course}})) {
+            my $role = 'cm./'.$cdom.'/'.$cnum;
+            if ($sec ne 'none') {
+                $role .= '/'.$sec;
+            }
+            if (&Apache::lonnet::allowed('evb',undef,undef,$role)) {
+                $noblock = 1;
+                last;
+            }
+        }
+        # if they have the evb priv and are currently not playing student
+        next if (($noblock) &&
+                 ($env{'request.role'} !~ m{^st\./$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 > $1) ) {
+                        $startblock = $1;
+                    }
+                    if ( ($endblock == 0) || ($endblock < $2) ) {
+                        $endblock = $2;
+                    }
+                }
+            }
+        }
+    }
+    return ($startblock,$endblock);
+}
+
+sub parse_block_record {
+    my ($record) = @_;
+    my ($setuname,$setudom,$title,$blocks);
+    if (ref($record) eq 'HASH') {
+        ($setuname,$setudom) = split(/:/,$record->{'setter'});
+        $title = &unescape($record->{'event'});
+        $blocks = $record->{'blocks'};
+
+    } else {
+        my @data = split(/:/,$record,3);
+        if (scalar(@data) eq 2) {
+            $title = $data[1];
+            ($setuname,$setudom) = split(/@/,$data[0]);
+        } else {
+            ($setuname,$setudom,$title) = @data;
+        }
+        $blocks = { 'com' => 'on' };
+    }
+    return ($setuname,$setudom,$title,$blocks);
+}
+
+sub build_block_table {
+    my ($startblock,$endblock,$setters) = @_;
+    my %lt = &Apache::lonlocal::texthash(
+        'cacb' => 'Currently active communication blocks',
+        'cour' => 'Course',
+        'dura' => 'Duration',
+        'blse' => 'Block set by'
+    );
+    my $output;
+    $output = '<br /><br />'.$lt{'cacb'}.':<br /><br />';
+    $output .= &start_data_table();
+    $output .= '
+<tr>
+ <th>'.$lt{'cour'}.'</th>
+ <th>'.$lt{'dura'}.'</th>
+ <th>'.$lt{'blse'}.'</th>
+</tr>
+';
+    foreach my $course (keys(%{$setters})) {
+        my %courseinfo=&Apache::lonnet::coursedescription($course);
+        for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
+            my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
+            my $fullname = &Apache::loncommon::plainname($uname,$udom);
+            my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
+            $openblock = &Apache::lonlocal::locallocaltime($openblock);
+            $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
+            $output .= &Apache::loncommon::start_data_table_row().
+                       '<td>'.$courseinfo{'description'}.'</td>'.
+                       '<td>'.$openblock.' to '.$closeblock.'</td>'.
+                       '<td>'.$fullname.' ('.$uname.':'.$udom.
+                       ')</td>'.
+                        &Apache::loncommon::end_data_table_row();
+        }
+    }
+    $output .= &end_data_table();
+}
+
 ###############################################
 
 =pod