--- loncom/interface/loncommon.pm 2014/02/22 00:02:13 1.1075.2.67 +++ loncom/interface/loncommon.pm 2013/08/20 14:33:42 1.1150 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.67 2014/02/22 00:02:13 raeburn Exp $ +# $Id: loncommon.pm,v 1.1150 2013/08/20 14:33:42 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -72,10 +72,9 @@ use Apache::lonuserstate(); use LONCAPA qw(:DEFAULT :match); use DateTime::TimeZone; use DateTime::Locale::Catalog; +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; -use Crypt::DES; -use DynaLoader; # for Crypt::DES version # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -160,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; @@ -194,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); @@ -665,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)); @@ -901,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; } } @@ -1016,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 @@ -1236,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 { @@ -1354,40 +1378,32 @@ sub help_open_menu { sub top_nav_help { my ($text) = @_; $text = &mt($text); - my $stay_on_page; - unless ($env{'environment.remote'} eq 'on') { - $stay_on_page = 1; - } - my ($link,$banner_link); - unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) { - $link = ($stay_on_page) ? "javascript:helpMenu('display')" - : "javascript:helpMenu('open')"; - $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page); - } + my $stay_on_page = 1; + + my $link = ($stay_on_page) ? "javascript:helpMenu('display')" + : "javascript:helpMenu('open')"; + my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page); + my $title = &mt('Get help'); - if ($link) { - return <<"END"; + + return <<"END"; $banner_link -$text + $text END - } else { - return ' '.$text.' '; - } } sub help_menu_js { - my ($httphost) = @_; + my ($text) = @_; my $stayOnPage = 1; my $width = 620; my $height = 600; my $helptopic=&general_help(); - my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp'; + my $details_link = '/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,*",},}); @@ -1419,10 +1435,9 @@ function helpMenu(target) { return; } function writeHelp(caller) { - caller.document.writeln('$start_page\\n\\n'); - caller.document.writeln('\\n$end_page'); - caller.document.close(); - caller.focus(); + caller.document.writeln('$start_page\\n\\n\\n$end_page') + caller.document.close() + caller.focus() } // END LON-CAPA Internal --> // ]]> @@ -1734,6 +1749,8 @@ RESIZE =head1 Excel and CSV file utility routines +=over 4 + =cut ############################################################### @@ -1741,8 +1758,6 @@ RESIZE =pod -=over 4 - =item * &csv_translate($text) Translate $text to allow it to be output as a 'comma separated values' @@ -2191,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 @@ -2209,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 = "'. + ''. $lt{'yes'}.' 
'. @@ -11375,7 +11304,6 @@ 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'} = []; @@ -11394,15 +11322,12 @@ 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") && ($version == 6)) || - (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { + } elsif ($item eq "$contents[0]/index.html") { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'}; $displayed{'web'} = $i; } else { - 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))) { + if ($item eq "$contents[0]/media") { push(@{$env{'form.archive_directory'}},$i); } $env{'form.archive_'.$i} = 'dependency'; @@ -11847,7 +11772,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -11967,7 +11892,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++) { @@ -11989,7 +11914,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}}"; @@ -12036,12 +11961,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; } } @@ -12051,7 +11976,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)) { @@ -12129,7 +12054,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, @@ -13241,14 +13166,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. @@ -13442,7 +13367,7 @@ sub extract_categories { =pod -=item * &recurse_categories() +=item *&recurse_categories() Recursively used to generate breadcrumb trails for course categories. @@ -13513,7 +13438,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. @@ -13590,7 +13515,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. @@ -13786,7 +13711,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; @@ -13908,7 +13833,7 @@ sub check_clone { } sub construct_course { - my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_; + my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_; my $outcome; my $linefeed = '
    '."\n"; if ($context eq 'auto') { @@ -14005,12 +13930,8 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories', - 'internal.uniquecode'], + 'categories'], $$crsudom,$$crsunum); - if ($args->{'textbook'}) { - $cenv{'internal.textbook'} = $args->{'textbook'}; - } } # @@ -14194,25 +14115,6 @@ sub construct_course { } } -# -# generate and store uniquecode (available to course requester), if course should have one. -# - if ($args->{'uniquecode'}) { - my ($code,$error) = &make_unique_code($$crsudom,$$crsunum); - if ($code) { - $cenv{'internal.uniquecode'} = $code; - my %crsinfo = - &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.'); - if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') { - $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code; - my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime'); - } - if (ref($coderef)) { - $$coderef = $code; - } - } - } - if ($args->{'disresdis'}) { $cenv{'pch.roles.denied'}='st'; } @@ -14281,60 +14183,6 @@ sub construct_course { return (1,$outcome); } -sub make_unique_code { - my ($cdom,$cnum) = @_; - # get lock on uniquecodes db - my $lockhash = { - $cnum."\0".'uniquecodes' => $env{'user.name'}. - ':'.$env{'user.domain'}, - }; - my $tries = 0; - my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); - my ($code,$error); - - while (($gotlock ne 'ok') && ($tries<3)) { - $tries ++; - sleep 1; - $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); - } - if ($gotlock eq 'ok') { - my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom); - my $gotcode; - my $attempts = 0; - while ((!$gotcode) && ($attempts < 100)) { - $code = &generate_code(); - if (!exists($currcodes{$code})) { - $gotcode = 1; - unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') { - $error = 'nostore'; - } - } - $attempts ++; - } - my @del_lock = ($cnum."\0".'uniquecodes'); - my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom); - } else { - $error = 'nolock'; - } - return ($code,$error); -} - -sub generate_code { - my $code; - my @letts = qw(B C D G H J K M N P Q R S T V W X Z); - for (my $i=0; $i<6; $i++) { - my $lettnum = int (rand 2); - my $item = ''; - if ($lettnum) { - $item = $letts[int( rand(18) )]; - } else { - $item = 1+int( rand(8) ); - } - $code .= $item; - } - return $code; -} - ############################################################ ############################################################ @@ -14362,12 +14210,11 @@ sub group_term { } sub course_types { - my @types = ('official','unofficial','community','textbook'); + my @types = ('official','unofficial','community'); my %typename = ( official => 'Official course', unofficial => 'Unofficial course', community => 'Community', - textbook => 'Textbook course', ); return (\@types,\%typename); } @@ -14552,12 +14399,6 @@ 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') { @@ -14570,7 +14411,7 @@ sub init_user_environment { undef,\%userenv,\%domdef,\%is_adv); } - foreach my $crstype ('official','unofficial','community','textbook') { + foreach my $crstype ('official','unofficial','community') { $userenv{'canrequest.'.$crstype} = &Apache::lonnet::usertools_access($username,$domain,$crstype, 'reload','requestcourses', @@ -14584,7 +14425,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'}; @@ -14890,15 +14731,15 @@ 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,$captcha); + return ($output,$error); } sub captcha_response { @@ -14974,9 +14815,8 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". &mt('Type in the letters/numbers shown below').' '. - ''. - '
    '. - 'captcha'; + '
    '. + ''; last; } } @@ -15017,13 +14857,9 @@ 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'). '

    '; @@ -15046,83 +14882,6 @@ sub check_recaptcha { return $captcha_chk; } -sub emailusername_info { - my @fields = ('firstname','lastname','institution','web','location','officialemail'); - my %titles = &Apache::lonlocal::texthash ( - lastname => 'Last Name', - firstname => 'First Name', - institution => 'School/college/university', - location => "School's city, state/province, country", - web => "School's web address", - officialemail => 'E-mail address at institution (if different)', - ); - return (\@fields,\%titles); -} - -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; -} - -# Use: -# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); -# -################################################## -# password associated functions # -################################################## -sub des_keys { - # Make a new key for DES encryption. - # Each key has two parts which are returned separately. - # Please note: Each key must be passed through the &hex function - # before it is output to the web browser. The hex versions cannot - # be used to decrypt. - my @hexstr=('0','1','2','3','4','5','6','7', - '8','9','a','b','c','d','e','f'); - my $lkey=''; - for (0..7) { - $lkey.=$hexstr[rand(15)]; - } - my $ukey=''; - for (0..7) { - $ukey.=$hexstr[rand(15)]; - } - return ($lkey,$ukey); -} - -sub des_decrypt { - my ($key,$cyphertext) = @_; - my $keybin=pack("H16",$key); - my $cypher; - if ($Crypt::DES::VERSION>=2.03) { - $cypher=new Crypt::DES $keybin; - } else { - $cypher=new DES $keybin; - } - my $plaintext= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); - $plaintext.= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); - $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); - return $plaintext; -} - =pod =back