--- loncom/interface/loncommon.pm 2013/09/07 00:46:18 1.1075.2.51 +++ loncom/interface/loncommon.pm 2013/05/03 21:57:13 1.1126 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.51 2013/09/07 00:46:18 raeburn Exp $ +# $Id: loncommon.pm,v 1.1126 2013/05/03 21:57:13 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 @@ -1234,11 +1264,7 @@ sub help_open_topic { $topic=~s/\W/\_/g; if (!$stayOnPage) { - if ($env{'browser.mobile'}) { - $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');"; - } else { - $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; - } + $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');"; } elsif ($stayOnPage eq 'popup') { $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; } else { @@ -2180,7 +2206,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 @@ -2198,7 +2224,7 @@ sub select_dom_form { } if ($includeempty) { @domains=('',@domains); } if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; + map { $exclude{$_} = 1; } @{$excdoms}; } my $selectdomain = "'."\n"; @@ -10262,47 +10052,6 @@ sub ask_for_embedded_content { return ($output,$counter,$numpathchg); } - -=pod - -=item * clean_path($name) - -Performs clean-up of directories, subdirectories and filename in an -embedded object, referenced in an HTML file which is being uploaded -to a course or portfolio, where -"Upload embedded images/multimedia files if HTML file" checkbox was -checked. - -Clean-up is similar to replacements in lonnet::clean_filename() -except each / between sub-directory and next level is preserved. - -=cut - -sub clean_path { - my ($embed_file) = @_; - $embed_file =~s{^/+}{}; - my @contents; - if ($embed_file =~ m{/}) { - @contents = split(/\//,$embed_file); - } else { - @contents = ($embed_file); - } - my $lastidx = scalar(@contents)-1; - for (my $i=0; $i<=$lastidx; $i++) { - $contents[$i]=~s{\\}{/}g; - $contents[$i]=~s/\s+/\_/g; - $contents[$i]=~s{[^/\w\.\-]}{}g; - if ($i == $lastidx) { - $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g; - } - } - if ($lastidx > 0) { - return join('/',@contents); - } else { - return $contents[0]; - } -} - sub embedded_file_element { my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_; return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') && @@ -10626,7 +10375,7 @@ sub modify_html_refs { } my (%allfiles,%codebase,$output,$content); my @changes = &get_env_multiple('form.namechange'); - unless ((@changes > 0) || ($context eq 'syllabus')) { + unless ((@changes > 0) || ($context eq 'syllabus')) { if (wantarray) { return ('',0,0); } else { @@ -10691,7 +10440,6 @@ sub modify_html_refs { my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi); $count += $numchg; $allfiles{$newname} = $allfiles{$ref}; - delete($allfiles{$ref}); } if ($env{'form.embedded_codebase_'.$i} ne '') { $codebase = &unescape($env{'form.embedded_codebase_'.$i}); @@ -10761,7 +10509,7 @@ sub modify_html_refs { } } if ($rewrites) { - my $saveresult; + my $saveresult; my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); if ($url eq $container) { my ($fname) = ($container =~ m{/([^/]+)$}); @@ -11770,7 +11518,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -11890,7 +11638,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++) { @@ -11912,7 +11660,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}}"; @@ -11959,12 +11707,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; } } @@ -11974,7 +11722,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)) { @@ -12080,7 +11828,7 @@ sub get_folder_hierarchy { my @pcs = split(/,/,$pcslist); foreach my $pc (@pcs) { if ($pc == 1) { - push(@pathitems,&mt('Main Content')); + push(@pathitems,&mt('Main Course Documents')); } else { my $res = $navmap->getByMapPc($pc); if (ref($res)) { @@ -12095,7 +11843,7 @@ sub get_folder_hierarchy { } if ($showitem) { if ($mapres->{ID} eq '0.0') { - push(@pathitems,&mt('Main Content')); + push(@pathitems,&mt('Main Course Documents')); } else { my $maptitle = $mapres->compTitle(); $maptitle =~ s/\W+/_/g; @@ -12162,9 +11910,6 @@ 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); } } @@ -12173,9 +11918,6 @@ 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') { @@ -12216,9 +11958,6 @@ sub get_turnedin_filepath { $restitle = time; } } - if (length($restitle) > 12) { - $restitle = substr($restitle,0,12); - } push(@pathitems,$restitle); $path .= join('/',@pathitems); } @@ -13156,22 +12895,18 @@ sub restore_settings { =item * &build_recipient_list() -Build recipient lists for following types of e-mail: +Build recipient lists for five types of e-mail: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors -(d) Help requests, (e) Course requests needing approval, (f) loncapa -module change checking, student/employee ID conflict checks, as -generated by lonerrorhandler.pm, CHECKRPMS, loncron, -lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively. +(d) Help requests, (e) Course requests needing approval, generated by +lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and +loncoursequeueadmin.pm respectively. Inputs: -defmail (scalar - email address of default recipient), -mailing type (scalar: errormail, packagesmail, helpdeskmail, -requestsmail, updatesmail, or idconflictsmail). - +defmail (scalar - email address of default recipient), +mailing type (scalar - errormail, packagesmail, or helpdeskmail), 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. @@ -13547,7 +13282,7 @@ sub assign_category_rows { if (ref($cats->[$depth]{$parent}) eq 'ARRAY') { my $numchildren = @{$cats->[$depth]{$parent}}; my $css_class = $itemcount%2?' class="LC_odd_row"':''; - $text .= ''; + $text .= '
    '; for (my $j=0; $j<$numchildren; $j++) { $name = $cats->[$depth]{$parent}[$j]; $item = &escape($name).':'.&escape($parent).':'.$depth; @@ -13709,7 +13444,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; @@ -14345,7 +14080,7 @@ sub init_user_environment { # ------------------------------------ Check browser type and MathML capability my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r); + $clientunicode,$clientos) = &decode_user_agent($r); # ------------------------------------------------------------- Get environment @@ -14376,8 +14111,6 @@ sub init_user_environment { "browser.mathml" => $clientmathml, "browser.unicode" => $clientunicode, "browser.os" => $clientos, - "browser.mobile" => $clientmobile, - "browser.info" => $clientinfo, "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'}, "request.course.fn" => '', "request.course.uri" => '', @@ -14423,7 +14156,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'}; @@ -14630,30 +14363,6 @@ sub parse_supplemental_title { return $title; } -sub recurse_supplemental { - my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_; - if ($suppmap) { - my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); - if ($fatal) { - $errors ++; - } else { - if ($#LONCAPA::map::resources > 0) { - foreach my $res (@LONCAPA::map::resources) { - my ($title,$src,$ext,$type,$status)=split(/\:/,$res); - if (($src ne '') && ($status eq 'res')) { - if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { - ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors); - } else { - $numfiles ++; - } - } - } - } - } - } - return ($numfiles,$errors); -} - sub symb_to_docspath { my ($symb) = @_; return unless ($symb); @@ -14683,7 +14392,7 @@ sub symb_to_docspath { my $thistitle = $res->title(); $path .= '&'. &Apache::lonhtmlcommon::entity_encode($thisurl).'&'. - &escape($thistitle). + &Apache::lonhtmlcommon::entity_encode($thistitle). ':'.$res->randompick(). ':'.$res->randomout(). ':'.$res->encrypted(). @@ -14695,11 +14404,11 @@ sub symb_to_docspath { $path =~ s/^\&//; my $maptitle = $mapresobj->title(); if ($mapurl eq 'default') { - $maptitle = 'Main Content'; + $maptitle = 'Main Course Documents'; } $path .= (($path ne '')? '&' : ''). &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &escape($maptitle). + &Apache::lonhtmlcommon::entity_encode($maptitle). ':'.$mapresobj->randompick(). ':'.$mapresobj->randomout(). ':'.$mapresobj->encrypted(). @@ -14709,14 +14418,14 @@ sub symb_to_docspath { my $maptitle = &Apache::lonnet::gettitle($mapurl); my $ispage = (($type eq 'page')? 1 : ''); if ($mapurl eq 'default') { - $maptitle = 'Main Content'; + $maptitle = 'Main Course Documents'; } $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &escape($maptitle).':::::'.$ispage; + &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage; } unless ($mapurl eq 'default') { $path = 'default&'. - &escape('Main Content'). + &Apache::lonhtmlcommon::entity_encode('Main Course Documents'). ':::::&'.$path; } return $path; @@ -14729,12 +14438,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); @@ -14855,15 +14564,11 @@ 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,undef,$use_ssl). + $captcha->get_html($pubkey). &mt('If either word is hard to read, [_1] will replace them.', - 'reCAPTCHA refresh'). + ''). '

    '; }