'.
- &mt('Field').' '.&mt('Samples').' ');
+ $r->print(&start_data_table().
+ &start_data_table_header_row().''.
+ &mt('Field').' '.&mt('Samples').' '.
+ &end_data_table_header_row());
foreach my $key (sort(keys(%{ $samples->[0] }))) {
- $r->print('print(&start_data_table_row().'');
foreach my $option (@$d) {
my ($value,$display,$defaultcol)=@{ $option };
@@ -5417,9 +7234,10 @@ sub csv_samples_select_table {
$r->print($samples->[$line]{$key}." \n");
}
}
- $r->print(' ');
+ $r->print(''.&end_data_table_row());
$i++;
}
+ $r->print(&end_data_table());
$i--;
return($i);
}
@@ -5918,21 +7736,26 @@ a hash ref describing the data to be sto
Returns: both routines return nothing
+=back
+
=cut
#######################################################
#######################################################
sub store_course_settings {
+ return &store_settings($env{'request.course.id'},@_);
+}
+
+sub store_settings {
# save to the environment
# appenv the same items, just to be safe
- my $courseid = $env{'request.course.id'};
my $udom = $env{'user.domain'};
my $uname = $env{'user.name'};
- my ($prefix,$Settings) = @_;
+ my ($context,$prefix,$Settings) = @_;
my %SaveHash;
my %AppHash;
while (my ($setting,$type) = each(%$Settings)) {
- my $basename = join('.','internal',$courseid,$prefix,$setting);
+ my $basename = join('.','internal',$context,$prefix,$setting);
my $envname = 'environment.'.$basename;
if (exists($env{'form.'.$setting})) {
# Save this value away
@@ -5972,11 +7795,14 @@ sub store_course_settings {
}
sub restore_course_settings {
- my $courseid = $env{'request.course.id'};
- my ($prefix,$Settings) = @_;
+ return &restore_settings($env{'request.course.id'},@_);
+}
+
+sub restore_settings {
+ my ($context,$prefix,$Settings) = @_;
while (my ($setting,$type) = each(%$Settings)) {
next if (exists($env{'form.'.$setting}));
- my $envname = 'environment.internal.'.$courseid.'.'.$prefix.
+ my $envname = 'environment.internal.'.$context.'.'.$prefix.
'.'.$setting;
if (exists($env{$envname})) {
if ($type eq 'scalar') {
@@ -5992,12 +7818,82 @@ sub restore_course_settings {
}
}
+#######################################################
+#######################################################
+
+=pod
+
+=head1 Domain E-mail Routines
+
+=over 4
+
+=item &build_recipient_list
+
+Build recipient lists for three types of e-mail:
+(a) Error Reports, (b) Package Updates, (c) Help requests, generated by
+lonerrorhandler.pm, CHECKRPMS and lonsupportreq.pm respectively.
+
+Inputs:
+defmail (scalar - email address of default recipient),
+mailing type (scalar - errormail, packagesmail, or helpdeskmail),
+defdom (domain for which to retrieve configuration settings),
+origmail (scalar - email address of recipient from loncapa.conf,
+i.e., predates configuration by DC via domainprefs.pm
+
+Returns: comma separated list of addresses to which to send e-mail.
+
+=cut
+
+############################################################
+############################################################
+sub build_recipient_list {
+ my ($defmail,$mailing,$defdom,$origmail) = @_;
+ my @recipients;
+ my $otheremails;
+ my %domconfig =
+ &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
+ if (ref($domconfig{'contacts'}) eq 'HASH') {
+ if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
+ my @contacts = ('adminemail','supportemail');
+ foreach my $item (@contacts) {
+ if ($domconfig{'contacts'}{$mailing}{$item}) {
+ my $addr = $domconfig{'contacts'}{$item};
+ if (!grep(/^\Q$addr\E$/,@recipients)) {
+ push(@recipients,$addr);
+ }
+ }
+ $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
+ }
+ }
+ } elsif ($origmail ne '') {
+ push(@recipients,$origmail);
+ }
+ if ($defmail ne '') {
+ push(@recipients,$defmail);
+ }
+ if ($otheremails) {
+ my @others;
+ if ($otheremails =~ /,/) {
+ @others = split(/,/,$otheremails);
+ } else {
+ push(@others,$otheremails);
+ }
+ foreach my $addr (@others) {
+ if (!grep(/^\Q$addr\E$/,@recipients)) {
+ push(@recipients,$addr);
+ }
+ }
+ }
+ my $recipientlist = join(',',@recipients);
+ return $recipientlist;
+}
+
############################################################
############################################################
sub commit_customrole {
my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
- my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url.
+ my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
($start?', '.&mt('starting').' '.localtime($start):'').
($end?', ending '.localtime($end):'').': '.
&Apache::lonnet::assigncustomrole(
@@ -6007,50 +7903,89 @@ sub commit_customrole {
}
sub commit_standardrole {
- my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec) = @_;
- my $output;
- my $logmsg;
+ my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
+ my ($output,$logmsg,$linefeed);
+ if ($context eq 'auto') {
+ $linefeed = "\n";
+ } else {
+ $linefeed = " \n";
+ }
if ($three eq 'st') {
- my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec);
- if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) {
- $output = "Error: $result\n";
+ my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
+ $one,$two,$sec,$context);
+ if (($result =~ /^error/) || ($result eq 'not_in_class') ||
+ ($result eq 'unknown_course') || ($result eq 'refused')) {
+ $output = $logmsg.' '.&mt('Error: ').$result."\n";
} else {
- $output = &mt('Assigning').' '.$three.' in '.$url.
+ $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
($start?', '.&mt('starting').' '.localtime($start):'').
- ($end?', '.&mt('ending').' '.localtime($end):'').
- ': '.$result.' '.
- &mt('Add to classlist').': ok ';
+ ($end?', '.&mt('ending').' '.localtime($end):'').': ';
+ if ($context eq 'auto') {
+ $output .= $result.$linefeed.&mt('Add to classlist').': ok';
+ } else {
+ $output .= ''.$result.' '.$linefeed.
+ &mt('Add to classlist').': ok ';
+ }
+ $output .= $linefeed;
}
} else {
$output = &mt('Assigning').' '.$three.' in '.$url.
($start?', '.&mt('starting').' '.localtime($start):'').
- ($end?', '.&mt('ending').' '.localtime($end):'').': '.
- &Apache::lonnet::assignrole(
- $udom,$uname,$url,$three,$end,$start).
- ' ';
+ ($end?', '.&mt('ending').' '.localtime($end):'').': ';
+ my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start);
+ if ($context eq 'auto') {
+ $output .= $result.$linefeed;
+ } else {
+ $output .= ''.$result.' '.$linefeed;
+ }
}
return $output;
}
sub commit_studentrole {
- my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec) = @_;
- my $linefeed = ' '."\n";
- my $result;
+ my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
+ my ($result,$linefeed,$oldsecurl,$newsecurl);
+ if ($context eq 'auto') {
+ $linefeed = "\n";
+ } else {
+ $linefeed = ' '."\n";
+ }
if (defined($one) && defined($two)) {
my $cid=$one.'_'.$two;
my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
my $secchange = 0;
my $expire_role_result;
my $modify_section_result;
- unless ($oldsec eq '-1') {
- unless ($sec eq $oldsec) {
+ if ($oldsec ne '-1') {
+ if ($oldsec ne $sec) {
$secchange = 1;
+ my $now = time;
my $uurl='/'.$cid;
$uurl=~s/\_/\//g;
if ($oldsec) {
$uurl.='/'.$oldsec;
}
- $expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time);
+ $oldsecurl = $uurl;
+ $expire_role_result =
+ &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now);
+ if ($env{'request.course.sec'} ne '') {
+ if ($expire_role_result eq 'refused') {
+ my @roles = ('st');
+ my @statuses = ('previous');
+ my @roledoms = ($one);
+ my $withsec = 1;
+ my %roleshash =
+ &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
+ \@statuses,\@roles,\@roledoms,$withsec);
+ if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
+ my ($oldstart,$oldend) =
+ split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
+ if ($oldend > 0 && $oldend <= $now) {
+ $expire_role_result = 'ok';
+ }
+ }
+ }
+ }
$result = $expire_role_result;
}
}
@@ -6058,21 +7993,55 @@ sub commit_studentrole {
$modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
if ($modify_section_result =~ /^ok/) {
if ($secchange == 1) {
- $$logmsg .= "Section for $uname switched from old section: $oldsec to new section: $sec".$linefeed;
+ if ($sec eq '') {
+ $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
+ } else {
+ $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
+ }
} elsif ($oldsec eq '-1') {
- $$logmsg .= "New student role for $uname in section $sec in course $cid".$linefeed;
+ if ($sec eq '') {
+ $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
+ } else {
+ $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
+ }
} else {
- $$logmsg .= "Student $uname assigned to unchanged section $sec in course $cid".$linefeed;
+ if ($sec eq '') {
+ $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
+ } else {
+ $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
+ }
}
} else {
- $$logmsg .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $modify_section_result".$linefeed;
+ if ($secchange) {
+ $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
+ } else {
+ $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
+ }
}
$result = $modify_section_result;
} elsif ($secchange == 1) {
- $$logmsg .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $expire_role_result".$linefeed;
+ if ($oldsec eq '') {
+ $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
+ } else {
+ $$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;
+ }
+ if ($expire_role_result eq 'refused') {
+ my $newsecurl = '/'.$cid;
+ $newsecurl =~ s/\_/\//g;
+ if ($sec ne '') {
+ $newsecurl.='/'.$sec;
+ }
+ if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
+ if ($sec eq '') {
+ $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments unaffiliated with any section.',$sec).$linefeed;
+ } else {
+ $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments in other sections.',$sec).$linefeed;
+ }
+ }
+ }
}
} else {
- $$logmsg .= "Incomplete course id defined. Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed";
+ $$logmsg .= &mt('Incomplete course id defined.').$linefeed.&mt('Addition of user [_1] from domain [_2] to course [_3], section [_4] not completed.',$uname,$udom,$one.'_'.$two,$sec).$linefeed;
$result = "error: incomplete course id\n";
}
return $result;
@@ -6081,9 +8050,70 @@ sub commit_studentrole {
############################################################
############################################################
+sub check_clone {
+ my ($args,$linefeed) = @_;
+ my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
+ my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
+ my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
+ my $clonemsg;
+ my $can_clone = 0;
+
+ if ($clonehome eq 'no_host') {
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+ } else {
+ my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
+ if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
+ $can_clone = 1;
+ } else {
+ my %clonehash = &Apache::lonnet::get('environment',['cloners'],
+ $args->{'clonedomain'},$args->{'clonecourse'});
+ my @cloners = split(/,/,$clonehash{'cloners'});
+ if (grep(/^\*$/,@cloners)) {
+ $can_clone = 1;
+ } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
+ $can_clone = 1;
+ } else {
+ my %roleshash =
+ &Apache::lonnet::get_my_roles($args->{'ccuname'},
+ $args->{'ccdomain'},
+ 'userroles',['active'],['cc'],
+ [$args->{'clonedomain'}]);
+ if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
+ $can_clone = 1;
+ } else {
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ }
+ }
+ }
+ }
+ return ($can_clone, $clonemsg, $cloneid, $clonehome);
+}
+
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
my $outcome;
+ my $linefeed = ' '."\n";
+ if ($context eq 'auto') {
+ $linefeed = "\n";
+ }
+
+#
+# Are we cloning?
+#
+ my ($can_clone, $clonemsg, $cloneid, $clonehome);
+ if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
+ ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
+ if ($context ne 'auto') {
+ if ($clonemsg ne '') {
+ $clonemsg = ''.$clonemsg.' ';
+ }
+ }
+ $outcome .= $clonemsg.$linefeed;
+
+ if (!$can_clone) {
+ return (0,$outcome);
+ }
+ }
#
# Open course
@@ -6104,44 +8134,47 @@ sub construct_course {
# Utils::Course. This needs to at least be output as a comment
# if anyone ever decides to not show this, and Utils::Course::new
# will need to be suitably modified.
- $outcome .= &mt('New LON-CAPA [_1] ID: [_2] ',$crstype,$$courseid);
+ $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
#
# Check if created correctly
#
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
- $outcome .= &mt('Created on').': '.$crsuhome.' ';
-#
-# Are we cloning?
+ $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
+
#
- my $cloneid='';
- if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
- $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
- my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
- my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
- if ($clonehome eq 'no_host') {
- $outcome .=
- ''.&mt('Attempting to clone non-existing [_1]',$crstype).' '.$cloneid.' ';
- } else {
- $outcome .=
- ''.&mt('Cloning [_1] from [_2]',$crstype,$clonehome).' ';
- my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
+# Do the cloning
+#
+ if ($can_clone && $cloneid) {
+ $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
+ if ($context ne 'auto') {
+ $clonemsg = ''.$clonemsg.' ';
+ }
+ $outcome .= $clonemsg.$linefeed;
+ my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# Copy all files
- &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
+ &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
# Restore URL
- $cenv{'url'}=$oldcenv{'url'};
+ $cenv{'url'}=$oldcenv{'url'};
# Restore title
- $cenv{'description'}=$oldcenv{'description'};
-# restore grading mode
- if (defined($oldcenv{'grading'})) {
- $cenv{'grading'}=$oldcenv{'grading'};
- }
+ $cenv{'description'}=$oldcenv{'description'};
# Mark as cloned
- $cenv{'clonedfrom'}=$cloneid;
- delete($cenv{'default_enrollment_start_date'});
- delete($cenv{'default_enrollment_end_date'});
- }
+ $cenv{'clonedfrom'}=$cloneid;
+# Need to clone grading mode
+ my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
+ $cenv{'grading'}=$newenv{'grading'};
+# Do not clone these environment entries
+ &Apache::lonnet::del('environment',
+ ['default_enrollment_start_date',
+ 'default_enrollment_end_date',
+ 'question.email',
+ 'policy.email',
+ 'comment.email',
+ 'pch.users.denied',
+ 'plc.users.denied'],
+ $$crsudom,$$crsunum);
}
+
#
# Set environment (will override cloned, if existing)
#
@@ -6227,7 +8260,7 @@ sub construct_course {
}
if ($args->{'notify_dc'}) {
if ($uname ne '') {
- push(@notified,$uname.'@'.$udom);
+ push(@notified,$uname.':'.$udom);
}
}
if (@notified > 0) {
@@ -6245,11 +8278,24 @@ sub construct_course {
'dnhr' => 'does not have rights to access enrollment in these classes',
'adby' => 'as determined by the policies of your institution on access to official classlists'
);
- $outcome .= ''.$lt{'tclb'}.' ('.$cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.' ('.$lt{'adby'}.').'."\n";
- foreach (@badclasses) {
- $outcome .= "$_ \n";
- }
- $outcome .= " \n";
+ my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
+ ' ('.$lt{'adby'}.')';
+ if ($context eq 'auto') {
+ $outcome .= $badclass_msg.$linefeed;
+ $outcome .= ''.$badclass_msg.$linefeed.'
'."\n";
+ foreach my $item (@badclasses) {
+ if ($context eq 'auto') {
+ $outcome .= " - $item\n";
+ } else {
+ $outcome .= "$item \n";
+ }
+ }
+ if ($context eq 'auto') {
+ $outcome .= $linefeed;
+ } else {
+ $outcome .= " \n";
+ }
+ }
}
if ($args->{'no_end_date'}) {
$args->{'endaccess'} = 0;
@@ -6265,8 +8311,13 @@ sub construct_course {
$cenv{'internal.autharg'} = $args->{'autharg'};
if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
- $outcome .= ''.
- &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').' ';
+ 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'})) {
@@ -6290,9 +8341,11 @@ sub construct_course {
# if specified, key authority is not course, but user
# only active if keyaccess is yes
if ($args->{'keyauth'}) {
- $args->{'keyauth'}=~s/[^\w\@]//g;
- if ($args->{'keyauth'}) {
- $cenv{'keyauth'}=$args->{'keyauth'};
+ my ($user,$domain) = split(':',$args->{'keyauth'});
+ $user = &LONCAPA::clean_username($user);
+ $domain = &LONCAPA::clean_username($domain);
+ if ($user ne '' && $domain ne '') {
+ $cenv{'keyauth'}=$user.':'.$domain;
}
}
@@ -6320,8 +8373,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
#
@@ -6331,7 +8384,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
@@ -6358,9 +8411,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);
}
############################################################
@@ -6389,7 +8443,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')) {
@@ -6403,10 +8457,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;
}
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.