--- loncom/interface/loncommon.pm 2007/03/08 01:58:44 1.514 +++ loncom/interface/loncommon.pm 2007/04/16 22:50:44 1.523 @@ -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.523 2007/04/16 22:50:44 albertel 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 { @@ -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 \n"; foreach my $dom (@domains) { @@ -1473,8 +1467,6 @@ sub home_server_option_list { =pod -=back - =cut ############################################################### @@ -3184,6 +3176,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 +3243,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 ''.$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 ''.$domain.''; } elsif (defined(&Apache::lonnet::domain($domain,'description'))) { return &Apache::lonnet::domain($domain,'description'); } else { @@ -3239,11 +3289,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; } ############################################### @@ -3462,8 +3521,11 @@ ENDROLE # Top frame rendering, Remote is up # - my $upperleft=''.$function.''; + my $imgsrc = $img; + if ($img =~ /^\/adm/) { + $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img; + } + my $upperleft=''.$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 <