--- loncom/interface/loncommon.pm 2012/07/07 21:58:14 1.1086 +++ loncom/interface/loncommon.pm 2012/12/04 18:50:33 1.1100 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1086 2012/07/07 21:58:14 raeburn Exp $ +# $Id: loncommon.pm,v 1.1100 2012/12/04 18:50:33 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -70,6 +70,9 @@ use Apache::lonclonecourse(); use LONCAPA qw(:DEFAULT :match); use DateTime::TimeZone; use DateTime::Locale::Catalog; +use Text::Aspell; +use Authen::Captcha; +use Captcha::reCAPTCHA; # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -154,6 +157,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; @@ -188,14 +192,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); @@ -657,7 +662,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)); @@ -885,10 +890,14 @@ sub check_uncheck_jscript { function checkAll(field) { if (field.length > 0) { for (i = 0; i < field.length; i++) { - field[i].checked = true ; + if (!field[i].disabled) { + field[i].checked = true; + } } } else { - field.checked = true + if (!field.disabled) { + field.checked = true; + } } } @@ -995,6 +1004,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 @@ -2986,6 +3022,45 @@ sub get_related_words { untie %thesaurus_db; return @Words; } +############################################################### +# +# Spell checking +# + +=pod + +=head1 Spell checking + +=over 4 + +=item * &check_spelling($wordlist $language) + +Takes a string containing words and feeds it to an external +spellcheck program via a pipeline. Returns a string containing +them mis-spelled words. + +Parameters: + +=over 4 + +=item - $wordlist + +String that will be fed into the spellcheck program. + +=item - $language + +Language string that specifies the language for which the spell +check will be performed. + +=back + +=back + +Note: This sub assumes that aspell is installed. + + +=cut + =pod @@ -2993,6 +3068,31 @@ sub get_related_words { =cut +sub check_spelling { + my ($wordlist, $language) = @_; + my @misspellings; + + # Generate the speller and set the langauge. + # if explicitly selected: + + my $speller = Text::Aspell->new; + if ($language) { + $speller->set_option('lang', $language); + } + + # Turn the word list into an array of words by splittingon whitespace + + my @words = split(/\s+/, $wordlist); + + foreach my $word (@words) { + if(! $speller->check($word)) { + push(@misspellings, $word); + } + } + return join(' ', @misspellings); + +} + # -------------------------------------------------------------- Plaintext name =pod @@ -3226,7 +3326,7 @@ sub aboutmewrapper { if (!defined($username) && !defined($domain)) { return; } - return ''.$link.''; } @@ -4960,6 +5060,10 @@ Inputs: should it have jsmath forced on by the current page +=item * $advtoolsref, optional argument, ref to an array containing + inlineremote items to be added in "Functions" menu below + breadcrumbs. + =back Returns: A uniform header for LON-CAPA web pages. @@ -4971,7 +5075,7 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, - $no_nav_bar,$bgcolor,$args)=@_; + $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_; my $public; if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) @@ -5090,8 +5194,15 @@ sub bodytag { if ($env{'request.state'} eq 'construct') { $bodytag .= &Apache::lonmenu::innerregister($forcereg, $args->{'bread_crumbs'}); - } elsif ($forcereg) { - $bodytag .= &Apache::lonmenu::innerregister($forcereg); + } elsif ($forcereg) { + $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, + $args->{'group'}); + } else { + $bodytag .= + &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, + $forcereg,$args->{'group'}, + $args->{'bread_crumbs'}, + $advtoolsref); } }else{ # this is to seperate menu from content when there's no secondary @@ -5306,10 +5417,12 @@ form, .inline { .LC_error { color: red; - font-size: larger; } -.LC_warning, +.LC_warning { + color: darkorange; +} + .LC_diff_removed { color: red; } @@ -5472,11 +5585,11 @@ td.LC_table_cell_checkbox { text-align: left; } -.LC_head_subbox { +.LC_head_subbox, .LC_actionbox { clear:both; background: #F8F8F8; /* $sidebg; */ border: 1px solid $sidebg; - margin: 0 0 10px 0; + margin: 0 0 10px 0; padding: 3px; text-align: left; } @@ -6171,7 +6284,6 @@ div.LC_docs_entry_move { table.LC_data_table tr > td.LC_docs_entry_commands, table.LC_data_table tr > td.LC_docs_entry_parameter { - background: #DDDDDD; font-size: x-small; } @@ -7007,6 +7119,27 @@ ul.LC_funclist li { cursor:pointer; } +/* + styles used by TTH when "Default set of options to pass to tth/m + when converting TeX" in course settings has been set + + option passed: -t + +*/ + +td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;} +td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;} +td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;} +td div.norm {line-height:normal;} + +/* + option passed -y3 +*/ + +span.roman {font-family: serif; font-style: normal; font-weight: normal;} +span.overacc2 {position: relative; left: .8em; top: -1.2ex;} +span.overacc1 {position: relative; left: .6em; top: -1.2ex;} + END } @@ -7276,6 +7409,8 @@ $args - additional optional args support current page bread_crumbs -> Array containing breadcrumbs bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs + group -> includes the current group, if page is for a + specific group =back @@ -7288,7 +7423,7 @@ sub start_page { #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); $env{'internal.start_page'}++; - my $result; + my ($result,@advtools); if (! exists($args->{'skip_phases'}{'head'}) ) { $result .= &xml_begin() . &headtag($title, $head_extra, $args); @@ -7305,7 +7440,8 @@ sub start_page { $args->{'function'}, $args->{'add_entries'}, $args->{'only_body'}, $args->{'domain'}, $args->{'force_register'}, $args->{'no_nav_bar'}, - $args->{'bgcolor'}, $args); + $args->{'bgcolor'}, $args, + \@advtools); } } @@ -7334,6 +7470,10 @@ sub start_page { &Apache::lonhtmlcommon::add_breadcrumb($crumb); } } + # if @advtools array contains items add then to the breadcrumbs + if (@advtools > 0) { + &Apache::lonmenu::advtools_crumbs(@advtools); + } #if bread_crumbs_component exists show it as headline else show only the breadcrumbs if(exists($args->{'bread_crumbs_component'})){ @@ -7729,7 +7869,7 @@ sub simple_error_page { my ($r,$title,$msg) = @_; my $page = &Apache::loncommon::start_page($title). - &mt($msg). + '

'.&mt($msg).'

'. &Apache::loncommon::end_page(); if (ref($r)) { $r->print($page); @@ -11179,11 +11319,11 @@ sub process_extracted_files { if ($env{'form.folderpath'}) { my @items = split('&',$env{'form.folderpath'}); $folders{'0'} = $items[-2]; - $containers{'0'}='sequence'; - } elsif ($env{'form.pagepath'}) { - my @items = split('&',$env{'form.pagepath'}); - $folders{'0'} = $items[-2]; - $containers{'0'}='page'; + if ($env{'form.folderpath'} =~ /\:1$/) { + $containers{'0'}='page'; + } else { + $containers{'0'}='sequence'; + } } my @archdirs = &get_env_multiple('form.archive_directory'); if ($numitems) { @@ -11258,7 +11398,7 @@ sub process_extracted_files { my ($outtext,$errtext) = &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. $docuname.'/'.$folders{$outer}. - '.'.$containers{$outer},1); + '.'.$containers{$outer},1,1); $newseqid{$i} = $newidx; unless ($errtext) { $result .= '
  • '.&mt('Folder: [_1] added to course',$docstitle).'
  • '."\n"; @@ -11291,7 +11431,7 @@ sub process_extracted_files { my ($outtext,$errtext)= &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. $docuname.'/'.$folders{$outer}. - '.'.$containers{$outer},1); + '.'.$containers{$outer},1,1); unless ($errtext) { if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { $result .= '
  • '.&mt('File: [_1] added to course',$docstitle).'
  • '."\n"; @@ -13778,6 +13918,20 @@ sub init_user_environment { \%userenv,\%domdef,\%is_adv); } + $userenv{'canrequest.author'} = + &Apache::lonnet::usertools_access($username,$domain,'requestauthor', + 'reload','requestauthor', + \%userenv,\%domdef,\%is_adv); + my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], + $domain,$username); + my $reqstatus = $reqauthor{'author_status'}; + if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { + if (ref($reqauthor{'author'}) eq 'HASH') { + $userenv{'requestauthorqueued'} = $reqstatus.':'. + $reqauthor{'author'}{'timestamp'}; + } + } + $env{'user.environment'} = "$lonids/$cookie.id"; if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id", @@ -13952,6 +14106,164 @@ sub parse_supplemental_title { return $title; } +sub captcha_display { + my ($context,$lonhost) = @_; + my ($output,$error); + my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + if ($captcha eq 'original') { + $output = &create_captcha(); + unless ($output) { + $error = 'captcha'; + } + } elsif ($captcha eq 'recaptcha') { + $output = &create_recaptcha($pubkey); + unless ($output) { + $error = 'recaptcha'; + } + } + return ($output,$error); +} + +sub captcha_response { + my ($context,$lonhost) = @_; + my ($captcha_chk,$captcha_error); + my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + if ($captcha eq 'original') { + ($captcha_chk,$captcha_error) = &check_captcha(); + } elsif ($captcha eq 'recaptcha') { + $captcha_chk = &check_recaptcha($privkey); + } else { + $captcha_chk = 1; + } + return ($captcha_chk,$captcha_error); +} + +sub get_captcha_config { + my ($context,$lonhost) = @_; + my ($captcha,$pubkey,$privkey,$hashtocheck); + my $hostname = &Apache::lonnet::hostname($lonhost); + my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); + my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); + if ($context eq 'usercreation') { + my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom); + if (ref($domconfig{$context}) eq 'HASH') { + $hashtocheck = $domconfig{$context}{'cancreate'}; + if (ref($hashtocheck) eq 'HASH') { + if ($hashtocheck->{'captcha'} eq 'recaptcha') { + if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') { + $pubkey = $hashtocheck->{'recaptchakeys'}{'public'}; + $privkey = $hashtocheck->{'recaptchakeys'}{'private'}; + } + if ($privkey && $pubkey) { + $captcha = 'recaptcha'; + } else { + $captcha = 'original'; + } + } elsif ($hashtocheck->{'captcha'} ne 'notused') { + $captcha = 'original'; + } + } + } else { + $captcha = 'captcha'; + } + } elsif ($context eq 'login') { + my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom); + if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') { + $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'}; + $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'}; + if ($privkey && $pubkey) { + $captcha = 'recaptcha'; + } else { + $captcha = 'original'; + } + } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') { + $captcha = 'original'; + } + } + return ($captcha,$pubkey,$privkey); +} + +sub create_captcha { + my %captcha_params = &captcha_settings(); + my ($output,$maxtries,$tries) = ('',10,0); + while ($tries < $maxtries) { + $tries ++; + my $captcha = Authen::Captcha->new ( + output_folder => $captcha_params{'output_dir'}, + data_folder => $captcha_params{'db_dir'}, + ); + my $md5sum = $captcha->generate_code($captcha_params{'numchars'}); + + if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { + $output = ''."\n". + &mt('Type in the letters/numbers shown below').' '. + '
    '. + ''; + last; + } + } + return $output; +} + +sub captcha_settings { + my %captcha_params = ( + output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'}, + www_output_dir => "/captchaspool", + db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'}, + numchars => '5', + ); + return %captcha_params; +} + +sub check_captcha { + my ($captcha_chk,$captcha_error); + my $code = $env{'form.code'}; + my $md5sum = $env{'form.crypt'}; + my %captcha_params = &captcha_settings(); + my $captcha = Authen::Captcha->new( + output_folder => $captcha_params{'output_dir'}, + data_folder => $captcha_params{'db_dir'}, + ); + my $captcha_chk = $captcha->check_code($code,$md5sum); + my %captcha_hash = ( + 0 => 'Code not checked (file error)', + -1 => 'Failed: code expired', + -2 => 'Failed: invalid code (not in database)', + -3 => 'Failed: invalid code (code does not match crypt)', + ); + if ($captcha_chk != 1) { + $captcha_error = $captcha_hash{$captcha_chk} + } + return ($captcha_chk,$captcha_error); +} + +sub create_recaptcha { + my ($pubkey) = @_; + my $captcha = Captcha::reCAPTCHA->new; + return $captcha->get_options_setter({theme => 'white'})."\n". + $captcha->get_html($pubkey). + &mt('If either word is hard to read, [_1] will replace them.', + 'reCAPTCHA refresh'). + '

    '; +} + +sub check_recaptcha { + my ($privkey) = @_; + my $captcha_chk; + my $captcha = Captcha::reCAPTCHA->new; + my $captcha_result = + $captcha->check_answer( + $privkey, + $ENV{'REMOTE_ADDR'}, + $env{'form.recaptcha_challenge_field'}, + $env{'form.recaptcha_response_field'}, + ); + if ($captcha_result->{is_valid}) { + $captcha_chk = 1; + } + return $captcha_chk; +} + =pod =back