--- loncom/interface/loncommon.pm 2006/12/12 18:47:17 1.493
+++ loncom/interface/loncommon.pm 2007/09/05 05:09:53 1.579
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.493 2006/12/12 18:47:17 albertel Exp $
+# $Id: loncommon.pm,v 1.579 2007/09/05 05:09:53 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,6 +59,7 @@ use Apache::lonnet;
use GDBM_File;
use POSIX qw(strftime mktime);
use Apache::lonmenu();
+use Apache::lonenc();
use Apache::lonlocal;
use HTML::Entities;
use Apache::lonhtmlcommon();
@@ -67,8 +68,12 @@ use Apache::lontexconvert();
use Apache::lonclonecourse();
use LONCAPA qw(:DEFAULT :match);
+# ---------------------------------------------- Designs
+use vars qw(%defaultdesign);
+
my $readit;
+
##
## Global Variables
##
@@ -81,10 +86,6 @@ my %scprtag;
my %fe; my %fd; my %fm;
my %category_extensions;
-# ---------------------------------------------- Designs
-
-my %designhash;
-
# ---------------------------------------------- Thesaurus variables
#
# %Keywords:
@@ -150,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
{
@@ -345,10 +334,12 @@ sub studentbrowser_javascript {
return (<<'ENDSTDBRW');
+RESIZE
+
+}
+
+=pod
+
+=back
+
=head1 Excel and CSV file utility routines
=over 4
@@ -1223,7 +1266,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.
@@ -1264,41 +1307,19 @@ sub create_text_file {
## Home server list generating code ##
###############################################################
-=pod
-
-=head1 Home Server option list generating code
-
-=over 4
-
-=item * get_domains()
-
-Returns an array containing each of the domains listed in the hosts.tab
-file.
-
-=cut
-
-#-------------------------------------------
-sub get_domains {
- # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
- my @domains;
- my %seen;
- foreach my $dom (sort(values(%Apache::lonnet::hostdom))) {
- push(@domains,$dom) unless $seen{$dom}++;
- }
- return @domains;
-}
-
# ------------------------------------------
sub domain_select {
my ($name,$value,$multiple)=@_;
my %domains=map {
- $_ => $_.' '.$Apache::lonnet::domaindescription{$_}
- } &get_domains;
+ $_ => $_.' '. &Apache::lonnet::domain($_,'description')
+ } &Apache::lonnet::all_domains();
if ($multiple) {
$domains{''}=&mt('Any domain');
+ $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
return &multiple_select_form($name,$value,4,\%domains);
} else {
+ $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
return &select_form($name,$value,%domains);
}
}
@@ -1307,6 +1328,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 element int multiple mode
@@ -1314,11 +1341,11 @@ Returns a string containing a e
Args:
$name - name of the element
- $value - sclara or array ref of values that should already be selected
+ $value - scalar or array ref of values that should already be selected
$size - number of rows long the select element is
$hash - the elements should be 'option' => 'shown text'
(shown text should already have been &mt())
- $order - (optional) array ref of the order to show the elments in
+ $order - (optional) array ref of the order to show the elements in
=cut
@@ -1334,8 +1361,16 @@ sub multiple_select_form {
}
}
$output.="\n";
- my @order = ref($order) ? @$order
- : sort(keys(%$hash));
+ my @order;
+ if (ref($order) eq 'ARRAY') {
+ @order = @{$order};
+ } else {
+ @order = sort(keys(%$hash));
+ }
+ if (exists($$hash{'select_form_order'})) {
+ @order = @{$$hash{'select_form_order'}};
+ }
+
foreach my $key (@order) {
$output.='&').'" ';
$output.='selected="selected" ' if ($selected{$key});
@@ -1436,7 +1471,7 @@ sub select_level_form {
=pod
-=item * select_dom_form($defdom,$name,$includeempty)
+=item * select_dom_form($defdom,$name,$includeempty,$showdomdesc)
Returns a string containing a form to
allow a user to select the domain to preform an operation in.
@@ -1445,18 +1480,28 @@ See loncreateuser.pm for an example invo
If the $includeempty flag is set, it also includes an empty choice ("no domain
selected");
+If the $showdomdesc flag is set, the domain name is followed by the domain description.
+
=cut
#-------------------------------------------
sub select_dom_form {
- my ($defdom,$name,$includeempty) = @_;
- my @domains = get_domains();
+ my ($defdom,$name,$includeempty,$showdomdesc) = @_;
+ my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "\n";
foreach my $dom (@domains) {
$selectdomain.="$dom \n";
+ ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
+ if ($showdomdesc) {
+ if ($dom ne '') {
+ my $domdesc = &Apache::lonnet::domain($dom,'description');
+ if ($domdesc ne '') {
+ $selectdomain .= ' ('.$domdesc.')';
+ }
+ }
+ }
+ $selectdomain .= " \n";
}
$selectdomain.=" ";
return $selectdomain;
@@ -1466,30 +1511,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
@@ -1500,7 +1521,7 @@ returns a string which contains an &mt('Public'));
}
@@ -2159,6 +2185,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') {
@@ -2180,6 +2219,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
@@ -2253,11 +2301,25 @@ 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');
}
+# ===================================================== Display a student photo
+
+
+sub student_image_tag {
+ my ($domain,$user)=@_;
+ my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
+ if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
+ return ' ';
+ } else {
+ return '';
+ }
+}
+
=pod
=back
@@ -2473,19 +2535,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;
@@ -2690,7 +2754,8 @@ sub get_student_answers {
}
$moreenv{'grade_target'}='answer';
%moreenv=(%form,%moreenv);
- my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv);
+ $feedurl = &Apache::lonnet::clutter($feedurl);
+ my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
return $userview;
}
@@ -2893,16 +2958,16 @@ sub blockcheck {
$uname = $env{'user.name'};
}
- my ($startblock,$endblock);
-
# If uname and udom are for a course, check for blocks in the course.
if (&Apache::lonnet::is_course($udom,$uname)) {
my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
- ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
+ my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
return ($startblock,$endblock);
}
+ my $startblock = 0;
+ my $endblock = 0;
my %live_courses = &findallcourses(undef,$uname,$udom);
# If uname is for a user, and activity is course-specific, i.e.,
@@ -2940,7 +3005,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}})) {
@@ -2963,8 +3028,6 @@ sub blockcheck {
if ($sec ne 'none') {
$checkrole .= '/'.$sec;
}
- # Resource belongs to user other than current user.
- # Assemble privs for that user, and check for 'evb' priv.
if ($otheruser) {
# Resource belongs to user other than current user.
# Assemble privs for that user, and check for 'evb' priv.
@@ -3014,8 +3077,16 @@ sub blockcheck {
# Retrieve blocking times and identity of blocker for course
# of specified user, unless user has 'evb' privilege.
-
- ($startblock,$endblock)=&get_blocks($setters,$activity,$cdom,$cnum);
+
+ my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
+ if (($start != 0) &&
+ (($startblock == 0) || ($startblock > $start))) {
+ $startblock = $start;
+ }
+ if (($end != 0) &&
+ (($endblock == 0) || ($endblock < $end))) {
+ $endblock = $end;
+ }
}
return ($startblock,$endblock);
}
@@ -3187,7 +3258,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'}; }
@@ -3198,6 +3269,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()
@@ -3211,13 +3336,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 '';
}
@@ -3253,11 +3386,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;
}
###############################################
@@ -3267,7 +3413,7 @@ sub designparm {
=back
-=head1 HTTP Helpers
+=head1 HTML Helpers
=over 4
@@ -3308,6 +3454,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
@@ -3341,7 +3490,7 @@ sub bodytag {
my ($role,$realm) = split(/\./,$env{'request.role'},2);
if ($role eq 'ca') {
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
- $realm = &plainname($rname,$rdom).':'.$rdom;
+ $realm = &plainname($rname,$rdom);
}
# realm
if ($env{'request.course.id'}) {
@@ -3356,19 +3505,14 @@ sub bodytag {
if (!$realm) { $realm=' '; }
# 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);
# 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
@@ -3476,8 +3620,11 @@ ENDROLE
# Top frame rendering, Remote is up
#
- my $upperleft=' ';
+ my $imgsrc = $img;
+ if ($img =~ /^\/adm/) {
+ $imgsrc = &lonhttpdurl($img);
+ }
+ my $upperleft=' ';
# Explicit link to get inline menu
my $menu= ($no_inline_link?''
@@ -3560,20 +3707,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 {
@@ -3590,8 +3729,6 @@ sub endbodytag {
=pod
-=over 4
-
=item * &standard_css()
Returns a style sheet
@@ -3602,8 +3739,6 @@ Inputs: (all optional)
function -> force usage of a specific rolish color scheme
bgcolor -> override the default page bgcolor
-=back
-
=cut
sub standard_css {
@@ -3642,12 +3777,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 {
@@ -4264,16 +4699,12 @@ ADDMETA
=pod
-=over 4
-
=item * &font_settings()
Returns neccessary to set the proper encoding
Inputs: none
-=back
-
=cut
sub font_settings {
@@ -4290,16 +4721,12 @@ sub font_settings {
=pod
-=over 4
-
=item * &xml_begin()
Returns the needed doctype and
Inputs: none
-=back
-
=cut
sub xml_begin {
@@ -4324,16 +4751,12 @@ sub xml_begin {
=pod
-=over 4
-
=item * &endheadtag()
Returns a uniform for LON-CAPA web pages.
Inputs: none
-=back
-
=cut
sub endheadtag {
@@ -4342,8 +4765,6 @@ sub endheadtag {
=pod
-=over 4
-
=item * &head()
Returns a uniform complete .. section for LON-CAPA web pages.
@@ -4351,8 +4772,6 @@ Returns a uniform complete ..
-=back
-
=cut
sub head {
@@ -4362,8 +4781,6 @@ sub head {
=pod
-=over 4
-
=item * &start_page()
Returns a complete .. section for LON-CAPA web pages.
@@ -4402,7 +4819,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
@@ -4455,8 +4874,6 @@ sub start_page {
=pod
-=over 4
-
=item * &head()
Returns a complete section for LON-CAPA web pages.
@@ -4614,10 +5031,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'})) {
@@ -6468,8 +7345,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
#
@@ -6479,7 +7356,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
@@ -6506,9 +7383,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);
}
############################################################
@@ -6537,7 +7415,7 @@ sub group_term {
sub icon {
my ($file)=@_;
- my $curfext = (split(/\./,$file))[-1];
+ my $curfext = lc((split(/\./,$file))[-1]);
my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
my $embstyle = &Apache::loncommon::fileembstyle($curfext);
if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
@@ -6551,10 +7429,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;
}