--- loncom/interface/loncommon.pm 2007/02/28 21:45:43 1.509
+++ loncom/interface/loncommon.pm 2007/08/28 15:55:49 1.571
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.509 2007/02/28 21:45:43 albertel Exp $
+# $Id: loncommon.pm,v 1.571 2007/08/28 15:55:49 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
{
@@ -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
list to be used in a
@@ -1509,7 +1531,7 @@ returns a string which contains an &mt('Public'));
}
@@ -2168,6 +2195,19 @@ sub getnames {
}
}
+# -------------------------------------------------------------------- getemails
+=pod
+
+=item * getemails($uname,$udom)
+
+Gets a user's email information and returns it as a hash with keys:
+notification, critnotification, permanentemail
+
+For notification and critnotification, values are comma-separated lists
+of e-mail address(es); for permanentemail, value is a single e-mail address.
+
+=cut
+
sub getemails {
my ($uname,$udom)=@_;
if ($udom eq 'public' && $uname eq 'public') {
@@ -2189,6 +2229,15 @@ sub getemails {
}
}
+sub flush_email_cache {
+ my ($uname,$udom)=@_;
+ if (!$udom) { $udom =$env{'user.domain'}; }
+ if (!$uname) { $uname=$env{'user.name'}; }
+ return if ($udom eq 'public' && $uname eq 'public');
+ my $id=$uname.':'.$udom;
+ &Apache::lonnet::devalidate_cache_new('emailscache',$id);
+}
+
# ------------------------------------------------------------------ Screenname
=pod
@@ -2262,7 +2311,8 @@ sub track_student_link {
$target = '';
}
if ($start) { $link.='&start='.$start; }
-
+ $title = &mt($title);
+ $linktext = &mt($linktext);
return qq{$linktext}.
&help_open_topic('View_recent_activity');
}
@@ -2495,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;
@@ -2713,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;
}
@@ -2964,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}})) {
@@ -3217,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'}; }
@@ -3228,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()
@@ -3241,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 '';
}
@@ -3283,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;
}
###############################################
@@ -3297,7 +3423,7 @@ sub designparm {
=back
-=head1 HTTP Helpers
+=head1 HTML Helpers
=over 4
@@ -3338,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
@@ -3394,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
@@ -3506,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?''
@@ -3590,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 {
@@ -3620,8 +3742,6 @@ sub endbodytag {
=pod
-=over 4
-
=item * &standard_css()
Returns a style sheet
@@ -3632,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 {
@@ -3672,12 +3790,21 @@ sub standard_css {
my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
: '0px 3px 0px 4px';
+
return < prevent &mt()ing the title arg
-=back
-
=cut
sub headtag {
@@ -4325,16 +4661,12 @@ ADDMETA
=pod
-=over 4
-
=item * &font_settings()
Returns neccessary to set the proper encoding
Inputs: none
-=back
-
=cut
sub font_settings {
@@ -4351,16 +4683,12 @@ sub font_settings {
=pod
-=over 4
-
=item * &xml_begin()
Returns the needed doctype and
Inputs: none
-=back
-
=cut
sub xml_begin {
@@ -4385,16 +4713,12 @@ sub xml_begin {
=pod
-=over 4
-
=item * &endheadtag()
Returns a uniform for LON-CAPA web pages.
Inputs: none
-=back
-
=cut
sub endheadtag {
@@ -4403,8 +4727,6 @@ sub endheadtag {
=pod
-=over 4
-
=item * &head()
Returns a uniform complete .. section for LON-CAPA web pages.
@@ -4412,8 +4734,6 @@ Returns a uniform complete ..
-=back
-
=cut
sub head {
@@ -4423,8 +4743,6 @@ sub head {
=pod
-=over 4
-
=item * &start_page()
Returns a complete .. section for LON-CAPA web pages.
@@ -4463,7 +4781,9 @@ Inputs: $title - optional title for the
no_auto_mt_title -> prevent &mt()ing the title arg
-=back
+ inherit_jsmath -> when creating popup window in a page,
+ should it have jsmath forced on by the
+ current page
=cut
@@ -4516,8 +4836,6 @@ sub start_page {
=pod
-=over 4
-
=item * &head()
Returns a complete section for LON-CAPA web pages.
@@ -4675,10 +4993,61 @@ sub simple_error_page {
}
}
+=pod
+
+=item * &inhibit_menu_check($arg)
+
+Checks for a inhibitmenu state and generates output to preserve it
+
+Inputs: $arg - can be any of
+ - undef - in which case the return value is a string
+ to add into arguments list of a uri
+ - 'input' - in which case the return value is a HTML
+
';
+ my $krb_msg = &mt('As you did not include the default Kerberos domain to be used for authentication in this class, the institutional data used by the automated enrollment process must include the Kerberos domain for each new student');
+ if ($context eq 'auto') {
+ $outcome .= $krb_msg;
+ } else {
+ $outcome .= ''.$krb_msg.'';
+ }
+ $outcome .= $linefeed;
}
}
if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
@@ -6535,8 +7294,8 @@ sub construct_course {
# By default, use standard grading
if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
- $outcome .= (' '.&mt('Setting environment').': '.
- &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).' ');
+ $outcome .= $linefeed.&mt('Setting environment').': '.
+ &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
#
# Open all assignments
#
@@ -6546,7 +7305,7 @@ sub construct_course {
$storeunder.'.type' => 'date_start');
$outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
- ('resourcedata',\%storecontent,$$crsudom,$$crsunum).' ';
+ ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
}
#
# Set first page
@@ -6573,9 +7332,10 @@ sub construct_course {
(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
if ($errtext) { $fatal=2; }
- $outcome .= ($fatal?$errtext:'write ok').' ';
+ $outcome .= ($fatal?$errtext:'write ok').$linefeed;
}
- return $outcome;
+
+ return (1,$outcome);
}
############################################################