--- loncom/interface/loncommon.pm 2007/08/02 01:07:00 1.558 +++ loncom/interface/loncommon.pm 2007/09/11 23:36:46 1.584 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.558 2007/08/02 01:07:00 albertel Exp $ +# $Id: loncommon.pm,v 1.584 2007/09/11 23:36:46 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -721,24 +721,20 @@ sub help_open_topic { my $template = ""; my $link; - + $topic=~s/\W/\_/g; - if (!$stayOnPage) - { + if (!$stayOnPage) { $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; - } - else - { + } else { $link = "/adm/help/${filename}.hlp"; } # Add the text - if ($text ne "") - { + if ($text ne "") { $template .= - "". - "
$text"; + "". + "'; foreach my $key (sort(keys(%lasthash))) { - my $value; - if ($key =~ /timestamp/) { - $value=scalar(localtime($returnhash{$version.':'.$key})); - } else { - $value=$returnhash{$version.':'.$key}; - } - $prevattempts.=''; + my $value = &format_previous_attempt_value($key, + $returnhash{$version.':'.$key}); + $prevattempts.=''; } } } $prevattempts.=''; foreach my $key (sort(keys(%lasthash))) { - my $value; - if ($key =~ /timestamp/) { - $value=scalar(localtime($lasthash{$key})); - } else { - $value=$lasthash{$key}; - } - $value=&unescape($value); + my $value = &format_previous_attempt_value($key,$lasthash{$key}); if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} $prevattempts.=''; } @@ -2611,6 +2686,19 @@ sub get_previous_attempt { } } +sub format_previous_attempt_value { + my ($key,$value) = @_; + if ($key =~ /timestamp/) { + $value = &Apache::lonlocal::locallocaltime($value); + } elsif (ref($value) eq 'ARRAY') { + $value = '('.join(', ', @{ $value }).')'; + } else { + $value = &unescape($value); + } + return $value; +} + + sub relative_to_absolute { my ($url,$output)=@_; my $parser=HTML::TokeParser->new(\$output); @@ -3397,6 +3485,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 +3536,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 +3653,7 @@ ENDROLE my $imgsrc = $img; if ($img =~ /^\/adm/) { - $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img; + $imgsrc = &lonhttpdurl($img); } my $upperleft=''.$function.''; @@ -4273,9 +4361,7 @@ table#LC_helpmenu_links a:hover { border: 1px solid #8888FF; background: #CCCCFF; } - table.LC_pick_box { - width: 100%; border-collapse: separate; background: white; border: 1px solid black; @@ -4288,6 +4374,14 @@ table.LC_pick_box td.LC_pick_box_title { width: 184px; padding: 8px; } +table.LC_pick_box td.LC_pick_box_value { + text-align: left; + padding: 8px; +} +table.LC_pick_box td.LC_pick_box_select { + text-align: left; + padding: 8px; +} table.LC_pick_box td.LC_pick_box_separator { padding: 0px; height: 1px; @@ -4296,7 +4390,48 @@ table.LC_pick_box td.LC_pick_box_separat table.LC_pick_box td.LC_pick_box_submit { text-align: right; } - +table.LC_pick_box td.LC_evenrow_value { + text-align: left; + padding: 8px; + background-color: $data_table_light; +} +table.LC_pick_box td.LC_oddrow_value { + text-align: left; + padding: 8px; + background-color: $data_table_light; +} +table.LC_helpform_receipt { + width: 620px; + border-collapse: separate; + background: white; + border: 1px solid black; + border-spacing: 1px; +} +table.LC_helpform_receipt td.LC_pick_box_title { + background: $tabbg; + font-weight: bold; + text-align: right; + width: 184px; + padding: 8px; +} +table.LC_helpform_receipt td.LC_evenrow_value { + text-align: left; + padding: 8px; + background-color: $data_table_light; +} +table.LC_helpform_receipt td.LC_oddrow_value { + text-align: left; + padding: 8px; + background-color: $data_table_light; +} +table.LC_helpform_receipt td.LC_pick_box_separator { + padding: 0px; + height: 1px; + background: black; +} +span.LC_helpform_receipt_cat { + font-weight: bold; +} table.LC_group_priv_box { background: white; border: 1px solid black; @@ -4441,6 +4576,10 @@ span.LC_nobreak { white-space: nowrap; } +span.LC_cusr_emph { + font-style: italic; +} + table.LC_docs_documents { background: #BBBBBB; border-width: 0px; @@ -4508,6 +4647,13 @@ table.LC_docs_adddocs th { background: #DDDDDD; } +table.LC_sty_begin { + background: #BBFFBB; +} +table.LC_sty_end { + background: #FFBBBB; +} + END } @@ -4711,6 +4857,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 { @@ -5535,11 +5685,11 @@ sub get_secgrprole_info { } sub user_picker { - my ($dom,$srch,$forcenewuser) = @_; + my ($dom,$srch,$forcenewuser,$caller) = @_; my $currdom = $dom; my %curr_selected = ( srchin => 'dom', - srchby => 'uname', + srchby => 'lastname', ); my $srchterm; if (ref($srch) eq 'HASH') { @@ -5557,25 +5707,30 @@ sub user_picker { } $srchterm = $srch->{'srchterm'}; } - use Data::Dumper; - &Apache::lonnet::logthis(&Dumper($srch)); my %lt=&Apache::lonlocal::texthash( - 'usr' => 'Search for', - 'or' => 'or', - 'doma' => 'domain', + 'usr' => 'Search criteria', + 'doma' => 'Domain/institution to search', 'uname' => 'username', 'lastname' => 'last name', 'lastfirst' => 'last name, first name', 'crs' => 'in this course', - 'dom' => 'in this domain', + 'dom' => 'in selected LON-CAPA domain', 'alc' => 'all LON-CAPA', - 'instd' => 'in institutional directory', + 'instd' => 'in institutional directory for selected domain', 'exact' => 'is', 'contains' => 'contains', + 'begins' => 'begins with', + 'youm' => "You must include some text to search for.", + 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.", + 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.", + 'yomc' => "You must choose a domain when using an institutional directory search.", + 'ymcd' => "You must choose a domain when using a domain search.", + 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.", + 'whse' => "When searching by last,first you must include at least one character in the first name.", + 'thfo' => "The following need to be corrected before the search can be run:", ); - my $domform = &select_dom_form($currdom,'srchdomain',1); - - my $srchin; + my $domform = &select_dom_form($currdom,'srchdomain',1,1); + my $srchinsel = ' - -ROW + if ($curr_selected{'srchin'} eq $option) { + $srchinsel .= ' + '; + } else { + $srchinsel .= ' + '; + } } + $srchinsel .= "\n \n"; my $srchbysel = ' \n"; my $srchtypesel = ' &"').'" onclick="javascript:setSearch(\'1\');" />

'; + if (ref($srch) eq 'HASH') { + if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) { + $new_user_create = '

&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" />

'; + } + } + $newuserscript = <<"ENDSCRIPT"; -function setSearch(createnew) { +function setSearch(createnew,callingForm) { if (createnew == 1) { - for (var i=0; i -function validateEntry() { +function validateEntry(callingForm) { var checkok = 1; var srchin; - for (var i=0; i - + + + + + + -$srchin
$text"; } # Add the graphic @@ -805,14 +801,10 @@ sub help_open_menu { my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) = @_; $stayOnPage = 0 if (not defined $stayOnPage); - # formerly only used pop-up help (stayOnPage = 0) + # only use pop-up help (stayOnPage == 0) # if environment.remote is on (using remote control UI) - # if ($env{'browser.interface'} eq 'textual' || - # $env{'environment.remote'} eq 'off' ) { - # $stayOnPage=1; - #} - # Now making pop-up help the default even with remote control - if ($env{'browser.interface'} eq 'textual') { + if ($env{'browser.interface'} eq 'textual' || + $env{'environment.remote'} eq 'off' ) { $stayOnPage=1; } my $output; @@ -834,15 +826,13 @@ sub help_open_menu { sub top_nav_help { my ($text) = @_; - $text = &mt($text); - - my $stayOnPage = + my $stay_on_page = ($env{'browser.interface'} eq 'textual' || $env{'environment.remote'} eq 'off' ); - my $link= ($stayOnPage) ? "javascript:helpMenu('display')" + my $link = ($stay_on_page) ? "javascript:helpMenu('display')" : "javascript:helpMenu('open')"; - my $banner_link = &update_help_link(undef,undef,undef,undef,$stayOnPage); + my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page); my $title = &mt('Get help'); @@ -870,7 +860,7 @@ sub help_menu_js { 'js_ready' => 1, 'add_entries' => { 'border' => '0', - 'rows' => "105,*",},}); + 'rows' => "110,*",},}); my $end_page = &Apache::loncommon::end_page({'frameset' => 1, 'js_ready' => 1,}); @@ -1084,6 +1074,63 @@ sub changable_area { =pod +=item * resize_textarea_js + +emits the needed javascript to resize a textarea to be as big as possible + +creates a function resize_textrea that takes two IDs first should be +the id of the element to resize, second should be the id of a div that +surrounds everything that comes after the textarea, this routine needs +to be attached to the for the onload and onresize events. + + +=cut + +sub resize_textarea_js { + return <<"RESIZE"; + +RESIZE + +} + +=pod + =back =head1 Excel and CSV file utility routines @@ -1424,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 \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; @@ -2474,9 +2531,11 @@ sub preferred_languages { @languages=(@languages, split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'})); } - my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0]; + my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'}; if ($browser) { - @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser)); + my @browser = + map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser)); + push(@languages,@browser); } if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) { @languages=(@languages, @@ -2498,14 +2557,40 @@ sub preferred_languages { my @genlanguages; foreach my $lang (@languages) { unless ($lang=~/\w/) { next; } - push (@genlanguages,$lang); + push(@genlanguages,$lang); if ($lang=~/(\-|\_)/) { push(@genlanguages,(split(/(\-|\_)/,$lang))[0]); } } + #uniqueify the languages list + my %count; + @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages; return @genlanguages; } +sub languages { + my ($possible_langs) = @_; + my @preferred_langs = &preferred_languages(); + if (!ref($possible_langs)) { + if( wantarray ) { + return @preferred_langs; + } else { + return $preferred_langs[0]; + } + } + my %possibilities = map { $_ => 1 } (@$possible_langs); + my @preferred_possibilities; + foreach my $preferred_lang (@preferred_langs) { + if (exists($possibilities{$preferred_lang})) { + push(@preferred_possibilities, $preferred_lang); + } + } + if( wantarray ) { + return @preferred_possibilities; + } + return $preferred_possibilities[0]; +} + ############################################################### ## Student Answer Attempts ## ############################################################### @@ -2580,25 +2665,15 @@ sub get_previous_attempt { for ($version=1;$version<=$returnhash{'version'};$version++) { $prevattempts.='
Transaction '.$version.''.&unescape($value).' '.$value.' 
Current'.$value.'  - $extra -
$srchbysel - $srchtypesel - + $lt{'doma'}:$domform
$lt{'usr'}:$srchbysel + $srchtypesel + + $srchinsel

END_BLOCK @@ -5737,8 +5908,6 @@ END_BLOCK return $output; } - - =pod =back @@ -5996,28 +6165,50 @@ sub record_sep { $i++; } } else { - my @allfields; + my $separator=','; if ($env{'form.upfiletype'} eq 'semisv') { - @allfields=split(/;/,$record,-1); - } else { - @allfields=split(/\,/,$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; } @@ -6876,6 +7067,45 @@ 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,$context) = @_; my $outcome; @@ -6883,6 +7113,25 @@ 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,$linefeed); + if ($context ne 'auto') { + if ($clonemsg ne '') { + $clonemsg = ''.$clonemsg.''; + } + } + $outcome .= $clonemsg.$linefeed; + + if (!$can_clone) { + return (0,$outcome); + } + } + # # Open course # @@ -6903,81 +7152,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) # @@ -7085,7 +7292,7 @@ sub construct_course { ' ('.$lt{'adby'}.')'; if ($context eq 'auto') { $outcome .= $badclass_msg.$linefeed; - $outcome .= ''.$badclass_msg.$linefeed.'
    '."\n"; + $outcome .= '
    '.$badclass_msg.$linefeed.'
      '."\n"; foreach my $item (@badclasses) { if ($context eq 'auto') { $outcome .= " - $item\n"; @@ -7096,7 +7303,7 @@ sub construct_course { if ($context eq 'auto') { $outcome .= $linefeed; } else { - $outcome .= "


    \n"; + $outcome .= "


\n"; } } } @@ -7118,7 +7325,7 @@ sub construct_course { if ($context eq 'auto') { $outcome .= $krb_msg; } else { - $outcome .= ''.$krb_msg.''; + $outcome .= ''.$krb_msg.''; } $outcome .= $linefeed; } @@ -7216,7 +7423,8 @@ sub construct_course { if ($errtext) { $fatal=2; } $outcome .= ($fatal?$errtext:'write ok').$linefeed; } - return $outcome; + + return (1,$outcome); } ############################################################ @@ -7259,10 +7467,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; }