--- loncom/interface/loncommon.pm	2007/03/08 01:58:44	1.514
+++ loncom/interface/loncommon.pm	2007/05/29 17:48:44	1.536
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.514 2007/03/08 01:58:44 albertel Exp $
+# $Id: loncommon.pm,v 1.536 2007/05/29 17:48:44 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -68,8 +68,12 @@ use Apache::lontexconvert();
 use Apache::lonclonecourse();
 use LONCAPA qw(:DEFAULT :match);
 
+# ---------------------------------------------- Designs
+use vars qw(%defaultdesign);
+
 my $readit;
 
+
 ##
 ## Global Variables
 ##
@@ -82,10 +86,6 @@ my %scprtag;
 my %fe; my %fd; my %fm;
 my %category_extensions;
 
-# ---------------------------------------------- Designs
-
-my %designhash;
-
 # ---------------------------------------------- Thesaurus variables
 #
 # %Keywords:
@@ -151,30 +151,18 @@ BEGIN {
         }
     }
 
-# -------------------------------------------------------------- domain designs
-
-    my $filename;
+# -------------------------------------------------------------- default domain designs
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
-    opendir(DIR,$designdir);
-    while ($filename=readdir(DIR)) {
-	if ($filename!~/\.tab$/) { next; }
-	my ($domain)=($filename=~/^($match_domain)\./);
-	{
-	    my $designfile = $designdir.'/'.$filename;
-	    if ( open (my $fh,"<$designfile") ) {
-		while (my $line = <$fh>) {
-		    next if ($line =~ /^\#/);
-		    chomp($line);
-		    my ($key,$val)=(split(/\=/,$line));
-		    if ($val) { $designhash{$domain.'.'.$key}=$val; }
-		}
-		close($fh);
-	    }
-	}
-
+    my $designfile = $designdir.'/default.tab';
+    if ( open (my $fh,"<$designfile") ) {
+        while (my $line = <$fh>) {
+            next if ($line =~ /^\#/);
+            chomp($line);
+            my ($key,$val)=(split(/\=/,$line));
+            if ($val) { $defaultdesign{$key}=$val; }
+        }
+        close($fh);
     }
-    closedir(DIR);
-
 
 # ------------------------------------------------------------- file categories
     {
@@ -252,7 +240,7 @@ Inputs: formname, elementname
 
 formname and elementname specify the name of the html form and the name
 of the element the selection from the search results will be placed in.
-
+=back
 =cut
 
 sub browser_and_searcher_javascript {
@@ -1284,6 +1272,12 @@ sub domain_select {
 
 =pod
 
+=head1 Routines for form select boxes
+
+=over 4
+
+=cut
+
 =item * multiple_select_form($name,$value,$size,$hash,$order)
 
 Returns a string containing a <select> element int multiple mode
@@ -1435,7 +1429,7 @@ selected");
 #-------------------------------------------
 sub select_dom_form {
     my ($defdom,$name,$includeempty) = @_;
-    my @domains = &Apache::lonnet::all_domains();
+    my @domains = sort(&Apache::lonnet::all_domains());
     if ($includeempty) { @domains=('',@domains); }
     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
     foreach my $dom (@domains) {
@@ -1473,7 +1467,7 @@ sub home_server_option_list {
 
 =pod
 
-=back
+=back 
 
 =cut
 
@@ -2920,7 +2914,7 @@ sub blockcheck {
         }
         my $no_ownblock = 0;
         my $no_userblock = 0;
-        if ($otheruser) {
+        if ($otheruser && $activity ne 'com') {
             # Check if current user has 'evb' priv for this
             if (defined($own_courses{$course})) {
                 foreach my $sec (keys(%{$own_courses{$course}})) {
@@ -3173,7 +3167,7 @@ Returns: Determines which domain should
 ###############################################
 sub determinedomain {
     my $domain=shift;
-   if (! $domain) {
+    if (! $domain) {
         # Determine domain if we have not been given one
         $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
@@ -3184,6 +3178,60 @@ sub determinedomain {
     return $domain;
 }
 ###############################################
+
+sub devalidate_domconfig_cache {
+    my ($udom)=@_;
+    &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
+}
+
+# ---------------------- Get domain configuration for a domain
+sub get_domainconf {
+    my ($udom) = @_;
+    my $cachetime=1800;
+    my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
+    if (defined($cached)) { return %{$result}; }
+
+    my %domconfig = &Apache::lonnet::get_dom('configuration',
+					     ['login','rolecolors'],$udom);
+    my %designhash;
+    if (keys(%domconfig) > 0) {
+        if (ref($domconfig{'login'}) eq 'HASH') {
+            foreach my $key (keys(%{$domconfig{'login'}})) {
+                $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
+            }
+        }
+        if (ref($domconfig{'rolecolors'}) eq 'HASH') {
+            foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
+                if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
+                    foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
+                        $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
+                    }
+                }
+            }
+        }
+    } else {
+        my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
+        my $designfile =  $designdir.'/'.$udom.'.tab';
+        if (-e $designfile) {
+            if ( open (my $fh,"<$designfile") ) {
+                while (my $line = <$fh>) {
+                    next if ($line =~ /^\#/);
+                    chomp($line);
+                    my ($key,$val)=(split(/\=/,$line));
+                    if ($val) { $designhash{$udom.'.'.$key}=$val; }
+                }
+                close($fh);
+            }
+        }
+        if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
+            $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
+        }
+    }
+    &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
+				  $cachetime);
+    return %designhash;
+}
+
 =pod
 
 =item * &domainlogo()
@@ -3197,11 +3245,15 @@ If the domain logo does not exist, a des
 
 ###############################################
 sub domainlogo {
-    my $domain = &determinedomain(shift);    
-     # See if there is a logo
-    if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
-	my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");
-        return '<img src="'.$logo.'" alt="'.$domain.'" />';
+    my $domain = &determinedomain(shift);
+    my %designhash = &get_domainconf($domain);    
+    # See if there is a logo
+    if ($designhash{$domain.'.login.domlogo'} ne '') {
+        my $imgsrc = $designhash{$domain.'.login.domlogo'};
+        if ($imgsrc =~ /^\/(adm|res)/) {
+            $imgsrc = &lonhttpdurl($imgsrc);
+        } 
+        return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
         return &Apache::lonnet::domain($domain,'description');
     } else {
@@ -3239,11 +3291,20 @@ sub designparm {
 	return $env{'environment.color.'.$which};
     }
     $domain=&determinedomain($domain);
-    if (exists($designhash{$domain.'.'.$which})) {
-	return $designhash{$domain.'.'.$which};
+    my %domdesign = &get_domainconf($domain);
+    my $output;
+    if ($domdesign{$domain.'.'.$which} ne '') {
+	$output = $domdesign{$domain.'.'.$which};
     } else {
-        return $designhash{'default.'.$which};
+        $output = $defaultdesign{$which};
+    }
+    if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
+        ($which =~ /login\.(img|logo|domlogo)/)) {
+        if ($output =~ /^\/(adm|res)\//) {
+            $output = &lonhttpdurl($output);
+        }
     }
+    return $output;
 }
 
 ###############################################
@@ -3352,9 +3413,7 @@ sub bodytag {
     my $bodytag = "<body $extra_body_attr>".
 	&Apache::lontexconvert::init_math_support();
 
-    if ($bodyonly 
-	|| ($env{'request.state'} eq 'construct' 
-	    && $env{'environment.remote'} ne 'off' )) {
+    if ($bodyonly) {
         return $bodytag;
     } elsif ($env{'browser.interface'} eq 'textual') {
 # Accessibility
@@ -3462,8 +3521,11 @@ ENDROLE
 # Top frame rendering, Remote is up
 #
 
-    my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
-        $lonhttpdPort.$img.'" alt="'.$function.'" />';
+    my $imgsrc = $img;
+    if ($img =~ /^\/adm/) {
+        $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
+    }
+    my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
 
     # Explicit link to get inline menu
     my $menu= ($no_inline_link?''
@@ -3628,20 +3690,18 @@ sub standard_css {
     my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
 	                                              : '0px 3px 0px 4px';
 
+
     return <<END;
 h1, h2, h3, th { font-family: $sans }
 a:focus { color: red; background: yellow } 
 table.thinborder,
-table.LC_optres_prior {
-  border-collapse: collapse;
-}
+
 table.thinborder tr th {
   border-style: solid;
   border-width: 1px;
   background: $tabbg;
 }
-table.thinborder tr td, 
-table.LC_optres_prior tr td {
+table.thinborder tr td {
   border-style: solid;
   border-width: 1px
 }
@@ -3657,6 +3717,8 @@ form, .inline { display: inline; }
 .LC_diff_removed {
   color: red;
 }
+
+.LC_info,
 .LC_success,
 .LC_diff_added {
   color: green;
@@ -3665,6 +3727,10 @@ form, .inline { display: inline; }
   border: 0px;
 }
 
+.LC_internal_info {
+  color: #999;
+}
+
 table.LC_pastsubmission {
   border: 1px solid black;
   margin: 2px;
@@ -3726,7 +3792,7 @@ table#LC_title_bar td.LC_title_bar_role_
 }
 
 table#LC_menubuttons_mainmenu {
-  background: $pgbg;
+  width: 100%;
   border: 0px;
   border-spacing: 1px;
   padding: 0px 1px;
@@ -3781,19 +3847,37 @@ td.LC_table_cell_checkbox {
   text-align: center;
 }
 
+table#LC_mainmenu td.LC_mainmenu_column {
+    vertical-align: top;
+}
+
 .LC_menubuttons_inline_text {
   color: $font;
   font-family: $sans;
   font-size: smaller;
 }
 
+.LC_menubuttons_link {
+  text-decoration: none;
+}
+
+.LC_menubuttons_category {
+  color: $font;
+  background: $pgbg;
+  font-family: $sans;
+  font-size: larger;
+  font-weight: bold;
+}
+
 td.LC_menubuttons_text {
+  width: 90%;
   color: $font;
   font-family: $sans;
 }
+
 td.LC_menubuttons_img {
-  background: $tabbg;
 }
+
 .LC_current_location {
   font-family: $sans;
   background: $tabbg;
@@ -3803,6 +3887,45 @@ td.LC_menubuttons_img {
   font-weight: bold;
 }
 
+.LC_rolesmenu_is {
+  font-family: $sans;
+}
+
+.LC_rolesmenu_selected {
+  font-family: $sans;
+}
+
+.LC_rolesmenu_future {
+  font-family: $sans;
+}
+
+
+.LC_rolesmenu_will {
+  font-family: $sans;
+}
+
+.LC_rolesmenu_will_not {
+  font-family: $sans;
+}
+
+.LC_rolesmenu_expired {
+  font-family: $sans;
+}
+
+.LC_rolesinfo {
+  font-family: $sans;
+}
+
+.LC_dropadd_labeltext {
+  font-family: $sans;
+  text-align: right;
+}
+
+.LC_preferences_labeltext {
+  font-family: $sans;
+  text-align: right;
+}
+
 table.LC_aboutme_port {
   border: 0px;
   border-collapse: collapse;
@@ -3828,7 +3951,8 @@ table.LC_nested {
   border-spacing: 0px;
   width: 100%;
 }
-table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th {
+table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
+table.LC_prior_tries tr th {
   font-weight: bold;
   background-color: $data_table_head;
   font-size: smaller;
@@ -4205,6 +4329,75 @@ span.LC_feedback_link {
     font-size: larger;
 }
 
+table.LC_prior_tries {
+  border: 1px solid #000000;
+  border-collapse: separate;
+  border-spacing: 1px;
+}
+
+table.LC_prior_tries td {
+  padding: 2px;
+}
+
+.LC_answer_correct {
+  background: #AAFFAA;
+  color: black;
+}
+.LC_answer_charged_try {
+  background: #FFAAAA ! important;
+  color: black;
+}
+.LC_answer_not_charged_try, 
+.LC_answer_no_grade,
+.LC_answer_late {
+  background: #FFFFAA;
+  color: black;
+}
+.LC_answer_previous {
+  background: #AAAAFF;
+  color: black;
+}
+.LC_answer_no_message {
+  background: #FFFFFF;
+  color: black;
+}
+.LC_answer_unknown {
+  background: orange;
+  color: black;
+}
+
+
+span.LC_prior_numerical,
+span.LC_prior_string,
+span.LC_prior_custom,
+span.LC_prior_reaction,
+span.LC_prior_math {
+  font-family: monospace;
+  white-space: pre;
+}
+
+span.LC_prior_string {
+  font-family: monospace;
+  white-space: pre;
+}
+
+table.LC_prior_option {
+  width: 100%;
+  border-collapse: collapse;
+}
+table.LC_prior_rank, table.LC_prior_match {
+  border-collapse: collapse;
+}
+table.LC_prior_option tr td,
+table.LC_prior_rank tr td,
+table.LC_prior_match tr td {
+  border: 1px solid #000000;
+}
+
+span.LC_nobreak {
+    white-space: nowrap;
+}
+
 END
 }
 
@@ -5034,11 +5227,18 @@ Incoming parameters:
 2. user's domain
 
 Returns:
-1. Disk quota (in Mb) assigned to student. 
+1. Disk quota (in Mb) assigned to student.
+2. (Optional) Type of setting: custom or default
+   (individually assigned or default for user's 
+   institutional status).
+3. (Optional) - User's institutional status (e.g., faculty, staff
+   or student - types as defined in localenroll::inst_usertypes 
+   for user's domain, which determines default quota for user.
+4. (Optional) - Default quota which would apply to the user.
 
 If a value has been stored in the user's environment, 
-it will return that, otherwise it returns the default
-for users in the domain.
+it will return that, otherwise it returns the maximal default
+defined for the user's instituional status(es) in the domain.
 
 =cut
 
@@ -5047,7 +5247,7 @@ for users in the domain.
 
 sub get_user_quota {
     my ($uname,$udom) = @_;
-    my $quota;
+    my ($quota,$quotatype,$settingstatus,$defquota);
     if (!defined($udom)) {
         $udom = $env{'user.domain'};
     }
@@ -5057,23 +5257,38 @@ sub get_user_quota {
     if (($udom eq '' || $uname eq '') ||
         ($udom eq 'public') && ($uname eq 'public')) {
         $quota = 0;
+        $quotatype = 'default';
+        $defquota = 0; 
     } else {
+        my $inststatus;
         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
             $quota = $env{'environment.portfolioquota'};
+            $inststatus = $env{'environment.inststatus'};
         } else {
-            my %userenv = &Apache::lonnet::dump('environment',$udom,$uname);
+            my %userenv = 
+                &Apache::lonnet::get('environment',['portfolioquota',
+                                     'inststatus'],$udom,$uname);
             my ($tmp) = keys(%userenv);
             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                 $quota = $userenv{'portfolioquota'};
+                $inststatus = $userenv{'inststatus'};
             } else {
                 undef(%userenv);
             }
         }
+        ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
         if ($quota eq '') {
-            $quota = &default_quota($udom);
+            $quota = $defquota;
+            $quotatype = 'default';
+        } else {
+            $quotatype = 'custom';
         }
     }
-    return $quota;
+    if (wantarray) {
+        return ($quota,$quotatype,$settingstatus,$defquota);
+    } else {
+        return $quota;
+    }
 }
 
 ###############################################
@@ -5082,32 +5297,68 @@ sub get_user_quota {
 
 =item * &default_quota()
 
-Retrieves default quota assigned for storage of user portfolio files
+Retrieves default quota assigned for storage of user portfolio files,
+given an (optional) user's institutional status.
 
 Incoming parameters:
 1. domain
+2. (Optional) institutional status(es).  This is a : separated list of 
+   status types (e.g., faculty, staff, student etc.)
+   which apply to the user for whom the default is being retrieved.
+   If the institutional status string in undefined, the domain
+   default quota will be returned. 
 
 Returns:
 1. Default disk quota (in Mb) for user portfolios in the domain.
+2. (Optional) institutional type which determined the value of the
+   default quota.
 
 If a value has been stored in the domain's configuration db,
 it will return that, otherwise it returns 20 (for backwards 
 compatibility with domains which have not set up a configuration
 db file; the original statically defined portfolio quota was 20 Mb). 
 
+If the user's status includes multiple types (e.g., staff and student),
+the largest default quota which applies to the user determines the
+default quota returned.
+
 =cut
 
 ###############################################
 
 
 sub default_quota {
-    my ($udom) = @_;
-    my %defaults = &Apache::lonnet::get_dom('configuration',
-                                            ['portfolioquota'],$udom);
-    if ($defaults{'portfolioquota'} ne '') {
-        return $defaults{'portfolioquota'};
+    my ($udom,$inststatus) = @_;
+    my ($defquota,$settingstatus);
+    my %quotahash = &Apache::lonnet::get_dom('configuration',
+                                            ['quota'],$udom);
+    if (ref($quotahash{'quota'}) eq 'HASH') {
+        if ($inststatus ne '') {
+            my @statuses = split(/:/,$inststatus);
+            foreach my $item (@statuses) {
+                if ($quotahash{'quota'}{$item} ne '') {
+                    if ($defquota eq '') {
+                        $defquota = $quotahash{'quota'}{$item};
+                        $settingstatus = $item;
+                    } elsif ($quotahash{'quota'}{$item} > $defquota) {
+                        $defquota = $quotahash{'quota'}{$item};
+                        $settingstatus = $item;
+                    }
+                }
+            }
+        }
+        if ($defquota eq '') {
+            $defquota = $quotahash{'quota'}{'default'};
+            $settingstatus = 'default';
+        }
+    } else {
+        $settingstatus = 'default';
+        $defquota = 20;
+    }
+    if (wantarray) {
+        return ($defquota,$settingstatus);
     } else {
-        return '20';
+        return $defquota;
     }
 }