--- loncom/interface/loncommon.pm	2006/11/29 19:33:29	1.476
+++ loncom/interface/loncommon.pm	2006/12/06 11:36:52	1.488
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.476 2006/11/29 19:33:29 raeburn Exp $
+# $Id: loncommon.pm,v 1.488 2006/12/06 11:36:52 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -65,7 +65,7 @@ use Apache::lonhtmlcommon();
 use Apache::loncoursedata();
 use Apache::lontexconvert();
 use Apache::lonclonecourse();
-use LONCAPA;
+use LONCAPA qw(:DEFAULT :match);
 
 my $readit;
 
@@ -157,7 +157,7 @@ BEGIN {
     opendir(DIR,$designdir);
     while ($filename=readdir(DIR)) {
 	if ($filename!~/\.tab$/) { next; }
-	my ($domain)=($filename=~/^(\w+)\./);
+	my ($domain)=($filename=~/^($match_domain)\./);
 	{
 	    my $designfile = $designdir.'/'.$filename;
 	    if ( open (my $fh,"<$designfile") ) {
@@ -1381,17 +1381,18 @@ sub select_form {
 
 sub display_filter {
     if (!$env{'form.show'}) { $env{'form.show'}=10; }
+    if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
     return '<nobr><label>'.&mt('Records [_1]',
 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
 							   (&mt('all'),10,20,50,100,1000,10000))).
-	   '</label></nobr> <nobr><label>'.
+	   '</label></nobr> <nobr>'.
            &mt('Filter [_1]',
-	   &select_form(($env{'form.displayfilter'}?$env{'form.displayfilter'}:'currentfolder'),
-					'displayfilter',
-					('currentfolder' => 'Current folder',
-					 'containing' => 'Containing phrase',
-					 'none' => 'None'))).
-	   '<input type="text" name="containingphrase" size="30" /></label></nobr>';
+	   &select_form($env{'form.displayfilter'},
+			'displayfilter',
+			('currentfolder' => 'Current folder/page',
+			 'containing' => 'Containing phrase',
+			 'none' => 'None'))).
+			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></nobr>';
 }
 
 sub gradeleveldescription {
@@ -2803,30 +2804,77 @@ sub maketime {
 #########################################
 
 sub findallcourses {
-    my ($roles) = @_;
+    my ($roles,$uname,$udom) = @_;
     my %roles;
     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
     my %courses;
     my $now=time;
-    foreach my $key (keys(%env)) {
-	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});
-            my $active=1;
-            if ($starttime) {
-		if ($now<$starttime) { $active=0; }
-            }
-            if ($endtime) {
-                if ($now>$endtime) { $active=0; }
-            }
-            if ($active) {
-                if ($sec eq '') {
-                    $sec = 'none';
+    if (!defined($uname)) {
+        $uname = $env{'user.name'};
+    }
+    if (!defined($udom)) {
+        $udom = $env{'user.domain'};
+    }
+    if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
+        my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
+        if (!%roles) {
+            %roles = (
+                       cc => 1,
+                       in => 1,
+                       ep => 1,
+                       ta => 1,
+                       cr => 1,
+                       st => 1,
+             );
+        }
+        foreach my $entry (keys(%roleshash)) {
+            my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
+            if ($trole =~ /^cr/) { 
+                next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
+            } else {
+                next if (!exists($roles{$trole}));
+            }
+            if ($tend) {
+                next if ($tend < $now);
+            }
+            if ($tstart) {
+                next if ($tstart > $now);
+            }
+            my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
+            (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
+            if ($secpart eq '') {
+                ($cnum,$role) = split(/_/,$cnumpart); 
+                $sec = 'none';
+                $realsec = '';
+            } else {
+                $cnum = $cnumpart;
+                ($sec,$role) = split(/_/,$secpart);
+                $realsec = $sec;
+            }   
+            $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
+        }
+    } else {
+        foreach my $key (keys(%env)) {
+	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
+                 $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
+	        my ($role,$cdom,$cnum,$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});
+                my $active=1;
+                if ($starttime) {
+		    if ($now<$starttime) { $active=0; }
+                }
+                if ($endtime) {
+                    if ($now>$endtime) { $active=0; }
+                }
+                if ($active) {
+                    if ($sec eq '') {
+                        $sec = 'none';
+                    }
+                    $courses{$cdom.'_'.$cnum}{$sec} = 
+                                     $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
                 }
-                $courses{$domain.'_'.$id}{$sec} = 1;
             }
         }
     }
@@ -2836,34 +2884,75 @@ sub findallcourses {
 ###############################################
 
 sub blockcheck {
-    my ($setters,$activity) = @_;
-    # Retrieve active student roles and active course coordinator/instructor roles
+    my ($setters,$activity,$uname,$udom) = @_;
+    # Retrieve active course roles - course coordinator, instructor, exam proctor, ta, student or custom role.
 
-    my %live_courses = &findallcourses();
+    my %live_courses = &findallcourses(undef,$uname,$udom);
 
     # Retrieve blocking times and identity of blocker for active courses
-    # unless user has 'evb' privilege.
+    # of specified user, 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;
+        my ($cdom,$cnum);
+        if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
+            $cdom = $env{'course.'.$course.'.domain'};
+            $cnum = $env{'course.'.$course.'.num'};
+        } else {
+           ($cdom,$cnum) = split(/_/,$course); 
+        }
+        my $no_ownblock = 0;
+        my $no_userblock = 0;
         foreach my $sec (keys(%{$live_courses{$course}})) {
-            my $role = 'cm./'.$cdom.'/'.$cnum;
+            my $checkrole = 'cm./'.$cdom.'/'.$cnum;
             if ($sec ne 'none') {
-                $role .= '/'.$sec;
+                $checkrole .= '/'.$sec;
             }
-            if (&Apache::lonnet::allowed('evb',undef,undef,$role)) {
-                $noblock = 1;
-                last;
+            if ((defined($uname) && ($uname ne $env{'user.name'})) ||
+                 (defined($udom) && ($udom ne $env{'user.domain'}))) { 
+                my ($trole,$tdom,$tnum,$tsec);
+                my $entry = $live_courses{$course}{$sec};
+                if ($entry =~ /^cr/) {
+                    ($trole,$tdom,$tnum,$tsec) = 
+                      ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
+                } else {
+                    ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
+                }
+                my ($spec,$area,$trest,%allroles,%userroles);
+                $area = '/'.$tdom.'/'.$tnum;
+                $trest = $tnum;
+                if ($tsec ne '') {
+                    $area .= '/'.$tsec;
+                    $trest .= '/'.$tsec;
+                }
+                $spec = $trole.'.'.$area;
+                if ($trole =~ /^cr/) {
+                    &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
+                                                      $tdom,$spec,$trest,$area);
+                } else {
+                    &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
+                                                       $tdom,$spec,$trest,$area);
+                }
+                my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
+                if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
+                    if ($1) {
+                        $no_userblock = 1;
+                        last;
+                    }
+                }
+             } else {
+                if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
+                    $no_ownblock = 1;
+                    last;
+                }
             }
         }
         # if they have the evb priv and are currently not playing student
-        next if (($noblock) &&
+        next if (($no_ownblock) &&
                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
+        next if ($no_userblock);
 
         $setters->{$course} = {};
         $setters->{$course}{'staff'} = [];
@@ -3117,7 +3206,7 @@ sub bodytag {
  # role and realm
     my ($role,$realm) = split(/\./,$env{'request.role'},2);
     if ($role  eq 'ca') {
-        my ($rdom,$rname) = ($realm =~ m-^/(\w+)/(\w+)$-);
+        my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
         $realm = &plainname($rname,$rdom).':'.$rdom;
     } 
 # realm
@@ -3623,8 +3712,6 @@ table.LC_whatsnew tr.LC_empty_row td {
 table.LC_whatsnew tr.LC_empty_row td {
   padding: 4ex
 }
-
-
 table.LC_whatsnew {
 }
 
@@ -5137,7 +5224,12 @@ sub record_sep {
             $i++;
         }
     } else {
-        my @allfields=split(/\,/,$record);
+        my @allfields;
+        if ($env{'form.upfiletype'} eq 'semisv') {
+            @allfields=split(/;/,$record);
+        } else {
+            @allfields=split(/\,/,$record);
+        }
         my $i=0;
         my $j;
         for ($j=0;$j<=$#allfields;$j++) {
@@ -5175,6 +5267,7 @@ the file type.
 sub upfile_select_html {
     my %Types = (
                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
+                 semisv => &mt('Semicolon separated values'),
                  space => &mt('Space separated'),
                  tab   => &mt('Tabulator separated'),
 #                 xml   => &mt('HTML/XML'),
@@ -6014,7 +6107,7 @@ sub construct_course {
 #
 # Check if created correctly
 #
-    ($$crsudom,$$crsunum)=($$courseid=~/^\/(\w+)\/(\w+)$/);
+    ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
     $outcome .= &mt('Created on').': '.$crsuhome.'<br>';
 #
@@ -6023,7 +6116,7 @@ sub construct_course {
     my $cloneid='';
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
 	$cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
-        my ($clonecrsudom,$clonecrsunum)=($cloneid=~/^\/(\w+)\/(\w+)$/);
+        my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
 	my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
 	if ($clonehome eq 'no_host') {
 	    $outcome .=
@@ -6196,9 +6289,11 @@ sub construct_course {
 # if specified, key authority is not course, but user
 # only active if keyaccess is yes
     if ($args->{'keyauth'}) {
-	$args->{'keyauth'}=~s/[^\w\@]//g;
-	if ($args->{'keyauth'}) {
-	    $cenv{'keyauth'}=$args->{'keyauth'};
+	my ($user,$domain) = split(':',$args->{'keyauth'});
+	$user = &LONCAPA::clean_username($user);
+	$domain = &LONCAPA::clean_username($domain);
+	if ($user ne '' && $domain ne '') {
+	    $cenv{'keyauth'}=$user.':'.$domain;
 	}
     }