--- loncom/interface/loncommon.pm 2007/08/11 14:22:14 1.560 +++ 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.560 2007/08/11 14:22:14 www Exp $ +# $Id: loncommon.pm,v 1.564.2.4 2007/08/30 23:02:03 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1424,7 +1424,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 \n"; foreach my $dom (@domains) { $selectdomain.="\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; @@ -3397,6 +3407,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 @@ -3445,15 +3458,12 @@ 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) { return $bodytag; @@ -3565,7 +3575,7 @@ ENDROLE my $imgsrc = $img; if ($img =~ /^\/adm/) { - $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img; + $imgsrc = &lonhttpdurl($img); } my $upperleft=''.$function.''; @@ -4711,6 +4721,10 @@ Inputs: $title - optional title for the no_auto_mt_title -> prevent &mt()ing the title arg + inherit_jsmath -> when creating popup window in a page, + should it have jsmath forced on by the + current page + =cut sub start_page { @@ -5558,9 +5572,7 @@ sub user_picker { $srchterm = $srch->{'srchterm'}; } my %lt=&Apache::lonlocal::texthash( - 'usr' => 'Search for', - 'or' => 'or', - 'doma' => 'domain', + 'doma' => 'Domain/institution to search', 'uname' => 'username', 'lastname' => 'last name', 'lastfirst' => 'last name, first name', @@ -5571,9 +5583,8 @@ sub user_picker { 'exact' => 'is', 'contains' => 'contains', ); - my $domform = &select_dom_form($currdom,'srchdomain',1); - - my $srchin; + my $domform = &select_dom_form($currdom,'srchdomain',1,1); + my $srchinsel = ' $lt{$option} $extra - - -ROW + if ($curr_selected{'srchin'} eq $option) { + $srchinsel .= ' + '; + } else { + $srchinsel .= ' + '; + } } + $srchinsel .= "\n \n"; my $srchbysel = ' + $srchbysel + $srchtypesel + + $srchinsel + + + + $lt{'doma'}: $domform -$srchin
END_BLOCK @@ -5994,28 +6007,50 @@ sub record_sep { $i++; } } else { - my @allfields; + my $separator=','; if ($env{'form.upfiletype'} eq 'semisv') { - @allfields=split(/\s*;\s*/,$record,-1); - } else { - @allfields=split(/\s*\,\s*/,$record,-1); + $separator=';'; } my $i=0; - my $j; - for ($j=0;$j<=$#allfields;$j++) { - my $field=$allfields[$j]; - if ($field=~/^\s*(\"|\')/) { - my $delimiter=$1; - while (($field!~/$delimiter$/) && ($j<$#allfields)) { - $j++; - $field.=','.$allfields[$j]; - } - $field=~s/^\s*$delimiter//; - $field=~s/$delimiter\s*$//; - } - $components{&takeleft($i)}=$field; - $i++; +# the character we are looking for to indicate the end of a quote or a record + my $looking_for=$separator; +# do not add the characters to the fields + my $ignore=0; +# we just encountered a separator (or the beginning of the record) + my $just_found_separator=1; +# store the field we are working on here + my $field=''; +# work our way through all characters in record + foreach my $character ($record=~/(.)/g) { + if ($character eq $looking_for) { + if ($character ne $separator) { +# Found the end of a quote, again looking for separator + $looking_for=$separator; + $ignore=1; + } else { +# Found a separator, store away what we got + $components{&takeleft($i)}=$field; + $i++; + $just_found_separator=1; + $ignore=0; + $field=''; + } + next; + } +# single or double quotation marks after a separator indicate beginning of a quote +# we are now looking for the end of the quote and need to ignore separators + if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) { + $looking_for=$character; + next; + } +# ignore would be true after we reached the end of a quote + if ($ignore) { next; } + if (($just_found_separator) && ($character=~/\s/)) { next; } + $field.=$character; + $just_found_separator=0; } +# catch the very last entry, since we never encountered the separator + $components{&takeleft($i)}=$field; } return %components; } @@ -6874,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; @@ -6881,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 # @@ -6901,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) # @@ -7083,7 +7127,7 @@ sub construct_course { ' ('.$lt{'adby'}.')'; if ($context eq 'auto') { $outcome .= $badclass_msg.$linefeed; - $outcome .= ''.$badclass_msg.$linefeed.'

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