--- loncom/interface/loncommon.pm	2007/08/30 16:03:29	1.573
+++ loncom/interface/loncommon.pm	2007/09/12 23:32:59	1.585
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.573 2007/08/30 16:03:29 raeburn Exp $
+# $Id: loncommon.pm,v 1.585 2007/09/12 23:32:59 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -860,7 +860,7 @@ sub help_menu_js {
 					'js_ready'    => 1,
 					'add_entries' => {
 					    'border' => '0',
-					    'rows'   => "105,*",},});
+					    'rows'   => "110,*",},});
     my $end_page =
         &Apache::loncommon::end_page({'frameset' => 1,
 				      'js_ready' => 1,});
@@ -2531,9 +2531,11 @@ sub preferred_languages {
 	@languages=(@languages,
 		    split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}));
     }
-    my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
+    my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
     if ($browser) {
-	@languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
+	my @browser = 
+	    map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
+	push(@languages,@browser);
     }
     if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
 	@languages=(@languages,
@@ -2555,14 +2557,40 @@ sub preferred_languages {
     my @genlanguages;
     foreach my $lang (@languages) {
 	unless ($lang=~/\w/) { next; }
-	push (@genlanguages,$lang);
+	push(@genlanguages,$lang);
 	if ($lang=~/(\-|\_)/) {
 	    push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
 	}
     }
+    #uniqueify the languages list
+    my %count;
+    @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
     return @genlanguages;
 }
 
+sub languages {
+    my ($possible_langs) = @_;
+    my @preferred_langs = &preferred_languages();
+    if (!ref($possible_langs)) {
+	if( wantarray ) {
+	    return @preferred_langs;
+	} else {
+	    return $preferred_langs[0];
+	}
+    }
+    my %possibilities = map { $_ => 1 } (@$possible_langs);
+    my @preferred_possibilities;
+    foreach my $preferred_lang (@preferred_langs) {
+	if (exists($possibilities{$preferred_lang})) {
+	    push(@preferred_possibilities, $preferred_lang);
+	}
+    }
+    if( wantarray ) {
+	return @preferred_possibilities;
+    }
+    return $preferred_possibilities[0];
+}
+
 ###############################################################
 ##               Student Answer Attempts                     ##
 ###############################################################
@@ -2637,25 +2665,15 @@ sub get_previous_attempt {
 	for ($version=1;$version<=$returnhash{'version'};$version++) {
 	  $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
 	    foreach my $key (sort(keys(%lasthash))) {
-	       my $value;
-	       if ($key =~ /timestamp/) {
-		  $value=scalar(localtime($returnhash{$version.':'.$key}));
-	       } else {
-		  $value=$returnhash{$version.':'.$key};
-	       }
-	       $prevattempts.='<td>'.&unescape($value).'&nbsp;</td>';   
+		my $value = &format_previous_attempt_value($key,
+							   $returnhash{$version.':'.$key});
+		$prevattempts.='<td>'.$value.'&nbsp;</td>';   
 	    }
 	 }
       }
       $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
       foreach my $key (sort(keys(%lasthash))) {
-	my $value;
-	if ($key =~ /timestamp/) {
-	  $value=scalar(localtime($lasthash{$key}));
-	} else {
-	  $value=$lasthash{$key};
-	}
-	$value=&unescape($value);
+	my $value = &format_previous_attempt_value($key,$lasthash{$key});
 	if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
 	$prevattempts.='<td>'.$value.'&nbsp;</td>';
       }
@@ -2668,6 +2686,19 @@ sub get_previous_attempt {
   }
 }
 
+sub format_previous_attempt_value {
+    my ($key,$value) = @_;
+    if ($key =~ /timestamp/) {
+	$value = &Apache::lonlocal::locallocaltime($value);
+    } elsif (ref($value) eq 'ARRAY') {
+	$value = '('.join(', ', @{ $value }).')';
+    } else {
+	$value = &unescape($value);
+    }
+    return $value;
+}
+
+
 sub relative_to_absolute {
     my ($url,$output)=@_;
     my $parser=HTML::TokeParser->new(\$output);
@@ -3505,9 +3536,6 @@ sub bodytag {
     if (!$realm) { $realm='&nbsp;'; }
 # Set messages
     my $messages=&domainlogo($domain);
-# Port for miniserver
-    my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
-    if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
 
     my $extra_body_attr = &make_attr_string($forcereg,\%design);
 
@@ -3625,7 +3653,7 @@ ENDROLE
 
     my $imgsrc = $img;
     if ($img =~ /^\/adm/) {
-        $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
+        $imgsrc = &lonhttpdurl($img);
     }
     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
 
@@ -4333,9 +4361,7 @@ table#LC_helpmenu_links a:hover {
   border: 1px solid #8888FF;
   background: #CCCCFF;
 }
-
 table.LC_pick_box {
-  width: 100%;
   border-collapse: separate;
   background: white;
   border: 1px solid black;
@@ -4348,6 +4374,14 @@ table.LC_pick_box td.LC_pick_box_title {
   width: 184px;
   padding: 8px;
 }
+table.LC_pick_box td.LC_pick_box_value {
+  text-align: left;
+  padding: 8px;
+}
+table.LC_pick_box td.LC_pick_box_select {
+  text-align: left;
+  padding: 8px;
+}
 table.LC_pick_box td.LC_pick_box_separator {
   padding: 0px;
   height: 1px;
@@ -4356,7 +4390,48 @@ table.LC_pick_box td.LC_pick_box_separat
 table.LC_pick_box td.LC_pick_box_submit {
   text-align: right;
 }
-
+table.LC_pick_box td.LC_evenrow_value {
+  text-align: left;
+  padding: 8px;
+  background-color: $data_table_light;
+}
+table.LC_pick_box td.LC_oddrow_value {
+  text-align: left;
+  padding: 8px;
+  background-color: $data_table_light;
+}
+table.LC_helpform_receipt {
+  width: 620px;
+  border-collapse: separate;
+  background: white;
+  border: 1px solid black;
+  border-spacing: 1px;
+}
+table.LC_helpform_receipt td.LC_pick_box_title {
+  background: $tabbg;
+  font-weight: bold;
+  text-align: right;
+  width: 184px;
+  padding: 8px;
+}
+table.LC_helpform_receipt td.LC_evenrow_value {
+  text-align: left;
+  padding: 8px;
+  background-color: $data_table_light;
+}
+table.LC_helpform_receipt td.LC_oddrow_value {
+  text-align: left;
+  padding: 8px;
+  background-color: $data_table_light;
+}
+table.LC_helpform_receipt td.LC_pick_box_separator {
+  padding: 0px;
+  height: 1px;
+  background: black;
+}
+span.LC_helpform_receipt_cat {
+  font-weight: bold;
+}
 table.LC_group_priv_box {
   background: white;
   border: 1px solid black;
@@ -4501,6 +4576,10 @@ span.LC_nobreak {
   white-space: nowrap;
 }
 
+span.LC_cusr_emph {
+  font-style: italic;
+}
+
 table.LC_docs_documents {
   background: #BBBBBB;
   border-width: 0px;
@@ -4568,6 +4647,13 @@ table.LC_docs_adddocs th {
   background: #DDDDDD;
 }
 
+table.LC_sty_begin {
+  background: #BBFFBB;
+}
+table.LC_sty_end {
+  background: #FFBBBB;
+}
+
 END
 }
 
@@ -5603,7 +5689,7 @@ sub user_picker {
     my $currdom = $dom;
     my %curr_selected = (
                         srchin => 'dom',
-                        srchby => 'uname',
+                        srchby => 'lastname',
                       );
     my $srchterm;
     if (ref($srch) eq 'HASH') {
@@ -5628,7 +5714,7 @@ sub user_picker {
                     'lastname'  => 'last name',
                     'lastfirst' => 'last name, first name',
                     'crs'       => 'in this course',
-                    'dom'       => 'in selected domain', 
+                    'dom'       => 'in selected LON-CAPA domain', 
                     'alc'       => 'all LON-CAPA',
                     'instd'     => 'in institutional directory for selected domain',
                     'exact'     => 'is',
@@ -5665,7 +5751,7 @@ sub user_picker {
     $srchinsel .= "\n  </select>\n";
 
     my $srchbysel =  ' <select name="srchby">';
-    foreach my $option ('uname','lastname','lastfirst') {
+    foreach my $option ('lastname','lastfirst','uname') {
         if ($curr_selected{'srchby'} eq $option) {
             $srchbysel .= '
    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
@@ -5677,7 +5763,7 @@ sub user_picker {
     $srchbysel .= "\n  </select>\n";
 
     my $srchtypesel = ' <select name="srchtype">';
-    foreach my $option ('exact','begins','contains') {
+    foreach my $option ('begins','contains','exact') {
         if ($curr_selected{'srchtype'} eq $option) {
             $srchtypesel .= '
    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
@@ -5691,7 +5777,12 @@ sub user_picker {
     my ($newuserscript,$new_user_create);
 
     if ($forcenewuser) {
-	$new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';
+        if (ref($srch) eq 'HASH') {
+            if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
+	        $new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';
+            }
+        }
+
         $newuserscript = <<"ENDSCRIPT";
 
 function setSearch(createnew,callingForm) {
@@ -5817,7 +5908,58 @@ END_BLOCK
     return $output;
 }
 
-
+sub username_rule_check {
+    my ($srch,$caller) = @_;
+    my ($response,@curr_rules,%inst_results,$rulematch);
+    my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($srch->{'srchdomain'});
+    if (ref($srch) eq 'HASH') {
+        (my $inst_response,%inst_results) = 
+            &Apache::lonnet::get_instuser($srch->{'srchdomain'},
+                                          $srch->{'srchterm'});
+        my %domconfig = &Apache::lonnet::get_dom('configuration',
+                              ['usercreation'],$srch->{'srchdomain'});
+        if (ref($domconfig{'usercreation'}) eq 'HASH') {
+            if (ref($domconfig{'usercreation'}{'username_rule'}) eq 'ARRAY') {
+                @curr_rules = @{$domconfig{'usercreation'}{'username_rule'}};
+            }
+        }
+        if (@curr_rules > 0) {
+            my $domdesc = &Apache::lonnet::domain($srch->{'srchdomain'},'description');
+            my $instuser_reqd;
+            my %rule_check = &Apache::lonnet::inst_rulecheck($srch->{'srchdomain'},$srch->{'srchterm'},\@curr_rules);
+            foreach my $rule (@curr_rules) {
+                if ($rule_check{$rule}) {
+                    $rulematch = $rule;
+                    if ($inst_response eq 'ok') {
+                        if (keys(%inst_results) == 0) {
+                            if ($caller eq 'new') {
+                                $response = &mt('The username you chose matches the format of usernames defined for <span class="LC_cusr_emph">[_1]</span>, but the user does not exist in the institutional directory.',$domdesc).'<br />'.&mt("You must choose a username with a different format -- one that will not conflict with 'official' institutional usernames.");
+                            }
+                        }
+                    }
+                    last;
+                }
+            }
+            if ($response) {
+                if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
+                    if (@{$ruleorder} > 0) {
+                        $response .= '<br />'.&mt('Usernames with the following format(s) may <span class="LC_cusr_emph">only</span> be used for verified users at [_1]:',$domdesc).' <ul>';
+                        foreach my $rule (@{$ruleorder}) {
+                            if (grep(/^\Q$rule\E$/,@curr_rules)) {
+                                if (ref($rules->{$rule}) eq 'HASH') {
+                                    $response .= '<li>'.$rules->{$rule}{'name'}.': '.
+                                                 $rules->{$rule}{'desc'}.'</li>';
+                                }
+                            }
+                        }
+                    }
+                    $response .= '</ul>';
+                }
+            }
+        }
+    }
+    return ($response,$rulematch,$rules,%inst_results);
+}
 
 =pod
 
@@ -6979,7 +7121,7 @@ sub commit_studentrole {
 ############################################################
 
 sub check_clone {
-    my ($args) = @_;
+    my ($args,$linefeed) = @_;
     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
@@ -6987,8 +7129,7 @@ sub check_clone {
     my $can_clone = 0;
 
     if ($clonehome eq 'no_host') {
-	$clonemsg = &mt('Attempting to clone non-existing [_1]',
-			$args->{'crstype'});
+        $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});     
     } else {
 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
 	if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
@@ -6997,18 +7138,24 @@ sub check_clone {
 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
 						 $args->{'clonedomain'},$args->{'clonecourse'});
 	    my @cloners = split(/,/,$clonehash{'cloners'});
-	    my %roleshash =
-		&Apache::lonnet::get_my_roles($args->{'ccuname'},
-					      $args->{'ccdomain'},'userroles',['active'],['cc'],
-					      [$args->{'clonedomain'}]);
-	    if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
-		$can_clone = 1;
-	    } else {
-		$clonemsg = &mt('The new course was not cloned from an existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+            if (grep(/^\*$/,@cloners)) {
+                $can_clone = 1;
+            } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
+                $can_clone = 1;
+            } else {
+	        my %roleshash =
+		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
+					 $args->{'ccdomain'},
+                                         'userroles',['active'],['cc'],
+					 [$args->{'clonedomain'}]);
+	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
+		    $can_clone = 1;
+	        } else {
+                    $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+	        }
 	    }
-	}
+        }
     }
-
     return ($can_clone, $clonemsg, $cloneid, $clonehome);
 }
 
@@ -7025,9 +7172,11 @@ sub construct_course {
 #
     my ($can_clone, $clonemsg, $cloneid, $clonehome);
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
-	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args);
+	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
 	if ($context ne 'auto') {
-	    $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
+            if ($clonemsg ne '') {
+	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
+            }
 	}
 	$outcome .= $clonemsg.$linefeed;
 
@@ -7371,10 +7520,27 @@ sub icon {
     return &lonhttpdurl($iconname);
 } 
 
-sub lonhttpdurl {
-    my ($url)=@_;
+sub lonhttpd_port {
     my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
     if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
+    # IE doesn't like a secure page getting images from a non-secure
+    # port (when logging we haven't parsed the browser type so default
+    # back to secure
+    if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer')
+	&& $ENV{'SERVER_PORT'} == 443) {
+	return 443;
+    }
+    return $lonhttpd_port;
+
+}
+
+sub lonhttpdurl {
+    my ($url)=@_;
+
+    my $lonhttpd_port = &lonhttpd_port();
+    if ($lonhttpd_port == 443) {
+	return 'https://'.$ENV{'SERVER_NAME'}.$url;
+    }
     return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
 }