--- loncom/interface/loncommon.pm 2016/08/31 20:54:41 1.1075.2.110 +++ loncom/interface/loncommon.pm 2015/02/25 19:22:24 1.1206 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.110 2016/08/31 20:54:41 raeburn Exp $ +# $Id: loncommon.pm,v 1.1206 2015/02/25 19:22:24 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -72,12 +72,10 @@ use Apache::lonuserstate(); use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); use DateTime::TimeZone; -use DateTime::Locale; -use Encode(); +use DateTime::Locale::Catalog; +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; -use JSON::DWIW; -use LWP::UserAgent; use Crypt::DES; use DynaLoader; # for Crypt::DES version @@ -164,6 +162,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; @@ -198,14 +197,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); @@ -535,7 +535,7 @@ ENDAUTHORBRW sub coursebrowser_javascript { my ($domainfilter,$sec_element,$formname,$role_element,$crstype, - $credits_element,$instcode) = @_; + $credits_element) = @_; my $wintitle = 'Course_Browser'; if ($crstype eq 'Community') { $wintitle = 'Community_Browser'; @@ -586,12 +586,6 @@ sub coursebrowser_javascript { var ownername = document.forms[formid].ccuname.value; var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value; url += '&cloner='+ownername+':'+ownerdom; - if (type == 'Course') { - url += '&crscode='+document.forms[formid].crscode.value; - } - } - if (formname == 'requestcrs') { - url += '&crsdom=$domainfilter&crscode=$instcode'; } if (multflag !=null && multflag != '') { url += '&multiple='+multflag; @@ -675,7 +669,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)); @@ -911,12 +905,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; } } @@ -967,16 +961,15 @@ sub select_datelocale { } $output .= '> '; } - my @languages = &Apache::lonlocal::preferred_languages(); my (@possibles,%locale_names); - my @locales = DateTime::Locale->ids(); - foreach my $id (@locales) { - if ($id ne '') { - my ($en_terr,$native_terr); - my $loc = DateTime::Locale->load($id); - if (ref($loc)) { - $en_terr = $loc->name(); - $native_terr = $loc->native_name(); + my @locales = DateTime::Locale::Catalog::Locales; + foreach my $locale (@locales) { + if (ref($locale) eq 'HASH') { + my $id = $locale->{'id'}; + if ($id ne '') { + my $en_terr = $locale->{'en_territory'}; + my $native_terr = $locale->{'native_territory'}; + my @languages = &Apache::lonlocal::preferred_languages(); if (grep(/^en$/,@languages) || !@languages) { if ($en_terr ne '') { $locale_names{$id} = '('.$en_terr.')'; @@ -990,8 +983,7 @@ sub select_datelocale { $locale_names{$id} = '('.$en_terr.')'; } } - $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id}); - push(@possibles,$id); + push (@possibles,$id); } } } @@ -1002,7 +994,7 @@ sub select_datelocale { } $output.=">$item"; if ($locale_names{$item} ne '') { - $output.=' '.$locale_names{$item}; + $output.=" $locale_names{$item}\n"; } $output.="\n"; } @@ -1028,6 +1020,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 @@ -1248,11 +1267,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 { @@ -1301,11 +1316,11 @@ sub helpLatexCheatsheet { .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600) .''; unless ($not_author) { - $out .= ' ' - .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600) - .' ' - .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600) - .''; + $out .= '' + .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600) + .' ' + .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600) + .''; } $out .= ''; # End cheatsheet return $out; @@ -1368,10 +1383,8 @@ 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 $stay_on_page = 1; + my ($link,$banner_link); unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) { $link = ($stay_on_page) ? "javascript:helpMenu('display')" @@ -1401,9 +1414,9 @@ sub help_menu_js { &Apache::loncommon::start_page('Help Menu', undef, {'frameset' => 1, 'js_ready' => 1, - 'use_absolute' => $httphost, + 'use_absolute' => $httphost, 'add_entries' => { - 'border' => '0', + 'border' => '0', 'rows' => "110,*",},}); my $end_page = &Apache::loncommon::end_page({'frameset' => 1, @@ -1744,6 +1757,241 @@ RESIZE } +sub colorfuleditor_js { + return <<"COLORFULEDIT" + +COLORFULEDIT +} + +sub xmleditor_js { + return < + +XMLEDIT +} + +sub insert_folding_button { + my $curDepth = $Apache::lonxml::curdepth; + my $lastresource = $env{'request.ambiguous'}; + + return ""; +} + =pod =head1 Excel and CSV file utility routines @@ -2205,7 +2453,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 @@ -2223,7 +2471,7 @@ sub select_dom_form { } if ($includeempty) { @domains=('',@domains); } if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; + map { $exclude{$_} = 1; } @{$excdoms}; } my $selectdomain = "'; @@ -9289,10 +9441,10 @@ sub user_picker { next if ($option eq 'crs' && !$env{'request.course.id'}); if ($curr_selected{'srchin'} eq $option) { $srchinsel .= ' - '; + '; } else { $srchinsel .= ' - '; + '; } } $srchinsel .= "\n \n"; @@ -9301,10 +9453,10 @@ sub user_picker { foreach my $option ('lastname','lastfirst','uname') { if ($curr_selected{'srchby'} eq $option) { $srchbysel .= ' - '; + '; } else { $srchbysel .= ' - '; + '; } } $srchbysel .= "\n \n"; @@ -9313,10 +9465,10 @@ sub user_picker { foreach my $option ('begins','contains','exact') { if ($curr_selected{'srchtype'} eq $option) { $srchtypesel .= ' - '; + '; } else { $srchtypesel .= ' - '; + '; } } $srchtypesel .= "\n \n"; @@ -9401,46 +9553,46 @@ function validateEntry(callingForm) { if (srchterm == "") { checkok = 0; - msg += "$js_lt{'youm'}\\n"; + msg += "$lt{'youm'}\\n"; } if (srchtype== 'begins') { if (srchterm.length < 2) { checkok = 0; - msg += "$js_lt{'thte'}\\n"; + msg += "$lt{'thte'}\\n"; } } if (srchtype== 'contains') { if (srchterm.length < 3) { checkok = 0; - msg += "$js_lt{'thet'}\\n"; + msg += "$lt{'thet'}\\n"; } } if (srchin == 'instd') { if (srchdomain == '') { checkok = 0; - msg += "$js_lt{'yomc'}\\n"; + msg += "$lt{'yomc'}\\n"; } } if (srchin == 'dom') { if (srchdomain == '') { checkok = 0; - msg += "$js_lt{'ymcd'}\\n"; + msg += "$lt{'ymcd'}\\n"; } } if (srchby == 'lastfirst') { if (srchterm.indexOf(",") == -1) { checkok = 0; - msg += "$js_lt{'whus'}\\n"; + msg += "$lt{'whus'}\\n"; } if (srchterm.indexOf(",") == srchterm.length -1) { checkok = 0; - msg += "$js_lt{'whse'}\\n"; + msg += "$lt{'whse'}\\n"; } } if (checkok == 0) { - alert("$js_lt{'thfo'}\\n"+msg); + alert("$lt{'thfo'}\\n"+msg); return; } if (checkok == 1) { @@ -9458,10 +9610,10 @@ $new_user_create END_BLOCK $output .= &Apache::lonhtmlcommon::start_pick_box(). - &Apache::lonhtmlcommon::row_title($html_lt{'doma'}). + &Apache::lonhtmlcommon::row_title($lt{'doma'}). $domform. &Apache::lonhtmlcommon::row_closure(). - &Apache::lonhtmlcommon::row_title($html_lt{'usr'}). + &Apache::lonhtmlcommon::row_title($lt{'usr'}). $srchbysel. $srchtypesel. ''. @@ -9474,160 +9626,56 @@ END_BLOCK sub user_rule_check { my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_; - my ($response,%inst_response); + my $response; if (ref($usershash) eq 'HASH') { - if (keys(%{$usershash}) > 1) { - my (%by_username,%by_id,%userdoms); - my $checkid; - if (ref($checks) eq 'HASH') { - if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) { - $checkid = 1; - } - } - foreach my $user (keys(%{$usershash})) { - my ($uname,$udom) = split(/:/,$user); - if ($checkid) { - if (ref($usershash->{$user}) eq 'HASH') { - if ($usershash->{$user}->{'id'} ne '') { - $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; - $userdoms{$udom} = 1; - if (ref($inst_results) eq 'HASH') { - $inst_results->{$uname.':'.$udom} = {}; - } - } - } - } else { - $by_username{$udom}{$uname} = 1; - $userdoms{$udom} = 1; - if (ref($inst_results) eq 'HASH') { - $inst_results->{$uname.':'.$udom} = {}; - } - } - } - foreach my $udom (keys(%userdoms)) { - if (!$got_rules->{$udom}) { - my %domconfig = &Apache::lonnet::get_dom('configuration', - ['usercreation'],$udom); - if (ref($domconfig{'usercreation'}) eq 'HASH') { - foreach my $item ('username','id') { - if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { - $$curr_rules{$udom}{$item} = - $domconfig{'usercreation'}{$item.'_rule'}; - } - } - } - $got_rules->{$udom} = 1; - } + foreach my $user (keys(%{$usershash})) { + my ($uname,$udom) = split(/:/,$user); + next if ($udom eq '' || $uname eq ''); + my ($id,$newuser); + if (ref($usershash->{$user}) eq 'HASH') { + $newuser = $usershash->{$user}->{'newuser'}; + $id = $usershash->{$user}->{'id'}; } - if ($checkid) { - foreach my $udom (keys(%by_id)) { - my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id'); - if ($outcome eq 'ok') { - foreach my $id (keys(%{$by_id{$udom}})) { - my $uname = $by_id{$udom}{$id}; - $inst_response{$uname.':'.$udom} = $outcome; - } - if (ref($results) eq 'HASH') { - foreach my $uname (keys(%{$results})) { - if (exists($inst_response{$uname.':'.$udom})) { - $inst_response{$uname.':'.$udom} = $outcome; - $inst_results->{$uname.':'.$udom} = $results->{$uname}; - } - } - } - } + my $inst_response; + if (ref($checks) eq 'HASH') { + if (defined($checks->{'username'})) { + ($inst_response,%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + } elsif (defined($checks->{'id'})) { + ($inst_response,%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,undef,$id); } } else { - foreach my $udom (keys(%by_username)) { - my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom}); - if ($outcome eq 'ok') { - foreach my $uname (keys(%{$by_username{$udom}})) { - $inst_response{$uname.':'.$udom} = $outcome; - } - if (ref($results) eq 'HASH') { - foreach my $uname (keys(%{$results})) { - $inst_results->{$uname.':'.$udom} = $results->{$uname}; - } - } - } - } + ($inst_response,%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + return; } - } elsif (keys(%{$usershash}) == 1) { - my $user = (keys(%{$usershash}))[0]; - my ($uname,$udom) = split(/:/,$user); - if (($udom ne '') && ($uname ne '')) { - if (ref($usershash->{$user}) eq 'HASH') { - if (ref($checks) eq 'HASH') { - if (defined($checks->{'username'})) { - ($inst_response{$user},%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,$uname); - } elsif (defined($checks->{'id'})) { - if ($usershash->{$user}->{'id'} ne '') { - ($inst_response{$user},%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,undef, - $usershash->{$user}->{'id'}); - } else { - ($inst_response{$user},%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,$uname); - } + if (!$got_rules->{$udom}) { + my %domconfig = &Apache::lonnet::get_dom('configuration', + ['usercreation'],$udom); + if (ref($domconfig{'usercreation'}) eq 'HASH') { + foreach my $item ('username','id') { + if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { + $$curr_rules{$udom}{$item} = + $domconfig{'usercreation'}{$item.'_rule'}; } - } else { - ($inst_response{$user},%{$inst_results->{$user}}) = - &Apache::lonnet::get_instuser($udom,$uname); - return; - } - if (!$got_rules->{$udom}) { - my %domconfig = &Apache::lonnet::get_dom('configuration', - ['usercreation'],$udom); - if (ref($domconfig{'usercreation'}) eq 'HASH') { - foreach my $item ('username','id') { - if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { - $$curr_rules{$udom}{$item} = - $domconfig{'usercreation'}{$item.'_rule'}; - } - } - } - $got_rules->{$udom} = 1; } } - } else { - return; - } - } else { - return; - } - foreach my $user (keys(%{$usershash})) { - my ($uname,$udom) = split(/:/,$user); - next if (($udom eq '') || ($uname eq '')); - my $id; - if (ref($inst_results) eq 'HASH') { - if (ref($inst_results->{$user}) eq 'HASH') { - $id = $inst_results->{$user}->{'id'}; - } - } - if ($id eq '') { - if (ref($usershash->{$user})) { - $id = $usershash->{$user}->{'id'}; - } + $got_rules->{$udom} = 1; } foreach my $item (keys(%{$checks})) { if (ref($$curr_rules{$udom}) eq 'HASH') { if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') { if (@{$$curr_rules{$udom}{$item}} > 0) { - my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item, - $$curr_rules{$udom}{$item}); + my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item}); foreach my $rule (@{$$curr_rules{$udom}{$item}}) { if ($rule_check{$rule}) { $$rulematch{$user}{$item} = $rule; - if ($inst_response{$user} eq 'ok') { + if ($inst_response eq 'ok') { if (ref($inst_results) eq 'HASH') { if (ref($inst_results->{$user}) eq 'HASH') { if (keys(%{$inst_results->{$user}}) == 0) { $$alerts{$item}{$udom}{$uname} = 1; - } elsif ($item eq 'id') { - if ($inst_results->{$user}->{'id'} eq '') { - $$alerts{$item}{$udom}{$uname} = 1; - } } } } @@ -9895,9 +9943,7 @@ reservable_now - ref to hash of student_ Keys in inner hash are: (a) symb: either blank or symb to which slot use is restricted. - (b) endreserve: end date of reservation period. - (c) uniqueperiod: start,end dates when slot is to be uniquely - selected. + (b) endreserve: end date of reservation period. sorted_future - ref to array of student_schedulable slots reservable in the future, ordered by start date of reservation period. @@ -9908,8 +9954,6 @@ future_reservable - ref to hash of stude Keys in inner hash are: (a) symb: either blank or symb to which slot use is restricted. (b) startreserve: start date of reservation period. - (c) uniqueperiod: start,end dates when slot is to be uniquely - selected. =back @@ -9963,10 +10007,6 @@ sub get_future_slots { my $startreserve = $slots{$slot}->{'startreserve'}; my $endreserve = $slots{$slot}->{'endreserve'}; my $symb = $slots{$slot}->{'symb'}; - my $uniqueperiod; - if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') { - $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}}); - } if (($startreserve < $now) && (!$endreserve || $endreserve > $now)) { my $lastres = $endreserve; @@ -9975,15 +10015,13 @@ sub get_future_slots { } $reservable_now{$slot} = { symb => $symb, - endreserve => $lastres, - uniqueperiod => $uniqueperiod, + endreserve => $lastres }; } elsif (($startreserve > $now) && (!$endreserve || $endreserve > $startreserve)) { $future_reservable{$slot} = { symb => $symb, - startreserve => $startreserve, - uniqueperiod => $uniqueperiod, + startreserve => $startreserve }; } } @@ -10164,7 +10202,7 @@ sub ask_for_embedded_content { $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; } - if (($actionurl eq '/adm/portfolio') || + if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { my $current_path='/'; if ($env{'form.currentpath'}) { @@ -10196,18 +10234,18 @@ sub ask_for_embedded_content { $toplevel = $url; if ($args->{'context'} eq 'paste') { ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/}); - ($path) = + ($path) = ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/}); $fileloc = &Apache::lonnet::filelocation('',$toplevel); $fileloc =~ s{^/}{}; } } - } elsif ($actionurl eq '/adm/dependencies') { + } elsif ($actionurl eq '/adm/dependencies') { if ($env{'request.course.id'} ne '') { if (ref($args) eq 'HASH') { $url = $args->{'docs_url'}; $title = $args->{'docs_title'}; - $toplevel = $url; + $toplevel = $url; unless ($toplevel =~ m{^/}) { $toplevel = "/$url"; } @@ -10286,8 +10324,8 @@ sub ask_for_embedded_content { my $dirptr = 16384; foreach my $path (keys(%subdependencies)) { $currsubfile{$path} = {}; - if (($actionurl eq '/adm/portfolio') || - ($actionurl eq '/adm/coursegrp_portfolio')) { + if (($actionurl eq '/adm/portfolio') || + ($actionurl eq '/adm/coursegrp_portfolio')) { my ($sublistref,$listerror) = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath); if (ref($sublistref) eq 'ARRAY') { @@ -10429,7 +10467,7 @@ sub ask_for_embedded_content { $counter = scalar(keys(%existing)); $numpathchg = scalar(keys(%pathchanges)); return ($output,$counter,$numpathchg,\%existing); - } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && + } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) { $counter = scalar(keys(%existing)); $numpathchg = scalar(keys(%pathchanges)); @@ -10658,7 +10696,7 @@ sub ask_for_embedded_content { 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 +to a course or portfolio, where "Upload embedded images/multimedia files if HTML file" checkbox was checked. @@ -10677,7 +10715,7 @@ sub clean_path { @contents = ($embed_file); } my $lastidx = scalar(@contents)-1; - for (my $i=0; $i<=$lastidx; $i++) { + for (my $i=0; $i<=$lastidx; $i++) { $contents[$i]=~s{\\}{/}g; $contents[$i]=~s/\s+/\_/g; $contents[$i]=~s{[^/\w\.\-]}{}g; @@ -11016,7 +11054,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 { @@ -11151,7 +11189,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{/([^/]+)$}); @@ -11447,6 +11485,7 @@ function camtasiaToggle() { for (var i=0; i'; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; } } for (my $i=1; $i<=$numitems; $i++) { @@ -12355,7 +12394,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}}"; @@ -12402,12 +12441,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; } } @@ -12417,7 +12456,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)) { @@ -13607,14 +13646,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. @@ -14158,7 +14197,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; @@ -14245,91 +14284,33 @@ sub check_clone { (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) { $can_clone = 1; } else { - my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'], + my %clonehash = &Apache::lonnet::get('environment',['cloners'], $args->{'clonedomain'},$args->{'clonecourse'}); - if ($clonehash{'cloners'} eq '') { - my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'}); - if ($domdefs{'canclone'}) { - unless ($domdefs{'canclone'} eq 'none') { - if ($domdefs{'canclone'} eq 'domain') { - if ($args->{'ccdomain'} eq $args->{'clonedomain'}) { - $can_clone = 1; - } - } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && - ($args->{'clonedomain'} eq $args->{'course_domain'})) { - if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'}, - $clonehash{'internal.coursecode'},$args->{'crscode'})) { - $can_clone = 1; - } - } - } - } + my @cloners = split(/,/,$clonehash{'cloners'}); + if (grep(/^\*$/,@cloners)) { + $can_clone = 1; + } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) { + $can_clone = 1; } else { - my @cloners = split(/,/,$clonehash{'cloners'}); - if (grep(/^\*$/,@cloners)) { - $can_clone = 1; - } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) { - $can_clone = 1; - } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) { - $can_clone = 1; - } - unless ($can_clone) { - if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && - ($args->{'clonedomain'} eq $args->{'course_domain'})) { - my (%gotdomdefaults,%gotcodedefaults); - foreach my $cloner (@cloners) { - if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) && - ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) { - my (%codedefaults,@code_order); - if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') { - if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') { - %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}}; - } - if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') { - @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}}; - } - } else { - &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'}, - \%codedefaults, - \@code_order); - $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults; - $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order; - } - if (@code_order > 0) { - if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order, - $cloner,$clonehash{'internal.coursecode'}, - $args->{'crscode'})) { - $can_clone = 1; - last; - } - } - } - } - } - } - } - unless ($can_clone) { my $ccrole = 'cc'; if ($args->{'crstype'} eq 'Community') { $ccrole = 'co'; } - my %roleshash = - &Apache::lonnet::get_my_roles($args->{'ccuname'}, - $args->{'ccdomain'}, - 'userroles',['active'],[$ccrole], - [$args->{'clonedomain'}]); - if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) { + my %roleshash = + &Apache::lonnet::get_my_roles($args->{'ccuname'}, + $args->{'ccdomain'}, + 'userroles',['active'],[$ccrole], + [$args->{'clonedomain'}]); + if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) { $can_clone = 1; - } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'}, - $args->{'ccuname'},$args->{'ccdomain'})) { + } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) { $can_clone = 1; - } - } - unless ($can_clone) { - if ($args->{'crstype'} eq 'Community') { - $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); } 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'}); + if ($args->{'crstype'} eq 'Community') { + $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); + } 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'}); + } } } } @@ -14602,9 +14583,6 @@ sub construct_course { if ($args->{'setcontent'}) { $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; } - if ($args->{'setcomment'}) { - $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; - } } if ($args->{'reshome'}) { $cenv{'reshome'}=$args->{'reshome'}.'/'; @@ -14639,7 +14617,7 @@ sub construct_course { 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; } @@ -14724,7 +14702,7 @@ sub make_unique_code { my $tries = 0; my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); my ($code,$error); - + while (($gotlock ne 'ok') && ($tries<3)) { $tries ++; sleep 1; @@ -15029,7 +15007,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'}; @@ -15139,12 +15117,12 @@ and quotacheck.pl Inputs: -filterlist - anonymous array of fields to include as potential filters +filterlist - anonymous array of fields to include as potential filters crstype - course type roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used - to pop-open a course selector (will contain "extra element"). + to pop-open a course selector (will contain "extra element"). multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1 @@ -15160,19 +15138,19 @@ cloneruname - username of owner of new c clonerudom - domain of owner of new course who wants to clone -typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) +typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) codetitlesref - reference to array of titles of components in institutional codes (official courses) codedom - domain -formname - value of form element named "form". +formname - value of form element named "form". fixeddom - domain, if fixed. -prevphase - value to assign to form element named "phase" when going back to the previous screen +prevphase - value to assign to form element named "phase" when going back to the previous screen -cnameelement - name of form element in form on opener page which will receive title of selected course +cnameelement - name of form element in form on opener page which will receive title of selected course cnumelement - name of form element in form on opener page which will receive courseID of selected course @@ -15314,7 +15292,7 @@ sub build_filters { if (exists($filter->{'instcodefilter'})) { # if (($fixeddom) || ($formname eq 'requestcrs') || # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) { - if ($codedom) { + if ($codedom) { $officialjs = 1; ($instcodeform,$jscript,$$numtitlesref) = &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker', @@ -15443,7 +15421,7 @@ $typeelement return $jscript.$clonewarning.$output; } -=pod +=pod =item * &timebased_select_form() @@ -15458,7 +15436,7 @@ item - name of form element (sincefilter filter - anonymous hash of criteria and their values Returns: HTML for a select box contained a blank, then six time selections, - with value set in incoming form variables currently selected. + with value set in incoming form variables currently selected. Side Effects: None @@ -15495,7 +15473,7 @@ page load completion for page showing se Inputs: None -Returns: markup containing updateFilters() and hideSearching() javascript functions. +Returns: markup containing updateFilters() and hideSearching() javascript functions. Side Effects: None @@ -15534,7 +15512,7 @@ to retrieve a hash for which keys are co Inputs: -dom - domain being searched +dom - domain being searched type - course type ('Course' or 'Community' or '.' if any). @@ -15546,18 +15524,11 @@ cloneruname - optional username of new c clonerudom - optional domain of new course owner -domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, +domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, (used when DC is using course creation form) codetitles - reference to array of titles of components in institutional codes (official courses). -cc_clone - escaped comma separated list of courses for which course cloner has active CC role - (and so can clone automatically) - -reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone - -reqinstcode - institutional code of new course, where search_courses is used to identify potential - courses to clone Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type. @@ -15568,8 +15539,7 @@ Side Effects: None sub search_courses { - my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles, - $cc_clone,$reqcrsdom,$reqinstcode) = @_; + my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_; my (%courses,%showcourses,$cloner); if (($filter->{'ownerfilter'} ne '') || ($filter->{'ownerdomfilter'} ne '')) { @@ -15617,10 +15587,10 @@ sub search_courses { $filter->{'combownerfilter'}, $filter->{'coursefilter'}, undef,undef,$type,$regexpok,undef,undef, - undef,undef,$cloner,$cc_clone, + undef,undef,$cloner,$env{'form.cc_clone'}, $filter->{'cloneableonly'}, $createdbefore,$createdafter,undef, - $domcloner,undef,$reqcrsdom,$reqinstcode); + $domcloner); if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) { my $ccrole; if ($type eq 'Community') { @@ -15658,206 +15628,8 @@ sub search_courses { =back -=head1 Routines for version requirements for current course. - -=over 4 - -=item * &check_release_required() - -Compares required LON-CAPA version with version on server, and -if required version is newer looks for a server with the required version. - -Looks first at servers in user's owen domain; if none suitable, looks at -servers in course's domain are permitted to host sessions for user's domain. - -Inputs: - -$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) - -$courseid - Course ID of current course - -$rolecode - User's current role in course (for switchserver query string). - -$required - LON-CAPA version needed by course (format: Major.Minor). - - -Returns: - -$switchserver - query string tp append to /adm/switchserver call (if - current server's LON-CAPA version is too old. - -$warning - Message is displayed if no suitable server could be found. - -=cut - -sub check_release_required { - my ($loncaparev,$courseid,$rolecode,$required) = @_; - my ($switchserver,$warning); - if ($required ne '') { - my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/); - my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); - if ($reqdmajor ne '' && $reqdminor ne '') { - my $otherserver; - if (($major eq '' && $minor eq '') || - (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) { - my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1); - my $switchlcrev = - &Apache::lonnet::get_server_loncaparev($env{'user.domain'}, - $userdomserver); - my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); - if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) || - (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) { - my $cdom = $env{'course.'.$courseid.'.domain'}; - if ($cdom ne $env{'user.domain'}) { - my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1); - my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname); - my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); - my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom); - my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'}); - my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver); - my $canhost = - &Apache::lonnet::can_host_session($env{'user.domain'}, - $coursedomserver, - $remoterev, - $udomdefaults{'remotesessions'}, - $defdomdefaults{'hostedsessions'}); - - if ($canhost) { - $otherserver = $coursedomserver; - } else { - $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'
    '. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain."); - } - } else { - $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'
    '.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain)."); - } - } else { - $otherserver = $userdomserver; - } - } - if ($otherserver ne '') { - $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode; - } - } - } - return ($switchserver,$warning); -} - -=pod - -=item * &check_release_result() - -Inputs: - -$switchwarning - Warning message if no suitable server found to host session. - -$switchserver - query string to append to /adm/switchserver containing lonHostID - and current role. - -Returns: HTML to display with information about requirement to switch server. - Either displaying warning with link to Roles/Courses screen or - display link to switchserver. - -=cut - -sub check_release_result { - my ($switchwarning,$switchserver) = @_; - my $output = &start_page('Selected course unavailable on this server'). - '

    '; - if ($switchwarning) { - $output .= $switchwarning.'
    '; - if (&show_course()) { - $output .= &mt('Display courses'); - } else { - $output .= &mt('Display roles'); - } - $output .= ''; - } elsif ($switchserver) { - $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.'). - '
    '. - ''. - &mt('Switch Server'). - ''; - } - $output .= '

    '.&end_page(); - return $output; -} - -=pod - -=item * &needs_coursereinit() - -Determine if course contents stored for user's session needs to be -refreshed, because content has changed since "Big Hash" last tied. - -Check for change is made if time last checked is more than 10 minutes ago -(by default). - -Inputs: - -$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) - -$interval (optional) - Time which may elapse (in s) between last check for content - change in current course. (default: 600 s). - -Returns: an array; first element is: - -=over 4 - -'switch' - if content updates mean user's session - needs to be switched to a server running a newer LON-CAPA version - -'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded) - on current server hosting user's session - -'' - if no action required. - -=back - -If first item element is 'switch': - -second item is $switchwarning - Warning message if no suitable server found to host session. - -third item is $switchserver - query string to append to /adm/switchserver containing lonHostID - and current role. - -otherwise: no other elements returned. - -=back - =cut -sub needs_coursereinit { - my ($loncaparev,$interval) = @_; - return() unless ($env{'request.course.id'} && $env{'request.course.tied'}); - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $now = time; - if ($interval eq '') { - $interval = 600; - } - if (($now-$env{'request.course.timechecked'})>$interval) { - my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); - &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); - if ($lastchange > $env{'request.course.tied'}) { - my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); - if ($curr_reqd_hash{'internal.releaserequired'} ne '') { - my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'}; - if ($curr_reqd_hash{'internal.releaserequired'} ne $required) { - &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' => - $curr_reqd_hash{'internal.releaserequired'}}); - my ($switchserver,$switchwarning) = - &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'}, - $curr_reqd_hash{'internal.releaserequired'}); - if ($switchwarning ne '' || $switchserver ne '') { - return ('switch',$switchwarning,$switchserver); - } - } - } - return ('update'); - } - } - return (); -} sub update_content_constraints { my ($cdom,$cnum,$chome,$cid) = @_; @@ -16040,30 +15812,29 @@ sub symb_to_docspath { sub captcha_display { my ($context,$lonhost) = @_; my ($output,$error); - my ($captcha,$pubkey,$privkey,$version) = - &get_captcha_config($context,$lonhost); + 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,$version); + $output = &create_recaptcha($pubkey); unless ($output) { $error = 'recaptcha'; } } - return ($output,$error,$captcha,$version); + return ($output,$error,$captcha); } sub captcha_response { my ($context,$lonhost) = @_; my ($captcha_chk,$captcha_error); - my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost); + 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,$version); + $captcha_chk = &check_recaptcha($privkey); } else { $captcha_chk = 1; } @@ -16072,7 +15843,7 @@ sub captcha_response { sub get_captcha_config { my ($context,$lonhost) = @_; - my ($captcha,$pubkey,$privkey,$version,$hashtocheck); + 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); @@ -16088,10 +15859,6 @@ sub get_captcha_config { } if ($privkey && $pubkey) { $captcha = 'recaptcha'; - $version = $hashtocheck->{'recaptchaversion'}; - if ($version ne '2') { - $version = 1; - } } else { $captcha = 'original'; } @@ -16109,10 +15876,6 @@ sub get_captcha_config { $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'}; if ($privkey && $pubkey) { $captcha = 'recaptcha'; - $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'}; - if ($version ne '2') { - $version = 1; - } } else { $captcha = 'original'; } @@ -16120,7 +15883,7 @@ sub get_captcha_config { $captcha = 'original'; } } - return ($captcha,$pubkey,$privkey,$version); + return ($captcha,$pubkey,$privkey); } sub create_captcha { @@ -16179,61 +15942,38 @@ sub check_captcha { } sub create_recaptcha { - my ($pubkey,$version) = @_; - if ($version >= 2) { - return '
    '; - } else { - 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). - &mt('If the text is hard to read, [_1] will replace them.', - 'reCAPTCHA refresh'). - '

    '; - } + 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). + &mt('If either word is hard to read, [_1] will replace them.', + 'reCAPTCHA refresh'). + '

    '; } sub check_recaptcha { - my ($privkey,$version) = @_; + my ($privkey) = @_; my $captcha_chk; - if ($version >= 2) { - my $ua = LWP::UserAgent->new; - $ua->timeout(10); - my %info = ( - secret => $privkey, - response => $env{'form.g-recaptcha-response'}, - remoteip => $ENV{'REMOTE_ADDR'}, - ); - my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); - if ($response->is_success) { - my $data = JSON::DWIW->from_json($response->decoded_content); - if (ref($data) eq 'HASH') { - if ($data->{'success'}) { - $captcha_chk = 1; - } - } - } - } else { - 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; - } + 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; } sub emailusername_info { - my @fields = ('firstname','lastname','institution','web','location','officialemail','id'); + my @fields = ('firstname','lastname','institution','web','location','officialemail'); my %titles = &Apache::lonlocal::texthash ( lastname => 'Last Name', firstname => 'First Name', @@ -16241,7 +15981,6 @@ sub emailusername_info { location => "School's city, state/province, country", web => "School's web address", officialemail => 'E-mail address at institution (if different)', - id => 'Student/Employee ID', ); return (\@fields,\%titles); } @@ -16273,18 +16012,18 @@ sub cleanup_html { sub critical_redirect { my ($interval) = @_; if ((time-$env{'user.criticalcheck.time'})>$interval) { - my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, + my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, $env{'user.name'}); &Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); my $redirecturl; if ($what[0]) { - if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { - $redirecturl='/adm/email?critical=display'; - my $url=&Apache::lonnet::absolute_url().$redirecturl; + if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { + $redirecturl='/adm/email?critical=display'; + my $url=&Apache::lonnet::absolute_url().$redirecturl; return (1, $url); } } - } + } return (); } @@ -16322,19 +16061,11 @@ sub des_decrypt { } else { $cypher=new DES $keybin; } - my $plaintext=''; - my $cypherlength = length($cyphertext); - my $numchunks = int($cypherlength/32); - for (my $j=0; $j<$numchunks; $j++) { - my $start = $j*32; - my $cypherblock = substr($cyphertext,$start,32); - my $chunk = - $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16)))); - $chunk .= - $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16)))); - $chunk=substr($chunk,1,ord(substr($chunk,0,1)) ); - $plaintext .= $chunk; - } + 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; }