--- loncom/interface/loncommon.pm 2007/08/15 18:03:22 1.564 +++ loncom/interface/loncommon.pm 2007/08/30 23:02:03 1.564.2.4 @@ -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.4 2007/08/30 23:02:03 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=''.$function.''; @@ -6912,6 +6909,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 +6950,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 = ''.$clonemsg.''; + } + $outcome .= $clonemsg.$linefeed; + + if (!$can_clone) { + return (0,$outcome); + } + } + # # Open course # @@ -6939,81 +6987,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 .= ''.$clonemsg.''; - } - $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 .= ''.$clonemsg.''; - } - $outcome .= $linefeed; - } - } - } - if ($can_clone) { - $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome); - if ($context eq 'auto') { - $outcome = $clonemsg; - } else { - $outcome .= ''.$clonemsg.''; - } - $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 = ''.$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'}; + $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 +7127,7 @@ sub construct_course { ' ('.$lt{'adby'}.')'; if ($context eq 'auto') { $outcome .= $badclass_msg.$linefeed; - $outcome .= ''.$badclass_msg.$linefeed.'

\n"; } } } @@ -7154,7 +7160,7 @@ sub construct_course { if ($context eq 'auto') { $outcome .= $krb_msg; } else { - $outcome .= ''.$krb_msg.''; + $outcome .= ''.$krb_msg.''; } $outcome .= $linefeed; } @@ -7252,7 +7258,8 @@ sub construct_course { if ($errtext) { $fatal=2; } $outcome .= ($fatal?$errtext:'write ok').$linefeed; } - return $outcome; + + return (1,$outcome); } ############################################################ @@ -7295,10 +7302,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; }