--- loncom/interface/loncommon.pm 2007/08/15 18:03:22 1.564
+++ loncom/interface/loncommon.pm 2007/09/04 23:58:06 1.564.2.5
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.564 2007/08/15 18:03:22 albertel Exp $
+# $Id: loncommon.pm,v 1.564.2.5 2007/09/04 23:58:06 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3458,9 +3458,6 @@ 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);
@@ -3578,7 +3575,7 @@ ENDROLE
my $imgsrc = $img;
if ($img =~ /^\/adm/) {
- $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
+ $imgsrc = &lonhttpdurl($img);
}
my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
@@ -5585,6 +5582,7 @@ sub user_picker {
'instd' => 'in institutional directory',
'exact' => 'is',
'contains' => 'contains',
+ 'begins' => 'begins with',
);
my $domform = &select_dom_form($currdom,'srchdomain',1,1);
my $srchinsel = ' <select name="srchin">';
@@ -5620,7 +5618,7 @@ sub user_picker {
$srchbysel .= "\n </select>\n";
my $srchtypesel = ' <select name="srchtype">';
- foreach my $option ('exact','contains') {
+ foreach my $option ('exact','begins','contains') {
if ($curr_selected{'srchtype'} eq $option) {
$srchtypesel .= '
<option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
@@ -5689,6 +5687,13 @@ function validateEntry() {
msg += "You must include some text to search for.\\n";
}
+ if (srchtype== 'begins') {
+ if (srchterm.length < 2) {
+ checkok = 0;
+ msg += "The text you are searching for must contain at least two characters when using a 'begins' type search.\\n";
+ }
+ }
+
if (srchtype== 'contains') {
if (srchterm.length < 3) {
checkok = 0;
@@ -6912,6 +6917,40 @@ sub commit_studentrole {
############################################################
############################################################
+sub check_clone {
+ my ($args) = @_;
+ 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('Attempting to clone non-existing [_1]',
+ $args->{'crstype'});
+ } 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'});
+ 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('The new course was not cloned from an 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,$context) = @_;
my $outcome;
@@ -6919,6 +6958,23 @@ sub construct_course {
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);
+ if ($context ne 'auto') {
+ $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
+ }
+ $outcome .= $clonemsg.$linefeed;
+
+ if (!$can_clone) {
+ return (0,$outcome);
+ }
+ }
+
#
# Open course
#
@@ -6939,81 +6995,39 @@ sub construct_course {
# 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).$linefeed;
-
#
# Check if created correctly
#
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
+
#
-# Are we cloning?
-#
- my $cloneid='';
- if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
- my $can_clone = 0;
- $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
- my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
- my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
- my $clonemsg;
- if ($clonehome eq 'no_host') {
- $clonemsg = &mt('Attempting to clone non-existing [_1]',$crstype);
- if ($context eq 'auto') {
- $outcome .= $clonemsg;
- } else {
- $outcome .= '<font color="red">'.$clonemsg.'</font>';
- }
- $outcome .= $linefeed;
- } else {
- my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
- if ($env{'request.role.domain'} eq $args->{'form.clonedomain'}) {
- $can_clone = 1;
- } else {
- my %clonehash = &Apache::lonnet::get('environment',['cloners'],
- $args->{'clonedomain'},$args->{'clonecourse'});
- my @cloners = split(/,/,$clonehash{'cloners'});
- 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('The new course was not cloned from an existing course because the course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
- if ($context eq 'auto') {
- $outcome .= $clonemsg;
- } else {
- $outcome .= '<font color="red">'.$clonemsg.'</font>';
- }
- $outcome .= $linefeed;
- }
- }
- }
- if ($can_clone) {
- $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
- if ($context eq 'auto') {
- $outcome = $clonemsg;
- } else {
- $outcome .= '<font color="green">'.$clonemsg.'</font>';
- }
- $outcome .= $linefeed;
- 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 = '<span class="LC_success">'.$clonemsg.'</span>';
+ }
+ $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'};
+ $cenv{'description'}=$oldcenv{'description'};
# restore grading mode
- if (defined($oldcenv{'grading'})) {
- $cenv{'grading'}=$oldcenv{'grading'};
- }
-# Mark as cloned
- $cenv{'clonedfrom'}=$cloneid;
- delete($cenv{'default_enrollment_start_date'});
- delete($cenv{'default_enrollment_end_date'});
+ if (defined($oldcenv{'grading'})) {
+ $cenv{'grading'}=$oldcenv{'grading'};
}
+# Mark as cloned
+ $cenv{'clonedfrom'}=$cloneid;
+ delete($cenv{'default_enrollment_start_date'});
+ delete($cenv{'default_enrollment_end_date'});
}
+
#
# Set environment (will override cloned, if existing)
#
@@ -7121,7 +7135,7 @@ sub construct_course {
' ('.$lt{'adby'}.')';
if ($context eq 'auto') {
$outcome .= $badclass_msg.$linefeed;
- $outcome .= '<font color="red">'.$badclass_msg.$linefeed.'<ul>'."\n";
+ $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
foreach my $item (@badclasses) {
if ($context eq 'auto') {
$outcome .= " - $item\n";
@@ -7132,7 +7146,7 @@ sub construct_course {
if ($context eq 'auto') {
$outcome .= $linefeed;
} else {
- $outcome .= "</ul><br /><br /></font>\n";
+ $outcome .= "</ul><br /><br /></div>\n";
}
}
}
@@ -7154,7 +7168,7 @@ sub construct_course {
if ($context eq 'auto') {
$outcome .= $krb_msg;
} else {
- $outcome .= '<font color="red" size="+1">'.$krb_msg.'</font>';
+ $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
}
$outcome .= $linefeed;
}
@@ -7252,7 +7266,8 @@ sub construct_course {
if ($errtext) { $fatal=2; }
$outcome .= ($fatal?$errtext:'write ok').$linefeed;
}
- return $outcome;
+
+ return (1,$outcome);
}
############################################################
@@ -7295,10 +7310,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;
}