--- loncom/interface/loncommon.pm 2007/02/05 18:40:41 1.506
+++ loncom/interface/loncommon.pm 2007/08/18 00:01:37 1.565
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.506 2007/02/05 18:40:41 raeburn Exp $
+# $Id: loncommon.pm,v 1.565 2007/08/18 00:01:37 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
{
@@ -346,10 +334,12 @@ sub studentbrowser_javascript {
return (<<'ENDSTDBRW');
+RESIZE
+
+}
+
+=pod
+
+=back
+
=head1 Excel and CSV file utility routines
=over 4
@@ -1224,7 +1276,7 @@ sub create_workbook {
=item * create_text_file
-Create a file to write to and eventually make available to the usre.
+Create a file to write to and eventually make available to the user.
If file creation fails, outputs an error message on the request object and
return undefs.
@@ -1265,41 +1317,19 @@ sub create_text_file {
## Home server \n";
}
$selectdomain.="";
return $selectdomain;
@@ -1475,30 +1521,6 @@ sub select_dom_form {
=pod
-=item * get_library_servers($domain)
-
-Returns a hash which contains keys like '103l3' and values like
-'kirk.lite.msu.edu'. All of the keys will be for machines in the
-given $domain.
-
-=cut
-
-#-------------------------------------------
-sub get_library_servers {
- my $domain = shift;
- my %library_servers;
- foreach my $hostid (keys(%Apache::lonnet::libserv)) {
- if ($Apache::lonnet::hostdom{$hostid} eq $domain) {
- $library_servers{$hostid} = $Apache::lonnet::hostname{$hostid};
- }
- }
- return %library_servers;
-}
-
-#-------------------------------------------
-
-=pod
-
=item * home_server_option_list($domain)
returns a string which contains an ';
+ } else {
+ return '';
+ }
+}
+
=pod
=back
@@ -2482,19 +2545,21 @@ sub preferred_languages {
if ($browser) {
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
}
- if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) {
+ if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
@languages=(@languages,
- $Apache::lonnet::domain_lang_def{$env{'user.domain'}});
+ &Apache::lonnet::domain($env{'user.domain'},
+ 'lang_def'));
}
- if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) {
+ if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
@languages=(@languages,
- $Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});
+ &Apache::lonnet::domain($env{'request.role.domain'},
+ 'lang_def'));
}
- if ($Apache::lonnet::domain_lang_def{
- $Apache::lonnet::perlvar{'lonDefDomain'}}) {
+ if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
+ 'lang_def')) {
@languages=(@languages,
- $Apache::lonnet::domain_lang_def{
- $Apache::lonnet::perlvar{'lonDefDomain'}});
+ &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
+ 'lang_def'));
}
# turn "en-ca" into "en-ca,en"
my @genlanguages;
@@ -2700,7 +2765,6 @@ sub get_student_answers {
$moreenv{'grade_target'}='answer';
%moreenv=(%form,%moreenv);
$feedurl = &Apache::lonnet::clutter($feedurl);
- &Apache::lonenc::check_encrypt(\$feedurl);
my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
return $userview;
}
@@ -2951,7 +3015,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}})) {
@@ -3204,7 +3268,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'}; }
@@ -3215,6 +3279,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()
@@ -3228,13 +3346,21 @@ 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 '
';
- } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
- return $Apache::lonnet::domaindescription{$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 =~ m{^/(adm|res)/}) {
+ if ($imgsrc =~ m{^/res/}) {
+ my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
+ &Apache::lonnet::repcopy($local_name);
+ }
+ $imgsrc = &lonhttpdurl($imgsrc);
+ }
+ return '
';
+ } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
+ return &Apache::lonnet::domain($domain,'description');
} else {
return '';
}
@@ -3270,11 +3396,24 @@ 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 =~ m{^/(adm|res)/}) {
+ if ($output =~ m{^/res/}) {
+ my $local_name = &Apache::lonnet::filelocation('',$output);
+ &Apache::lonnet::repcopy($local_name);
+ }
+ $output = &lonhttpdurl($output);
+ }
+ }
+ return $output;
}
###############################################
@@ -3284,7 +3423,7 @@ sub designparm {
=back
-=head1 HTTP Helpers
+=head1 HTML Helpers
=over 4
@@ -3325,6 +3464,9 @@ Inputs:
=item * $args, optional argument valid values are
no_auto_mt_title -> prevents &mt()ing the title arg
+ inherit_jsmath -> when creating popup window in a page,
+ should it have jsmath forced on by the
+ current page
=back
@@ -3381,11 +3523,9 @@ sub bodytag {
# construct main body tag
my $bodytag = "".
- &Apache::lontexconvert::init_math_support();
+ &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
- if ($bodyonly
- || ($env{'request.state'} eq 'construct'
- && $env{'environment.remote'} ne 'off' )) {
+ if ($bodyonly) {
return $bodytag;
} elsif ($env{'browser.interface'} eq 'textual') {
# Accessibility
@@ -3493,8 +3633,11 @@ ENDROLE
# Top frame rendering, Remote is up
#
- my $upperleft='
';
+ my $imgsrc = $img;
+ if ($img =~ /^\/adm/) {
+ $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
+ }
+ my $upperleft='
';
# Explicit link to get inline menu
my $menu= ($no_inline_link?''
@@ -3577,20 +3720,12 @@ sub make_attr_string {
=pod
-=back
-
-=head1 HTML Helpers
-
-=over 4
-
=item * &endbodytag()
Returns a uniform footer for LON-CAPA web pages.
Inputs: none
-=back
-
=cut
sub endbodytag {
@@ -3607,8 +3742,6 @@ sub endbodytag {
=pod
-=over 4
-
=item * &standard_css()
Returns a style sheet
@@ -3619,8 +3752,6 @@ Inputs: (all optional)
function -> force usage of a specific rolish color scheme
bgcolor -> override the default page bgcolor
-=back
-
=cut
sub standard_css {
@@ -3659,12 +3790,21 @@ sub standard_css {
my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
: '0px 3px 0px 4px';
+
return <