--- loncom/interface/loncommon.pm 2013/08/19 07:44:32 1.1075.2.47 +++ loncom/interface/loncommon.pm 2013/12/20 00:08:22 1.1164 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.47 2013/08/19 07:44:32 raeburn Exp $ +# $Id: loncommon.pm,v 1.1164 2013/12/20 00:08:22 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -72,6 +72,7 @@ use Apache::lonuserstate(); use LONCAPA qw(:DEFAULT :match); use DateTime::TimeZone; use DateTime::Locale::Catalog; +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; @@ -158,6 +159,7 @@ sub ssi_with_retries { # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; +my %supported_codes; my %latex_language; # For choosing hyphenation in my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; @@ -192,14 +194,15 @@ BEGIN { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); - my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); + my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; + $supported_codes{$key} = $code; } if ($latex) { $latex_language_bykey{$key} = $latex; - $latex_language{$two} = $latex; + $latex_language{$code} = $latex; } } close($fh); @@ -663,7 +666,7 @@ if (!Array.prototype.indexOf) { var n = 0; if (arguments.length > 0) { n = Number(arguments[1]); - if (n !== n) { // shortcut for verifying if it's NaN + if (n !== n) { // shortcut for verifying if it is NaN n = 0; } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) { n = (n > 0 || -1) * Math.floor(Math.abs(n)); @@ -899,12 +902,12 @@ sub check_uncheck_jscript { function checkAll(field) { if (field.length > 0) { for (i = 0; i < field.length; i++) { - if (!field[i].disabled) { + if (!field[i].disabled) { field[i].checked = true; } } } else { - if (!field.disabled) { + if (!field.disabled) { field.checked = true; } } @@ -1014,6 +1017,33 @@ sub select_language { =pod + +=item * &list_languages() + +Returns an array reference that is suitable for use in language prompters. +Each array element is itself a two element array. The first element +is the language code. The second element a descsriptiuon of the +language itself. This is suitable for use in e.g. +&Apache::edit::select_arg (once dereferenced that is). + +=cut + +sub list_languages { + my @lang_choices; + + foreach my $id (&languageids()) { + my $code = &supportedlanguagecode($id); + if ($code) { + my $selector = $supported_codes{$id}; + my $description = &plainlanguagedescription($id); + push (@lang_choices, [$selector, $description]); + } + } + return \@lang_choices; +} + +=pod + =item * &linked_select_forms(...) linked_select_forms returns a string containing a block @@ -1358,22 +1388,23 @@ sub top_nav_help { return <<"END"; $banner_link - $text +$text END } sub help_menu_js { - my ($text) = @_; + my ($httphost) = @_; my $stayOnPage = 1; my $width = 620; my $height = 600; my $helptopic=&general_help(); - my $details_link = '/adm/help/'.$helptopic.'.hlp'; + my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp'; my $nothing=&Apache::lonhtmlcommon::javascript_nothing(); my $start_page = &Apache::loncommon::start_page('Help Menu', undef, {'frameset' => 1, 'js_ready' => 1, + 'use_absolute' => $httphost, 'add_entries' => { 'border' => '0', 'rows' => "110,*",},}); @@ -1719,8 +1750,6 @@ RESIZE =head1 Excel and CSV file utility routines -=over 4 - =cut ############################################################### @@ -1728,6 +1757,8 @@ RESIZE =pod +=over 4 + =item * &csv_translate($text) Translate $text to allow it to be output as a 'comma separated values' @@ -2176,7 +2207,7 @@ The optional $onchange argument specifie The optional $incdoms is a reference to an array of domains which will be the only available options. -The optional $excdoms is a reference to an array of domains which will be excluded from the available options. +The optional $excdoms is a reference to an array of domains which will be excluded from the available options. =cut @@ -2194,7 +2225,7 @@ sub select_dom_form { } if ($includeempty) { @domains=('',@domains); } if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; + map { $exclude{$_} = 1; } @{$excdoms}; } my $selectdomain = "'. + ''. $lt{'yes'}.' 
'. @@ -11291,6 +11349,7 @@ sub process_decompression { \%titles,\%children); } if ($env{'form.autoextract_camtasia'}) { + my $version = $env{'form.autoextract_camtasia'}; my %displayed; my $total = 1; $env{'form.archive_directory'} = []; @@ -11309,12 +11368,15 @@ sub process_decompression { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'}; $displayed{'folder'} = $i; - } elsif ($item eq "$contents[0]/index.html") { + } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) || + (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'}; $displayed{'web'} = $i; } else { - if ($item eq "$contents[0]/media") { + if ((($item eq "$contents[0]/media") && ($version == 6)) || + ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") || + ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) { push(@{$env{'form.archive_directory'}},$i); } $env{'form.archive_'.$i} = 'dependency'; @@ -11759,7 +11821,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -11879,7 +11941,7 @@ sub process_extracted_files { } } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; } } for (my $i=1; $i<=$numitems; $i++) { @@ -11901,7 +11963,7 @@ sub process_extracted_files { } if ($itemidx eq '') { $itemidx = 0; - } + } if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) { if ($mapinner{$referrer{$i}}) { $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}"; @@ -11948,12 +12010,12 @@ sub process_extracted_files { $showpath = "$relpath/$title"; } else { $showpath = "/$title"; - } + } $result .= '
  • '.&mt('[_1] included as a dependency',$showpath).'
  • '."\n"; - } + } unless ($ishome) { my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; + $fetch =~ s/^\Q$prefix$dir\E//; $prompttofetch{$fetch} = 1; } } @@ -11963,7 +12025,7 @@ sub process_extracted_files { $path,$env{'form.archive_content_'.$referrer{$i}}).'
    '; } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; } } if (keys(%todelete)) { @@ -12041,7 +12103,7 @@ sub cleanup_empty_dirs { =pod -=item &get_folder_hierarchy() +=item * &get_folder_hierarchy() Provides hierarchy of names of folders/sub-folders containing the current item, @@ -12151,6 +12213,9 @@ sub get_turnedin_filepath { my $title = $res->compTitle(); $title =~ s/\W+/_/g; if ($title ne '') { + if (($pc > 1) && (length($title) > 12)) { + $title = substr($title,0,12); + } push(@pathitems,$title); } } @@ -12159,6 +12224,9 @@ sub get_turnedin_filepath { my $maptitle = $mapres->compTitle(); $maptitle =~ s/\W+/_/g; if ($maptitle ne '') { + if (length($maptitle) > 12) { + $maptitle = substr($maptitle,0,12); + } push(@pathitems,$maptitle); } unless ($env{'request.state'} eq 'construct') { @@ -12199,6 +12267,9 @@ sub get_turnedin_filepath { $restitle = time; } } + if (length($restitle) > 12) { + $restitle = substr($restitle,0,12); + } push(@pathitems,$restitle); $path .= join('/',@pathitems); } @@ -13144,14 +13215,14 @@ generated by lonerrorhandler.pm, CHECKRP lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively. Inputs: -defmail (scalar - email address of default recipient), +defmail (scalar - email address of default recipient), mailing type (scalar: errormail, packagesmail, helpdeskmail, requestsmail, updatesmail, or idconflictsmail). defdom (domain for which to retrieve configuration settings), -origmail (scalar - email address of recipient from loncapa.conf, -i.e., predates configuration by DC via domainprefs.pm +origmail (scalar - email address of recipient from loncapa.conf, +i.e., predates configuration by DC via domainprefs.pm Returns: comma separated list of addresses to which to send e-mail. @@ -13345,7 +13416,7 @@ sub extract_categories { =pod -=item *&recurse_categories() +=item * &recurse_categories() Recursively used to generate breadcrumb trails for course categories. @@ -13416,7 +13487,7 @@ sub recurse_categories { =pod -=item *&assign_categories_table() +=item * &assign_categories_table() Create a datatable for display of hierarchical categories in a domain, with checkboxes to allow a course to be categorized. @@ -13493,7 +13564,7 @@ sub assign_categories_table { =pod -=item *&assign_category_rows() +=item * &assign_category_rows() Create a datatable row for display of nested categories in a domain, with checkboxes to allow a course to be categorized,called recursively. @@ -13689,7 +13760,7 @@ sub commit_studentrole { } } } else { - if ($secchange) { + if ($secchange) { $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed; } else { $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed; @@ -14377,6 +14448,12 @@ sub init_user_environment { $env{'browser.interface'}=$form->{'interface'}; } + if ($form->{'iptoken'}) { + my $lonhost = $r->dir_config('lonHostID'); + $initial_env{"user.noloadbalance"} = $lonhost; + $env{'user.noloadbalance'} = $lonhost; + } + my %is_adv = ( is_adv => $env{'user.adv'} ); my %domdef; unless ($domain eq 'public') { @@ -14403,7 +14480,7 @@ sub init_user_environment { my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], $domain,$username); my $reqstatus = $reqauthor{'author_status'}; - if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { + if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { if (ref($reqauthor{'author'}) eq 'HASH') { $userenv{'requestauthorqueued'} = $reqstatus.':'. $reqauthor{'author'}{'timestamp'}; @@ -14709,12 +14786,12 @@ sub captcha_display { if ($captcha eq 'original') { $output = &create_captcha(); unless ($output) { - $error = 'captcha'; + $error = 'captcha'; } } elsif ($captcha eq 'recaptcha') { $output = &create_recaptcha($pubkey); unless ($output) { - $error = 'recaptcha'; + $error = 'recaptcha'; } } return ($output,$error); @@ -14835,9 +14912,13 @@ sub check_captcha { sub create_recaptcha { my ($pubkey) = @_; + my $use_ssl; + if ($ENV{'SERVER_PORT'} == 443) { + $use_ssl = 1; + } my $captcha = Captcha::reCAPTCHA->new; return $captcha->get_options_setter({theme => 'white'})."\n". - $captcha->get_html($pubkey). + $captcha->get_html($pubkey,undef,$use_ssl). &mt('If either word is hard to read, [_1] will replace them.', 'reCAPTCHA refresh'). '

    '; @@ -14860,6 +14941,28 @@ sub check_recaptcha { return $captcha_chk; } +sub cleanup_html { + my ($incoming) = @_; + my $outgoing; + if ($incoming ne '') { + $outgoing = $incoming; + $outgoing =~ s/;/;/g; + $outgoing =~ s/\#/#/g; + $outgoing =~ s/\&/&/g; + $outgoing =~ s//>/g; + $outgoing =~ s/\(/(/g; + $outgoing =~ s/\)/)/g; + $outgoing =~ s/"/"/g; + $outgoing =~ s/'/'/g; + $outgoing =~ s/\$/$/g; + $outgoing =~ s{/}{/}g; + $outgoing =~ s/=/=/g; + $outgoing =~ s/\\/\/g + } + return $outgoing; +} + =pod =back