--- loncom/interface/loncommon.pm 2007/08/24 07:20:22 1.564.2.1 +++ loncom/interface/loncommon.pm 2007/11/06 02:23:49 1.608 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.564.2.1 2007/08/24 07:20:22 albertel Exp $ +# $Id: loncommon.pm,v 1.608 2007/11/06 02:23:49 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -367,7 +367,7 @@ sub selectstudent_link { return ''; } return "".&mt('Select User').""; + '","'.$udomele.'");'."'>".&mt('Select User').""; } if ($env{'request.role'}=~/^(au|dc|su)/) { return "". - "$text"; + "". + "'. + &end_data_table_row().&end_data_table(); } } else { - $prevattempts='No data.'; + $prevattempts= + &start_data_table().&start_data_table_row(). + ''. + &end_data_table_row().&end_data_table(); } } +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); @@ -2779,9 +3169,9 @@ sub pprmlink { if (!$symb) { $symb=&Apache::lonnet::symbread(); } $symb=&escape($symb); if ($target) { $target="target=\"$target\""; } - return ''.$text.''; + return ''.$text.''; } ############################################## @@ -3458,9 +3848,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 +3965,7 @@ ENDROLE my $imgsrc = $img; if ($img =~ /^\/adm/) { - $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img; + $imgsrc = &lonhttpdurl($img); } my $upperleft=''.$function.''; @@ -3712,7 +4099,7 @@ sub standard_css { my $vlink = &designparm($function.'.vlink', $domain); my $link = &designparm($function.'.link', $domain); - my $sans = 'Arial,Helvetica,sans-serif'; + my $sans = 'Verdana,Arial,Helvetica,sans-serif'; my $mono = 'monospace'; my $data_table_head = $tabbg; my $data_table_light = '#EEEEEE'; @@ -3730,8 +4117,9 @@ sub standard_css { my $table_header = '#DDDDDD'; my $feedback_link_bg = '#BBBBBB'; - my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px' - : '0px 3px 0px 4px'; + my $border = ($env{'browser.type'} eq 'explorer' || + $env{'browser.type'} eq 'safari' ) ? '0px 2px 0px 2px' + : '0px 3px 0px 4px'; return < 'dom', - srchby => 'uname', + srchby => 'lastname', ); my $srchterm; if (ref($srch) eq 'HASH') { @@ -5575,16 +6181,26 @@ sub user_picker { $srchterm = $srch->{'srchterm'}; } my %lt=&Apache::lonlocal::texthash( + '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,1); my $srchinsel = ' \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
+ + + + + + - - - -
$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,138 @@ sub changable_area { =pod +=item * viewport_geometry_js { + +Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser. + +=cut + + +sub viewport_geometry_js { + return <<"GEOMETRY"; +var Geometry = {}; +function init_geometry() { + if (Geometry.init) { return }; + Geometry.init=1; + if (window.innerHeight) { + Geometry.getViewportHeight = function() { return window.innerHeight; }; + Geometry.getViewportWidth = function() { return window.innerWidth; }; + Geometry.getHorizontalScroll = function() { return window.pageXOffset; }; + Geometry.getVerticalScroll = function() { return window.pageYOffset; }; + } + else if (document.documentElement && document.documentElement.clientHeight) { + Geometry.getViewportHeight = + function() { return document.documentElement.clientHeight; }; + Geometry.getViewportWidth = + function() { return document.documentElement.clientWidth; }; + + Geometry.getHorizontalScroll = + function() { return document.documentElement.scrollLeft; }; + Geometry.getVerticalScroll = + function() { return document.documentElement.scrollTop; }; + } + else if (document.body.clientHeight) { + Geometry.getViewportHeight = + function() { return document.body.clientHeight; }; + Geometry.getViewportWidth = + function() { return document.body.clientWidth; }; + Geometry.getHorizontalScroll = + function() { return document.body.scrollLeft; }; + Geometry.getVerticalScroll = + function() { return document.body.scrollTop; }; + } +} + +GEOMETRY +} + +=pod + +=item * viewport_size_js { + +Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. + +=cut + +sub viewport_size_js { + my $geometry = &viewport_geometry_js(); + return <<"DIMS"; + +$geometry + +function getViewportDims(width,height) { + init_geometry(); + width.value = Geometry.getViewportWidth(); + height.value = Geometry.getViewportHeight(); + return; +} + +DIMS +} + +=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 { + my $geometry = &viewport_geometry_js(); + return <<"RESIZE"; + +RESIZE + +} + +=pod + =back =head1 Excel and CSV file utility routines @@ -1285,8 +1407,6 @@ sub domain_select { =over 4 -=cut - =item * multiple_select_form($name,$value,$size,$hash,$order) Returns a string containing a + + + + form item if there are multiple library servers in $domain, or + (ii) an form item + if there is only one library server in $domain. -returns a string which contains an '."\n"; + } + foreach my $hostid (sort(keys(%servers))) { + $result.= '\n"; + } + $result .= ''."\n"; + } elsif ($numlib == 1) { + my $hostid; + foreach my $item (keys(%servers)) { + $hostid = $item; + } + $result .= ''; + if (!$hide) { + $result .= $hostid.' '.$servers{$hostid}; + } + $result .= "\n"; + } elsif ($default) { + $result .= ''; + if (!$hide) { + $result .= &mt('default'); + } + $result .= "\n"; } - return $result; + return ($result,$numlib); } =pod @@ -1634,19 +1798,16 @@ END } my $radioval = "'nochange'"; - if (exists($in{'curr_authtype'}) && - defined($in{'curr_authtype'}) && - $in{'curr_authtype'} ne '') { - $radioval = "'$in{'curr_authtype'}arg'"; + if (defined($in{'curr_authtype'})) { + if ($in{'curr_authtype'} ne '') { + $radioval = "'".$in{'curr_authtype'}."arg'"; + } } my $argfield = 'null'; - if ( grep/^mode$/,(keys %in) ) { + if (defined($in{'mode'})) { if ($in{'mode'} eq 'modifycourse') { - if ( grep/^curr_authtype$/,(keys %in) ) { - $radioval = "'$in{'curr_authtype'}'"; - } - if ( grep/^curr_autharg$/,(keys %in) ) { - unless ($in{'curr_autharg'} eq '') { + if (defined($in{'curr_autharg'})) { + if ($in{'curr_autharg'} ne '') { $argfield = "'$in{'curr_autharg'}'"; } } @@ -1729,79 +1890,170 @@ sub authform_nochange{ kerb_def_dom => 'MSU.EDU', @_, ); - my $result = ''; + } return $result; } -sub authform_kerberos{ +sub authform_kerberos { my %in = ( formname => 'document.cu', kerb_def_dom => 'MSU.EDU', kerb_def_auth => 'krb4', @_, ); - my ($check4,$check5,$krbarg); + my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype, + $autharg,$jscall); + my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); if ($in{'kerb_def_auth'} eq 'krb5') { - $check5 = " checked=\"on\""; + $check5 = ' checked="on"'; } else { - $check4 = " checked=\"on\""; + $check4 = ' checked="on"'; } $krbarg = $in{'kerb_def_dom'}; - - my $krbcheck = ""; - if ( grep/^curr_authtype$/,(keys %in) ) { - if ($in{'curr_authtype'} =~ m/^krb/) { - $krbcheck = " checked=\"on\""; - if ( grep/^curr_autharg$/,(keys %in) ) { + if (defined($in{'curr_authtype'})) { + if ($in{'curr_authtype'} eq 'krb') { + $krbcheck = ' checked="on"'; + if (defined($in{'curr_kerb_ver'})) { + if ($in{'curr_krb_ver'} eq '5') { + $check5 = ' checked="on"'; + $check4 = ''; + } else { + $check4 = ' checked="on"'; + $check5 = ''; + } + } + if (defined($in{'curr_autharg'})) { $krbarg = $in{'curr_autharg'}; } + if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) { + if (defined($in{'curr_autharg'})) { + $result = + &mt('Currently Kerberos authenticated with domain [_1] Version [_2].', + $in{'curr_autharg'},$krbver); + } else { + $result = + &mt('Currently Kerberos authenticated, Version [_1].',$krbver); + } + return $result; + } + } + } else { + if ($authnum == 1) { + $authtype = ''; } } - - my $jscall = "javascript:changed_radio('krb',$in{'formname'});"; - my $result .= &mt + if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) { + return; + } elsif ($authtype eq '') { + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifycourse') { + if ($authnum == 1) { + $authtype = ''; + } + } + } + } + $jscall = "javascript:changed_radio('krb',$in{'formname'});"; + if ($authtype eq '') { + $authtype = ''; + } + if (($can_assign{'krb4'} && $can_assign{'krb5'}) || + ($can_assign{'krb4'} && !$can_assign{'krb5'} && + $in{'curr_authtype'} eq 'krb5') || + (!$can_assign{'krb4'} && $can_assign{'krb5'} && + $in{'curr_authtype'} eq 'krb4')) { + $result .= &mt ('[_1] Kerberos authenticated with domain [_2] '. '[_3] Version 4 [_4] Version 5 [_5]', - ''); return $result; } +sub get_assignable_auth { + my ($dom) = @_; + if ($dom eq '') { + $dom = $env{'request.role.domain'}; + } + my %can_assign = ( + krb4 => 1, + krb5 => 1, + int => 1, + loc => 1, + ); + my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom); + if (ref($domconfig{'usercreation'}) eq 'HASH') { + if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') { + my $authhash = $domconfig{'usercreation'}{'authtypes'}; + my $context; + if ($env{'request.role'} =~ /^au/) { + $context = 'author'; + } elsif ($env{'request.role'} =~ /^dc/) { + $context = 'domain'; + } elsif ($env{'request.course.id'}) { + $context = 'course'; + } + if ($context) { + if (ref($authhash->{$context}) eq 'HASH') { + %can_assign = %{$authhash->{$context}}; + } + } + } + } + my $authnum = 0; + foreach my $key (keys(%can_assign)) { + if ($can_assign{$key}) { + $authnum ++; + } + } + if ($can_assign{'krb4'} && $can_assign{'krb5'}) { + $authnum --; + } + return ($authnum,%can_assign); +} + ############################################################### ## Get Authentication Defaults for Domain ## ############################################################### @@ -1973,7 +2323,7 @@ sub initialize_keywords { # Remove special values from %Keywords. foreach my $value ('total.count','average.count') { delete($Keywords{$value}) if (exists($Keywords{$value})); - } + } return 1; } @@ -2484,9 +2834,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, @@ -2508,14 +2860,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 ## ############################################################### @@ -2570,14 +2948,14 @@ sub get_previous_attempt { $lasthash{$key}=$returnhash{$version.':'.$key}; } } - $prevattempts='
'; - $prevattempts.=''; + $prevattempts=&start_data_table().&start_data_table_header_row(); + $prevattempts.=''; foreach my $key (sort(keys(%lasthash))) { my ($ign,@parts) = split(/\./,$key); if ($#parts > 0) { my $data=$parts[-1]; pop(@parts); - $prevattempts.=''; + $prevattempts.=''; } else { if ($#parts == 0) { $prevattempts.=''; @@ -2586,41 +2964,53 @@ sub get_previous_attempt { } } } + $prevattempts.=&end_data_table_header_row(); if ($getattempt eq '') { for ($version=1;$version<=$returnhash{'version'};$version++) { - $prevattempts.=''; + $prevattempts.=&start_data_table_row(). + ''; 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.=&end_data_table_row(); } } - $prevattempts.=''; + $prevattempts.=&start_data_table_row().''; 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.=''; } - $prevattempts.='
History'.&mt('History').'Part '.join('.',@parts).'
'.$data.' 
'.&mt('Part ').join('.',@parts).'
'.$data.' 
'.$parts[0].'
Transaction '.$version.''.&mt('Transaction [_1]',$version).''.&unescape($value).' '.$value.' 
Current'.&mt('Current').''.$value.' 
'; + $prevattempts.= &end_data_table_row().&end_data_table(); } else { - $prevattempts='Nothing submitted - no attempts.'; + $prevattempts= + &start_data_table().&start_data_table_row(). + '
'.&mt('Nothing submitted - no attempts.').''.&mt('No data.').'
$lt{'doma'}:$domform
$lt{'usr'}: $srchbysel $srchtypesel $srchinsel
$lt{'doma'}: $domform

END_BLOCK @@ -5751,7 +6381,58 @@ END_BLOCK return $output; } - +sub username_rule_check { + my ($srch,$caller) = @_; + my ($response,@curr_rules,%inst_results,$rulematch); + my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($srch->{'srchdomain'}); + if (ref($srch) eq 'HASH') { + (my $inst_response,%inst_results) = + &Apache::lonnet::get_instuser($srch->{'srchdomain'}, + $srch->{'srchterm'}); + my %domconfig = &Apache::lonnet::get_dom('configuration', + ['usercreation'],$srch->{'srchdomain'}); + if (ref($domconfig{'usercreation'}) eq 'HASH') { + if (ref($domconfig{'usercreation'}{'username_rule'}) eq 'ARRAY') { + @curr_rules = @{$domconfig{'usercreation'}{'username_rule'}}; + } + } + if (@curr_rules > 0) { + my $domdesc = &Apache::lonnet::domain($srch->{'srchdomain'},'description'); + my $instuser_reqd; + my %rule_check = &Apache::lonnet::inst_rulecheck($srch->{'srchdomain'},$srch->{'srchterm'},\@curr_rules); + foreach my $rule (@curr_rules) { + if ($rule_check{$rule}) { + $rulematch = $rule; + if ($inst_response eq 'ok') { + if (keys(%inst_results) == 0) { + if ($caller eq 'new') { + $response = &mt('The username you chose matches the format of usernames defined for [_1], but the user does not exist in the institutional directory.',$domdesc).'
'.&mt("You must choose a username with a different format -- one that will not conflict with 'official' institutional usernames."); + } + } + } + last; + } + } + if ($response) { + if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) { + if (@{$ruleorder} > 0) { + $response .= '
'.&mt('Usernames with the following format(s) may only be used for verified users at [_1]:',$domdesc).' '; + } + } + } + } + return ($response,$rulematch,$rules,%inst_results); +} =pod @@ -6124,20 +6805,21 @@ sub csv_print_samples { my ($r,$records) = @_; my $samples = &get_samples($records,3); - $r->print(&mt('Samples').'
'); + $r->print(&mt('Samples').'
'.&start_data_table(). + &start_data_table_header_row()); foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { $r->print(''); } - $r->print(''); + $r->print(&end_data_table_header_row()); foreach my $hash (@$samples) { - $r->print(''); + $r->print(&start_data_table_row()); foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { $r->print(''); } - $r->print(''); + $r->print(&end_data_table_row()); } - $r->print('
'.&mt('Column [_1]',($sample+1)).'
'); if (defined($$hash{$sample})) { $r->print($$hash{$sample}); } $r->print('

'."\n"); + $r->print(&end_data_table().'
'."\n"); } ###################################################### @@ -6162,12 +6844,13 @@ sub csv_print_select_table { my $i=0; my $samples = &get_samples($records,1); $r->print(&mt('Associate columns with student attributes.')."\n". - ''. + &start_data_table().&start_data_table_header_row(). ''. - ''."\n"); + ''. + &end_data_table_header_row()."\n"); foreach my $array_ref (@$d) { my ($value,$display,$defaultcol)=@{ $array_ref }; - $r->print(''); + $r->print(&start_data_table_row().''); $r->print(''."\n"); + $r->print(''.&end_data_table_row()."\n"); $i++; } + $r->print(&end_data_table()); $i--; return $i; } @@ -6206,11 +6890,13 @@ sub csv_samples_select_table { my $i=0; # my $samples = &get_samples($records,3); - $r->print('
'.&mt('Attribute').''.&mt('Column').'
'.&mt('Column').'
'.$display.'
'.$display.'
'); + $r->print(&start_data_table(). + &start_data_table_header_row().''. + &end_data_table_header_row()); foreach my $key (sort(keys(%{ $samples->[0] }))) { - $r->print(''); + $r->print(''.&end_data_table_row()); $i++; } + $r->print(&end_data_table()); $i--; return($i); } @@ -6913,7 +7600,7 @@ sub commit_studentrole { ############################################################ sub check_clone { - my ($args) = @_; + my ($args,$linefeed) = @_; my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); @@ -6921,28 +7608,33 @@ sub check_clone { my $can_clone = 0; if ($clonehome eq 'no_host') { - $clonemsg = &mt('Attempting to clone non-existing [_1]', - $args->{'crstype'}); + $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->{'form.clonedomain'}) { + 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'}); + 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); } @@ -6959,9 +7651,11 @@ sub construct_course { # my ($can_clone, $clonemsg, $cloneid, $clonehome); if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { - ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args); + ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed); if ($context ne 'auto') { - $clonemsg = ''.$clonemsg.''; + if ($clonemsg ne '') { + $clonemsg = ''.$clonemsg.''; + } } $outcome .= $clonemsg.$linefeed; @@ -7305,10 +7999,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; }
'. - &mt('Field').''.&mt('Samples').'
'. + &mt('Field').''.&mt('Samples').'