--- loncom/interface/loncommon.pm 2024/03/29 00:45:24 1.1075.2.161.2.24 +++ loncom/interface/loncommon.pm 2020/09/28 00:10:28 1.1347 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.161.2.24 2024/03/29 00:45:24 raeburn Exp $ +# $Id: loncommon.pm,v 1.1347 2020/09/28 00:10:28 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -61,7 +61,7 @@ use POSIX qw(strftime mktime); use Apache::lonmenu(); use Apache::lonenc(); use Apache::lonlocal; -use Apache::lonnavmaps(); +use Apache::lonnet(); use HTML::Entities; use Apache::lonhtmlcommon(); use Apache::loncoursedata(); @@ -71,17 +71,19 @@ use Apache::lonuserutils(); use Apache::lonuserstate(); use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); -use LONCAPA::map(); +use LONCAPA::LWPReq; use HTTP::Request; use DateTime::TimeZone; use DateTime::Locale; use Encode(); +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; use JSON::DWIW; -use LWP::UserAgent; use Crypt::DES; use DynaLoader; # for Crypt::DES version +use MIME::Lite; +use MIME::Types; use File::Copy(); use File::Path(); use String::CRC32(); @@ -170,6 +172,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; @@ -204,14 +207,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); @@ -431,7 +435,7 @@ sub studentbrowser_javascript { block @@ -1081,6 +1108,9 @@ linked_select_forms takes the following =item * $onchangesecond, additional javascript call to execute for an onchange event for the second \n"; + $result .= ""; } -=pod - -=item * &iframe_wrapper_headjs() - -emits javascript containing two global vars to facilitate handling of resizing -by code in iframe_wrapper_resizejs() used when an iframe is present in a page -with standard LON-CAPA menus. - -=cut - -# -# Where iframe is in use, if window.onload() executes before the custom resize function -# has been defined (jQuery), two global javascript vars (LCnotready and LCresizedef) -# are used to ensure document.ready() triggers a call to resize, so the iframe contents -# do not obscure the Functions menu. -# - -sub iframe_wrapper_headjs { - return <<"ENDJS"; - - -ENDJS - +sub crsauthor_url { + my ($url) = @_; + if ($url eq '') { + $url = $ENV{'REQUEST_URI'}; + } + my ($cnum,$cdom); + if ($env{'request.course.id'}) { + my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/}); + if ($audom ne '' && $auname ne '') { + if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) && + ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) { + $cnum = $auname; + $cdom = $audom; + } + } + } + return ($cnum,$cdom); } -=pod - -=item * &iframe_wrapper_resizejs() - -emits javascript used to handle resizing for a page containing -an iframe, to ensure that the iframe does not obscure any -standard LON-CAPA menu items. - -=back - -=cut - -# -# jQuery to use when iframe is in use and a page resize occurs. -# This script will ensure that the iframe does not obscure any -# standard LON-CAPA inline menus (primary, secondary, and/or -# breadcrumbs and Functions menus. Expects javascript from -# &iframe_wrapper_headjs() to be in head portion of the web page, -# e.g., by inclusion in second arg passed to &start_page(). -# - -sub iframe_wrapper_resizejs { - my $offset = 5; - &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']); - if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) { - $offset = 0; - } - return &Apache::lonhtmlcommon::scripttag(< 'Filename', + dire => 'Directory', + ); + my $numdirs = scalar(keys(%files)); + my (%possexts,$singledir,@singledirfiles); + if ($only) { + map { $possexts{$_} = 1; } split(/\s*,\s*/,$only); + } + my (%nonemptydirs,$possdirs); + if ($numdirs > 1) { + my @order; + foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) { + if (ref($files{$key}) eq 'HASH') { + my $shown = $key; + if ($key eq '') { + $shown = '/'; + } + my @ordered = (); + foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) { + next if ($file =~ /\.rights$/); + if ($only) { + my ($ext) = ($file =~ /\.([^.]+)$/); + unless ($possexts{lc($ext)}) { + next; + } + } + $selimport_menus{$key}->{'select2'}->{$file} = $file; + push(@ordered,$file); + } + if (@ordered) { + push(@order,$key); + $nonemptydirs{$key} = 1; + $selimport_menus{$key}->{'text'} = $shown; + $selimport_menus{$key}->{'default'} = ''; + $selimport_menus{$key}->{'select2'}->{''} = ''; + $selimport_menus{$key}->{'order'} = \@ordered; } } - if (header != null && header.length) { - height = header.height(); - hdrtop = header.position().top; + } + $possdirs = scalar(keys(%nonemptydirs)); + if ($possdirs > 1) { + my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs)); + $output = $lt{'dire'}. + &linked_select_forms($form,'
'. + $lt{'fnam'},'', + $firstselectname,$secondselectname, + \%selimport_menus,\@order, + $onchangefirst,'',$suffix).'
'; + } elsif ($possdirs == 1) { + $singledir = (keys(%nonemptydirs))[0]; + if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') { + @singledirfiles = @{$selimport_menus{$singledir}->{'order'}}; + } + delete($selimport_menus{$singledir}); + } + } elsif ($numdirs == 1) { + $singledir = (keys(%files))[0]; + foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) { + if ($only) { + my ($ext) = ($file =~ /\.([^.]+)$/); + unless ($possexts{lc($ext)}) { + next; + } + } else { + next if ($file =~ /\.rights$/); } - var pos = height + hdrtop + offset; - \$('.LC_iframecontainer').css('top', pos); - }); - LCresizedef = 1; - if (LCnotready == 1) { - LCnotready = 0; - \$(window).trigger('resize'); + push(@singledirfiles,$file); } - }); - window.onload = function(){ - if (LCresizedef) { - LCnotready = 0; - \$(window).trigger('resize'); - } else { - LCnotready = 1; - } - }; -SCRIPT - + if (@singledirfiles) { + $possdirs = 1; + } + } + if (($possdirs == 1) && (@singledirfiles)) { + my $showdir = $singledir; + if ($singledir eq '') { + $showdir = '/'; + } + $output = $lt{'dire'}. + '
'. + $lt{'fnam'}.'
'."\n"; + } + return ($possdirs,$output); } =pod @@ -2303,10 +2502,24 @@ sub create_text_file { # ------------------------------------------ sub domain_select { - my ($name,$value,$multiple)=@_; + my ($name,$value,$multiple,$incdoms,$excdoms)=@_; + my @possdoms; + if (ref($incdoms) eq 'ARRAY') { + @possdoms = @{$incdoms}; + } else { + @possdoms = &Apache::lonnet::all_domains(); + } + my %domains=map { $_ => $_.' '. &Apache::lonnet::domain($_,'description') - } &Apache::lonnet::all_domains(); + } @possdoms; + + if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) { + foreach my $dom (@{$excdoms}) { + delete($domains{$dom}); + } + } + if ($multiple) { $domains{''}=&mt('Any domain'); $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))]; @@ -2383,7 +2596,7 @@ option_name => displayed text. An option a javascript onchange item, e.g., onchange="this.form.submit();". An optional arg -- $readonly -- if true will cause the select form to be disabled, e.g., for the case where an instructor has a section- -specific role, and is viewing/modifying parameters. +specific role, and is viewing/modifying parameters. See lonrights.pm for an example invocation and use. @@ -2586,7 +2799,7 @@ The optional $incdoms is a reference to The optional $excdoms is a reference to an array of domains which will be excluded from the available options. -The optional $disabled argument, if true, adds the disabled attribute to the select tag. +The optional $disabled argument, if true, adds the disabled attribute to the select tag. =cut @@ -2607,7 +2820,7 @@ sub select_dom_form { } if ($includeempty) { @domains=('',@domains); } if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; + map { $exclude{$_} = 1; } @{$excdoms}; } my $selectdomain = "'; @@ -11305,7 +10712,7 @@ sub user_rule_check { if (ref($usershash) eq 'HASH') { if (keys(%{$usershash}) > 1) { my (%by_username,%by_id,%userdoms); - my $checkid; + my $checkid; if (ref($checks) eq 'HASH') { if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) { $checkid = 1; @@ -11316,7 +10723,7 @@ sub user_rule_check { if ($checkid) { if (ref($usershash->{$user}) eq 'HASH') { if ($usershash->{$user}->{'id'} ne '') { - $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; + $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; $userdoms{$udom} = 1; if (ref($inst_results) eq 'HASH') { $inst_results->{$uname.':'.$udom} = {}; @@ -11386,7 +10793,7 @@ sub user_rule_check { if (ref($usershash->{$user}) eq 'HASH') { if (ref($checks) eq 'HASH') { if (defined($checks->{'username'})) { - ($inst_response{$user},%{$inst_results->{$user}}) = + ($inst_response{$user},%{$inst_results->{$user}}) = &Apache::lonnet::get_instuser($udom,$uname); } elsif (defined($checks->{'id'})) { if ($usershash->{$user}->{'id'} ne '') { @@ -11409,7 +10816,7 @@ sub user_rule_check { if (ref($domconfig{'usercreation'}) eq 'HASH') { foreach my $item ('username','id') { if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { - $$curr_rules{$udom}{$item} = + $$curr_rules{$udom}{$item} = $domconfig{'usercreation'}{$item.'_rule'}; } } @@ -11432,7 +10839,7 @@ sub user_rule_check { $id = $inst_results->{$user}->{'id'}; } } - if ($id eq '') { + if ($id eq '') { if (ref($usershash->{$user})) { $id = $usershash->{$user}->{'id'}; } @@ -11593,15 +11000,11 @@ sub sorted_inst_types { } sub get_institutional_codes { - my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_; + my ($settings,$allcourses,$LC_code) = @_; # Get complete list of course sections to update my @currsections = (); my @currxlists = (); - my (%unclutteredsec,%unclutteredlcsec); my $coursecode = $$settings{'internal.coursecode'}; - my $crskey = $crs.':'.$coursecode; - @{$unclutteredsec{$crskey}} = (); - @{$unclutteredlcsec{$crskey}} = (); if ($$settings{'internal.sectionnums'} ne '') { @currsections = split(/,/,$$settings{'internal.sectionnums'}); @@ -11612,8 +11015,8 @@ sub get_institutional_codes { } if (@currxlists > 0) { - foreach my $xl (@currxlists) { - if ($xl =~ /^([^:]+):(\w*)$/) { + foreach (@currxlists) { + if (m/^([^:]+):(\w*)$/) { unless (grep/^$1$/,@{$allcourses}) { push(@{$allcourses},$1); $$LC_code{$1} = $2; @@ -11621,28 +11024,15 @@ sub get_institutional_codes { } } } - + if (@currsections > 0) { - foreach my $sec (@currsections) { - if ($sec =~ m/^(\w+):(\w*)$/ ) { - my $instsec = $1; + foreach (@currsections) { + if (m/^(\w+):(\w*)$/) { + my $sec = $coursecode.$1; my $lc_sec = $2; - unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) { - push(@{$unclutteredsec{$crskey}},$instsec); - push(@{$unclutteredlcsec{$crskey}},$lc_sec); - } - } - } - } - - if (@{$unclutteredsec{$crskey}} > 0) { - my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec); - if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) { - for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) { - my $sec = $coursecode.$formattedsec{$crskey}[$i]; - unless (grep/^\Q$sec\E$/,@{$allcourses}) { + unless (grep/^$sec$/,@{$allcourses}) { push(@{$allcourses},$sec); - $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i]; + $$LC_code{$sec} = $lc_sec; } } } @@ -11751,7 +11141,7 @@ 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. + (b) startreserve: start date of reservation period. (c) uniqueperiod: start,end dates when slot is to be uniquely selected. @@ -11761,13 +11151,35 @@ future_reservable - ref to hash of stude sub get_future_slots { my ($cnum,$cdom,$now,$symb) = @_; + my $map; + if ($symb) { + ($map) = &Apache::lonnet::decode_symb($symb); + } my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future); my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom); foreach my $slot (keys(%slots)) { next unless($slots{$slot}->{'type'} eq 'schedulable_student'); if ($symb) { - next if (($slots{$slot}->{'symb'} ne '') && - ($slots{$slot}->{'symb'} ne $symb)); + if ($slots{$slot}->{'symb'} ne '') { + my $canuse; + my %oksymbs; + my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'}); + map { $oksymbs{$_} = 1; } @slotsymbs; + if ($oksymbs{$symb}) { + $canuse = 1; + } else { + foreach my $item (@slotsymbs) { + if ($item =~ /\.(page|sequence)$/) { + (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item); + if (($map ne '') && ($map eq $sloturl)) { + $canuse = 1; + last; + } + } + } + } + next unless ($canuse); + } } if (($slots{$slot}->{'starttime'} > $now) && ($slots{$slot}->{'endtime'} > $now)) { @@ -11820,7 +11232,7 @@ sub get_future_slots { $reservable_now{$slot} = { symb => $symb, endreserve => $lastres, - uniqueperiod => $uniqueperiod, + uniqueperiod => $uniqueperiod, }; } elsif (($startreserve > $now) && (!$endreserve || $endreserve > $startreserve)) { @@ -11985,7 +11397,23 @@ sub get_env_multiple { return(@values); } +# Looks at given dependencies, and returns something depending on the context. +# For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing). +# For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping). +# For all other contexts, returns ($output, $counter, $numpathchg). +# $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use. +# $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned. +# $numpathchg: integer with the number of cleaned up dependency paths. +# \%existing: hash reference clean path -> 1 only for existing dependencies. +# \%mapping: hash reference clean path -> original path for all dependencies. +# @param {string} actionurl - The path to the handler, indicative of the context. +# @param {string} state - Can contain HTML with hidden inputs that will be added to the output form. +# @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items +# @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ? +# @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string) +# @return {Array} - array depending on the context (not a reference) sub ask_for_embedded_content { + # NOTE: documentation was added afterwards, it could be wrong my ($actionurl,$state,$allfiles,$codebase,$args)=@_; my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges, %currsubfile,%unused,$rem); @@ -12001,6 +11429,9 @@ sub ask_for_embedded_content { my $heading = &mt('Upload embedded files'); my $buttontext = &mt('Upload'); + # fills these variables based on the context: + # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath, + # $path, $fileloc, $title, $rem, $filename if ($env{'request.course.id'}) { if ($actionurl eq '/adm/dependencies') { $navmap = Apache::lonnavmaps::navmap->new(); @@ -12008,7 +11439,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'}) { @@ -12040,18 +11471,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"; } @@ -12085,6 +11516,16 @@ sub ask_for_embedded_content { $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/'; $fileloc =~ s{^/}{}; } + + # parses the dependency paths to get some info + # fills $newfiles, $mapping, $subdependencies, $dependencies + # $newfiles: hash URL -> 1 for new files or external URLs + # (will be completed later) + # $mapping: + # for external URLs: external URL -> external URL + # for relative paths: clean path -> original path + # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories + # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories foreach my $file (keys(%{$allfiles})) { my $embed_file; if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) { @@ -12127,11 +11568,24 @@ sub ask_for_embedded_content { } } } + + # looks for all existing files in dependency subdirectories (from $subdependencies filled above) + # and lists + # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused + # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path + # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and + # the path had to be cleaned up + # $existing: hash clean path -> 1 if the file exists + # $numexisting: number of keys in $existing + # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist + # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in + # dependency subdirectories that are + # not listed as dependencies, with some exceptions using $rem 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') { @@ -12202,6 +11656,9 @@ sub ask_for_embedded_content { } } } + + # fills $currfile, hash file name -> 1 or [$size,$mtime] + # for files in $url or $fileloc (target directory) in some contexts my %currfile; if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { @@ -12240,6 +11697,8 @@ sub ask_for_embedded_content { } } } + # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that + # are not in subdirectories, using $currfile foreach my $file (keys(%dependencies)) { if (exists($currfile{$file})) { unless ($mapping{$file} eq $file) { @@ -12268,17 +11727,25 @@ sub ask_for_embedded_content { $unused{$file} = 1; } } + + # returns some results for coursedocs paste and syllabus rewrites ($output is undef) if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') && ($args->{'context'} eq 'paste')) { $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)); return ($output,$counter,$numpathchg,\%existing,\%mapping); } + + # returns HTML otherwise, with dependency results and to ask for more uploads + + # $upload_output: missing dependencies (with upload form) + # $modify_output: uploaded dependencies (in use) + # $delete_output: files no longer in use (unused files are not listed for londocs, bug?) foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) { if ($actionurl eq '/adm/dependencies') { next if ($embed_file =~ m{^\w+://}); @@ -12502,7 +11969,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. @@ -12521,7 +11988,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; @@ -12860,7 +12327,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 { @@ -12995,7 +12462,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{/([^/]+)$}); @@ -13521,7 +12988,7 @@ sub process_decompression { } my $numskip = scalar(@to_skip); my $numoverwrite = scalar(@to_overwrite); - if (($numskip) && (!$numoverwrite)) { + if (($numskip) && (!$numoverwrite)) { $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); } elsif ($dir eq '') { $error = &mt('Directory containing archive file unavailable.'); @@ -13531,11 +12998,11 @@ sub process_decompression { my $tempdir = time.'_'.$$.int(rand(10000)); mkdir("$dir/$tempdir",0755); if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) { - ($decompressed,$display) = + ($decompressed,$display) = &decompress_uploaded_file($file,"$dir/$tempdir"); foreach my $item (@to_skip) { if (($item ne '') && ($item !~ /\.\./)) { - if (-f "$dir/$tempdir/$item") { + if (-f "$dir/$tempdir/$item") { unlink("$dir/$tempdir/$item"); } elsif (-d "$dir/$tempdir/$item") { &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 }); @@ -13575,7 +13042,7 @@ sub process_decompression { if (ref($newdirlistref) eq 'ARRAY') { foreach my $dir_line (@{$newdirlistref}) { my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); - unless (($item =~ /^\.+$/) || ($item eq $file)) { + unless (($item =~ /^\.+$/) || ($item eq $file)) { push(@newitems,$item); if ($dirptr&$testdir) { $is_dir{$item} = 1; @@ -13630,7 +13097,7 @@ sub process_decompression { $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))) { + (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'}; $displayed{'web'} = $i; @@ -14082,7 +13549,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -14163,7 +13630,7 @@ sub process_extracted_files { $newseqid{$i} = $newidx; unless ($errtext) { $result .= '
  • '.&mt('Folder: [_1] added to course', - &HTML::Entities::encode($docstitle,'<>&"')).. + &HTML::Entities::encode($docstitle,'<>&"')). '
    • '."\n"; } } @@ -14173,9 +13640,7 @@ sub process_extracted_files { my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. $title; - if (($outer !~ /\D/) && - (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) && - ($newidx !~ /\D/)) { + if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) { if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); } @@ -14190,7 +13655,7 @@ sub process_extracted_files { $fetch =~ s/^\Q$prefix$dir\E//; $prompttofetch{$fetch} = 1; } - } + } } $LONCAPA::map::resources[$newidx]= $docstitle.':'.$url.':false:normal:res'; @@ -14215,7 +13680,7 @@ sub process_extracted_files { } } else { $warning .= &mt('Item extracted from archive: [_1] has unexpected path.', - &HTML::Entities::encode($path,'<>&"')).'
    '; + &HTML::Entities::encode($path,'<>&"')).'
    '; } } for (my $i=1; $i<=$numitems; $i++) { @@ -14237,7 +13702,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}}"; @@ -14286,13 +13751,13 @@ sub process_extracted_files { $showpath = "$relpath/$title"; } else { $showpath = "/$title"; - } + } $result .= '
  • '.&mt('[_1] included as a dependency', &HTML::Entities::encode($showpath,'<>&"')). '
    • '."\n"; unless ($ishome) { my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; + $fetch =~ s/^\Q$prefix$dir\E//; $prompttofetch{$fetch} = 1; } } @@ -15508,13 +14973,13 @@ 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, +origmail (scalar - email address of recipient from loncapa.conf, i.e., predates configuration by DC via domainprefs.pm $requname username of requester (if mailing type is helpdeskmail) @@ -15523,6 +14988,7 @@ $requdom domain of requester (if mailing $reqemail e-mail address of requester (if mailing type is helpdeskmail) + Returns: comma separated list of addresses to which to send e-mail. =back @@ -15766,6 +15232,91 @@ sub build_recipient_list { =pod +=over 4 + +=item * &mime_email() + +Sends an email with a possible attachment + +Inputs: + +=over 4 + +from - Sender's email address + +replyto - Reply-To email address + +to - Email address of recipient + +subject - Subject of email + +body - Body of email + +cc_string - Carbon copy email address + +bcc - Blind carbon copy email address + +attachment_path - Path of file to be attached + +file_name - Name of file to be attached + +attachment_text - The body of an attachment of type "TEXT" + +=back + +=back + +=cut + +############################################################ +############################################################ + +sub mime_email { + my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, + $file_name,$attachment_text) = @_; + + my $msg = MIME::Lite->new( + From => $from, + To => $to, + Subject => $subject, + Type =>'TEXT', + Data => $body, + ); + if ($replyto ne '') { + $msg->add("Reply-To" => $replyto); + } + if ($cc_string ne '') { + $msg->add("Cc" => $cc_string); + } + if ($bcc ne '') { + $msg->add("Bcc" => $bcc); + } + $msg->attr("content-type" => "text/plain"); + $msg->attr("content-type.charset" => "UTF-8"); + # Attach file if given + if ($attachment_path) { + unless ($file_name) { + if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; } + } + my ($type, $encoding) = MIME::Types::by_suffix($attachment_path); + $msg->attach(Type => $type, + Path => $attachment_path, + Filename => $file_name + ); + # Otherwise attach text if given + } elsif ($attachment_text) { + $msg->attach(Type => 'TEXT', + Data => $attachment_text); + } + # Send it + $msg->send('sendmail'); +} + +############################################################ +############################################################ + +=pod + =head1 Course Catalog Routines =over 4 @@ -15870,6 +15421,8 @@ sub extract_categories { $trailstr = &mt('Official courses (with institutional codes)'); } elsif ($name eq 'communities') { $trailstr = &mt('Communities'); + } elsif ($name eq 'placement') { + $trailstr = &mt('Placement Tests'); } else { $trailstr = $name; } @@ -16019,8 +15572,10 @@ sub assign_categories_table { next if ($parent eq 'instcode'); if ($type eq 'Community') { next unless ($parent eq 'communities'); + } elsif ($type eq 'Placement') { + next unless ($parent eq 'placement'); } else { - next if ($parent eq 'communities'); + next if (($parent eq 'communities') || ($parent eq 'placement')); } my $css_class = $itemcount%2?' class="LC_odd_row"':''; my $item = &escape($parent).'::0'; @@ -16033,6 +15588,8 @@ sub assign_categories_table { my $parent_title = $parent; if ($parent eq 'communities') { $parent_title = &mt('Communities'); + } elsif ($parent eq 'placement') { + $parent_title = &mt('Placement Tests'); } $table .= ''. '{'ccdomain'} eq $args->{'clonedomain'}) { $can_clone = 1; } - } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && + } 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'})) { @@ -16402,7 +15959,7 @@ sub check_clone { $can_clone = 1; } unless ($can_clone) { - if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && + if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && ($args->{'clonedomain'} eq $args->{'course_domain'})) { my (%gotdomdefaults,%gotcodedefaults); foreach my $cloner (@cloners) { @@ -16441,12 +15998,12 @@ sub check_clone { if ($args->{'crstype'} eq 'Community') { $ccrole = 'co'; } - my %roleshash = - &Apache::lonnet::get_my_roles($args->{'ccuname'}, - $args->{'ccdomain'}, + my %roleshash = + &Apache::lonnet::get_my_roles($args->{'ccuname'}, + $args->{'ccdomain'}, 'userroles',['active'],[$ccrole], - [$args->{'clonedomain'}]); - if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) { + [$args->{'clonedomain'}]); + if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) { $can_clone = 1; } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'}, $args->{'ccuname'},$args->{'ccdomain'})) { @@ -16472,7 +16029,7 @@ sub check_clone { 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 => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], })); - } + } } } } @@ -16502,7 +16059,12 @@ sub construct_course { # # Open course # - my $crstype = lc($args->{'crstype'}); + my $showncrstype; + if ($args->{'crstype'} eq 'Placement') { + $showncrstype = 'placement test'; + } else { + $showncrstype = lc($args->{'crstype'}); + } my %cenv=(); $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'}, $args->{'cdescr'}, @@ -16521,9 +16083,9 @@ sub construct_course { # if anyone ever decides to not show this, and Utils::Course::new # will need to be suitably modified. if (($callercontext eq 'auto') && ($user_lh ne '')) { - $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; + $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; } else { - $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; + $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; } if ($$courseid =~ /^error:/) { return (0,$outcome,$clonemsgref); @@ -16548,19 +16110,19 @@ sub construct_course { # # Do the cloning -# +# my @clonemsg; if ($can_clone && $cloneid) { push(@clonemsg, { mt => 'Created [_1] by cloning from [_2]', - args => [$crstype,$clonetitle], + args => [$showncrstype,$clonetitle], }); my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); # Copy all files my @info = - &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'}, - $args->{'dateshift'},$args->{'crscode'}, + &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'}, + $args->{'dateshift'},$args->{'crscode'}, $args->{'ccuname'}.':'.$args->{'ccdomain'}, $args->{'tinyurls'}); if (@info) { @@ -16590,7 +16152,8 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories'], + 'categories', + 'internal.uniquecode'], $$crsudom,$$crsunum); if ($args->{'textbook'}) { $cenv{'internal.textbook'} = $args->{'textbook'}; @@ -16605,9 +16168,6 @@ sub construct_course { if ($args->{'crstype'}) { $cenv{'type'}=$args->{'crstype'}; } - if ($args->{'lti'}) { - $cenv{'internal.lti'}=$args->{'lti'}; - } if ($args->{'crsid'}) { $cenv{'courseid'}=$args->{'crsid'}; } @@ -16629,7 +16189,6 @@ sub construct_course { $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'}; } my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner. - my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections. if ($args->{'crssections'}) { $cenv{'internal.sectionnums'} = ''; if ($args->{'crssections'} =~ m/,/) { @@ -16643,11 +16202,7 @@ sub construct_course { my $class = $args->{'crscode'}.$sec; my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'}); $cenv{'internal.sectionnums'} .= $item.','; - if ($addcheck eq 'ok') { - unless (grep(/^\Q$gp\E$/,@oklcsecs)) { - push(@oklcsecs,$gp); - } - } else { + unless ($addcheck eq 'ok') { push(@badclasses,$class); } } @@ -16675,11 +16230,7 @@ sub construct_course { my ($xl,$gp) = split/:/,$item; my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'}); $cenv{'internal.crosslistings'} .= $item.','; - if ($addcheck eq 'ok') { - unless (grep(/^\Q$gp\E$/,@oklcsecs)) { - push(@oklcsecs,$gp); - } - } else { + unless ($addcheck eq 'ok') { push(@badclasses,$xl); } } @@ -16737,41 +16288,11 @@ sub construct_course { $outcome .= $linefeed; } else { $outcome .= "

    \n"; - } + } } if ($args->{'no_end_date'}) { $args->{'endaccess'} = 0; } -# If an official course with institutional sections is created by cloning -# an existing course, section-specific hiding of course totals in student's -# view of grades as copied from cloned course, will be checked for valid -# sections. - if (($can_clone && $cloneid) && - ($cenv{'internal.coursecode'} ne '') && - ($cenv{'grading'} eq 'standard') && - ($cenv{'hidetotals'} ne '') && - ($cenv{'hidetotals'} ne 'all')) { - my @hidesecs; - my $deletehidetotals; - if (@oklcsecs) { - foreach my $sec (split(/,/,$cenv{'hidetotals'})) { - if (grep(/^\Q$sec$/,@oklcsecs)) { - push(@hidesecs,$sec); - } - } - if (@hidesecs) { - $cenv{'hidetotals'} = join(',',@hidesecs); - } else { - $deletehidetotals = 1; - } - } else { - $deletehidetotals = 1; - } - if ($deletehidetotals) { - delete($cenv{'hidetotals'}); - &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum); - } - } $cenv{'internal.autostart'}=$args->{'enrollstart'}; $cenv{'internal.autoend'}=$args->{'enrollend'}; $cenv{'default_enrollment_start_date'}=$args->{'startaccess'}; @@ -16836,7 +16357,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; } @@ -16890,6 +16411,7 @@ sub construct_course { # unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank') || ($cloneid)) { + use LONCAPA::map; $outcome .= &mt('Setting first resource').': '; my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence'; @@ -16912,6 +16434,30 @@ sub construct_course { $outcome .= ($fatal?$errtext:'write ok').$linefeed; } +# +# Set params for Placement Tests +# + if ($args->{'crstype'} eq 'Placement') { + my %storecontent; + my $prefix=$$crsudom.'_'.$$crsunum.'.0.'; + my %defaults = ( + buttonshide => { value => 'yes', + type => 'string_yesno',}, + type => { value => 'randomizetry', + type => 'string_questiontype',}, + maxtries => { value => 1, + type => 'int_pos',}, + problemstatus => { value => 'no', + type => 'string_problemstatus',}, + ); + foreach my $key (keys(%defaults)) { + $storecontent{$prefix.$key} = $defaults{$key}{'value'}; + $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'}; + } + &Apache::lonnet::cput + ('resourcedata',\%storecontent,$$crsudom,$$crsunum); + } + return (1,$outcome,\@clonemsg); } @@ -16925,7 +16471,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; @@ -16972,8 +16518,7 @@ sub generate_code { ############################################################ ############################################################ -#SD -# only Community and Course, or anything else? +# Community, Course and Placement Test sub course_type { my ($cid) = @_; if (!defined($cid)) { @@ -16991,17 +16536,19 @@ sub group_term { my %names = ( 'Course' => 'group', 'Community' => 'group', + 'Placement' => 'group', ); return $names{$crstype}; } sub course_types { - my @types = ('official','unofficial','community','textbook','lti'); + my @types = ('official','unofficial','community','textbook','placement','lti'); my %typename = ( official => 'Official course', unofficial => 'Unofficial course', community => 'Community', textbook => 'Textbook course', + placement => 'Placement test', lti => 'LTI provider', ); return (\@types,\%typename); @@ -17107,10 +16654,7 @@ sub init_user_environment { my $public=($username eq 'public' && $domain eq 'public'); -# See if old ID present, if so, remove - - my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv, - $coauthorenv); + my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv); my $now=time; if ($public) { @@ -17131,7 +16675,8 @@ sub init_user_environment { } if (!$cookie) { $cookie="publicuser_$oldest"; } } else { - # if this isn't a robot, kill any existing non-robot sessions + # See if old ID present, if so, remove if this isn't a robot, + # killing any existing non-robot sessions if (!$args->{'robot'}) { opendir(DIR,$lonids); while ($filename=readdir(DIR)) { @@ -17175,7 +16720,7 @@ sub init_user_environment { # Initialize roles - ($userroles,$firstaccenv,$timerintenv,$coauthorenv) = + ($userroles,$firstaccenv,$timerintenv) = &Apache::lonnet::rolesinit($domain,$username,$authhost); } # ------------------------------------ Check browser type and MathML capability @@ -17187,8 +16732,7 @@ sub init_user_environment { my %userenv = &Apache::lonnet::dump('environment',$domain,$username); my ($tmp) = keys(%userenv); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - } else { + if ($tmp =~ /^(con_lost|error|no_such_host)/i) { undef(%userenv); } if (($userenv{'interface'}) && (!$form->{'interface'})) { @@ -17203,7 +16747,6 @@ sub init_user_environment { # --------------------------------------------------------- Write first profile { - my $ip = &Apache::lonnet::get_requestor_ip(); my %initial_env = ("user.name" => $username, "user.domain" => $domain, @@ -17222,7 +16765,7 @@ sub init_user_environment { "request.course.sec" => '', "request.role" => 'cm', "request.role.adv" => $env{'user.adv'}, - "request.host" => $ip,); + "request.host" => $ENV{'REMOTE_ADDR'},); if ($form->{'localpath'}) { $initial_env{"browser.localpath"} = $form->{'localpath'}; @@ -17254,30 +16797,19 @@ sub init_user_environment { my %is_adv = ( is_adv => $env{'user.adv'} ); my %domdef = &Apache::lonnet::get_domain_defaults($domain); - foreach my $tool ('aboutme','blog','webdav','portfolio','timezone') { + foreach my $tool ('aboutme','blog','webdav','portfolio') { $userenv{'availabletools.'.$tool} = &Apache::lonnet::usertools_access($username,$domain,$tool,'reload', undef,\%userenv,\%domdef,\%is_adv); } - foreach my $crstype ('official','unofficial','community','textbook','lti') { + foreach my $crstype ('official','unofficial','community','textbook','placement','lti') { $userenv{'canrequest.'.$crstype} = &Apache::lonnet::usertools_access($username,$domain,$crstype, 'reload','requestcourses', \%userenv,\%domdef,\%is_adv); } - if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) && - (exists($userroles->{"user.role.au./$domain/"}))) { - if ($userenv{'authoreditors'}) { - $userenv{'editors'} = $userenv{'authoreditors'}; - } elsif ($domdef{'editors'} ne '') { - $userenv{'editors'} = $domdef{'editors'}; - } else { - $userenv{'editors'} = 'edit,xml'; - } - } - $userenv{'canrequest.author'} = &Apache::lonnet::usertools_access($username,$domain,'requestauthor', 'reload','requestauthor', @@ -17285,14 +16817,42 @@ 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'}; } } + my ($types,$typename) = &course_types(); + if (ref($types) eq 'ARRAY') { + my @options = ('approval','validate','autolimit'); + my $optregex = join('|',@options); + my (%willtrust,%trustchecked); + foreach my $type (@{$types}) { + my $dom_str = $env{'environment.reqcrsotherdom.'.$type}; + if ($dom_str ne '') { + my $updatedstr = ''; + my @possdomains = split(',',$dom_str); + foreach my $entry (@possdomains) { + my ($extdom,$extopt) = split(':',$entry); + unless ($trustchecked{$extdom}) { + $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom); + $trustchecked{$extdom} = 1; + } + if ($willtrust{$extdom}) { + $updatedstr .= $entry.','; + } + } + $updatedstr =~ s/,$//; + if ($updatedstr) { + $userenv{'reqcrsotherdom.'.$type} = $updatedstr; + } else { + delete($userenv{'reqcrsotherdom.'.$type}); + } + } + } + } } - $env{'user.environment'} = "$lonids/$cookie.id"; if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id", @@ -17306,11 +16866,6 @@ sub init_user_environment { if (ref($timerintenv) eq 'HASH') { &_add_to_env(\%disk_env,$timerintenv); } - if (ref($coauthorenv) eq 'HASH') { - if (keys(%{$coauthorenv})) { - &_add_to_env(\%disk_env,$coauthorenv); - } - } if (ref($args->{'extra_env'})) { &_add_to_env(\%disk_env,$args->{'extra_env'}); } @@ -17401,12 +16956,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 @@ -17422,19 +16977,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 @@ -17525,15 +17080,19 @@ sub build_filters { $createdfilterform = &timebased_select_form('createdfilter',$filter); } + my $prefix = $crstype; + if ($crstype eq 'Placement') { + $prefix = 'Placement Test' + } my %lt = &Apache::lonlocal::texthash( - 'cac' => "$crstype Activity", - 'ccr' => "$crstype Created", - 'cde' => "$crstype Title", - 'cdo' => "$crstype Domain", + 'cac' => "$prefix Activity", + 'ccr' => "$prefix Created", + 'cde' => "$prefix Title", + 'cdo' => "$prefix Domain", 'ins' => 'Institutional Code', 'inc' => 'Institutional Categorization', - 'cow' => "$crstype Owner/Co-owner", - 'cop' => "$crstype Personnel Includes", + 'cow' => "$prefix Owner/Co-owner", + 'cop' => "$prefix Personnel Includes", 'cog' => 'Type', ); @@ -17541,6 +17100,8 @@ sub build_filters { my $typeval = 'Course'; if ($crstype eq 'Community') { $typeval = 'Community'; + } elsif ($crstype eq 'Placement') { + $typeval = 'Placement'; } $typeselectform = ''; } else { @@ -17549,9 +17110,15 @@ sub build_filters { $typeselectform .= ' onchange="'.$onchange.'"'; } $typeselectform .= '>'."\n"; - foreach my $posstype ('Course','Community') { + foreach my $posstype ('Course','Community','Placement') { + my $shown; + if ($posstype eq 'Placement') { + $shown = &mt('Placement Test'); + } else { + $shown = &mt($posstype); + } $typeselectform.='\n"; + ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."\n"; } $typeselectform.=""; } @@ -17576,7 +17143,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', @@ -17705,7 +17272,7 @@ $typeelement return $jscript.$clonewarning.$output; } -=pod +=pod =item * &timebased_select_form() @@ -17720,7 +17287,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 @@ -17757,7 +17324,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 @@ -17796,7 +17363,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). @@ -17808,7 +17375,7 @@ 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). @@ -17818,8 +17385,8 @@ cc_clone - escaped comma separated list 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 +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. @@ -17945,8 +17512,8 @@ $required - LON-CAPA version needed by c Returns: -$switchserver - query string tp append to /adm/switchserver call (if - current server's LON-CAPA version is too old. +$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. @@ -18059,7 +17626,7 @@ 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). + change in current course. (default: 600 s). Returns: an array; first element is: @@ -18067,9 +17634,9 @@ Returns: an array; first element is: '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 + on current server hosting user's session '' - if no action required. @@ -18077,10 +17644,10 @@ Returns: an array; first element is: If first item element is 'switch': -second item is $switchwarning - Warning message if no suitable server found to host session. +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. + and current role. otherwise: no other elements returned. @@ -18099,73 +17666,61 @@ sub needs_coursereinit { } if (($now-$env{'request.course.timechecked'})>$interval) { &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); - my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1); + my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1); if ($blocked) { return (); } - my $update; - my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum); - my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum); - if ($lastmainchange > $env{'request.course.tied'}) { - my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum); - if ($needswitch) { - return ('switch',$switchwarning,$switchserver); - } - $update = 'main'; - } - if ($lastsuppchange > $env{'request.course.suppupdated'}) { - if ($update) { - $update = 'both'; - } else { - my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum); - if ($needswitch) { - return ('switch',$switchwarning,$switchserver); - } else { - $update = 'supp'; + my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); + 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 switch_for_update { - my ($loncaparev,$cdom,$cnum) = @_; - 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) = @_; + my ($cdom,$cnum,$chome,$cid,$keeporder) = @_; my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'}); - my %checkresponsetypes; + my (%checkresponsetypes,%checkcrsrestypes); foreach my $key (keys(%Apache::lonnet::needsrelease)) { my ($item,$name,$value) = split(/:/,$key); if ($item eq 'resourcetag') { if ($name eq 'responsetype') { $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key} } + } elsif ($item eq 'course') { + if ($name eq 'courserestype') { + $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key}; + } } } my $navmap = Apache::lonnavmaps::navmap->new(); if (defined($navmap)) { - my %allresponses; - foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) { + my (%allresponses,%allcrsrestypes); + foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) { + if ($res->is_tool()) { + if ($allcrsrestypes{'exttool'}) { + $allcrsrestypes{'exttool'} ++; + } else { + $allcrsrestypes{'exttool'} = 1; + } + next; + } my %responses = $res->responseTypes(); foreach my $key (keys(%responses)) { next unless(exists($checkresponsetypes{$key})); @@ -18178,8 +17733,38 @@ sub update_content_constraints { ($reqdmajor,$reqdminor) = ($major,$minor); } } + foreach my $key (keys(%allcrsrestypes)) { + my ($major,$minor) = split(/\./,$checkcrsrestypes{$key}); + if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { + ($reqdmajor,$reqdminor) = ($major,$minor); + } + } undef($navmap); } + my (@resources,@order,@resparms,@zombies); + if ($keeporder) { + use LONCAPA::map; + @resources = @LONCAPA::map::resources; + @order = @LONCAPA::map::order; + @resparms = @LONCAPA::map::resparms; + @zombies = @LONCAPA::map::zombies; + } + my $suppmap = 'supplemental.sequence'; + my ($suppcount,$supptools,$errors) = (0,0,0); + ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap, + $suppcount,$supptools,$errors); + if ($keeporder) { + @LONCAPA::map::resources = @resources; + @LONCAPA::map::order = @order; + @LONCAPA::map::resparms = @resparms; + @LONCAPA::map::zombies = @zombies; + } + if ($supptools) { + my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'}); + if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { + ($reqdmajor,$reqdminor) = ($major,$minor); + } + } unless (($reqdmajor eq '') && ($reqdminor eq '')) { &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid); } @@ -18200,7 +17785,7 @@ sub allmaps_incourse { if ($lastchange > $env{'request.course.tied'}) { my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); unless ($ferr) { - &update_content_constraints($cdom,$cnum,$chome,$cid); + &update_content_constraints($cdom,$cnum,$chome,$cid,1); } } my $navmap = Apache::lonnavmaps::navmap->new(); @@ -18226,10 +17811,8 @@ sub parse_supplemental_title { my $name = &plainname($uname,$udom); $name = &HTML::Entities::encode($name,'"<>&\''); $renametitle = &HTML::Entities::encode($renametitle,'"<>&\''); - $title=''.&Apache::lonlocal::locallocaltime($time).' '.$name; - if ($foldertitle ne '') { - $title .= ':
    '.$foldertitle; - } + $title=''.&Apache::lonlocal::locallocaltime($time).' '. + $name.':
    '.$foldertitle; } if (wantarray) { return ($title,$foldertitle,$renametitle); @@ -18237,147 +17820,32 @@ sub parse_supplemental_title { return $title; } -sub get_supplemental { - my ($cnum,$cdom,$ignorecache,$possdel)=@_; - my $hashid=$cnum.':'.$cdom; - my ($supplemental,$cached,$set_httprefs); - unless ($ignorecache) { - ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid); - } - unless (defined($cached)) { - my $chome=&Apache::lonnet::homeserver($cnum,$cdom); - unless ($chome eq 'no_host') { - my @order = @LONCAPA::map::order; - my @resources = @LONCAPA::map::resources; - my @resparms = @LONCAPA::map::resparms; - my @zombies = @LONCAPA::map::zombies; - my ($errors,%ids,%hidden); - $errors = - &recurse_supplemental($cnum,$cdom,'supplemental.sequence', - $errors,$possdel,\%ids,\%hidden); - @LONCAPA::map::order = @order; - @LONCAPA::map::resources = @resources; - @LONCAPA::map::resparms = @resparms; - @LONCAPA::map::zombies = @zombies; - $set_httprefs = 1; - if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { - &Apache::lonnet::appenv({'request.course.suppupdated' => time}); - } - $supplemental = { - ids => \%ids, - hidden => \%hidden, - }; - &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600); - } - } - return ($supplemental,$set_httprefs); -} - sub recurse_supplemental { - my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_; - if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) { - my $mapnum; - if ($suppmap eq 'supplemental.sequence') { - $mapnum = 0; - } else { - ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/); - } + my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_; + if ($suppmap) { my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); if ($fatal) { $errors ++; } else { - my @order = @LONCAPA::map::order; - if (@order > 0) { - my @resources = @LONCAPA::map::resources; - my @resparms = @LONCAPA::map::resparms; - foreach my $idx (@order) { - my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]); + 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')) { - my $id = $mapnum.':'.$idx; - push(@{$suppids->{$src}},$id); - if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) { - $hiddensupp->{$id} = 1; - } if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { - $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids, - $hiddensupp,$hiddensupp->{$id}); + ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1, + $numfiles,$numexttools,$errors); } else { - my $allowed; - if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) { - $allowed = 1; - } elsif ($possdel) { - foreach my $item (@{$suppids->{$src}}) { - next if ($item eq $id); - unless ($hiddensupp->{$item}) { - $allowed = 1; - last; - } - } - if ((!$allowed) && (exists($env{'httpref.'.$src}))) { - &Apache::lonnet::delenv('httpref.'.$src); - } - } - if ($allowed && (!exists($env{'httpref.'.$src}))) { - &Apache::lonnet::allowuploaded('/adm/coursedoc',$src); + if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { + $numexttools ++; } + $numfiles ++; } } } } } } - return $errors; -} - -sub set_supp_httprefs { - my ($cnum,$cdom,$supplemental,$possdel) = @_; - if (ref($supplemental) eq 'HASH') { - if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) { - foreach my $src (keys(%{$supplemental->{'ids'}})) { - next if ($src =~ /\.sequence$/); - if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') { - my $allowed; - if ($env{'request.role.adv'}) { - $allowed = 1; - } else { - foreach my $id (@{$supplemental->{'ids'}->{$src}}) { - unless ($supplemental->{'hidden'}->{$id}) { - $allowed = 1; - last; - } - } - } - if (exists($env{'httpref.'.$src})) { - if ($possdel) { - unless ($allowed) { - &Apache::lonnet::delenv('httpref.'.$src); - } - } - } elsif ($allowed) { - &Apache::lonnet::allowuploaded('/adm/coursedoc',$src); - } - } - } - if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { - &Apache::lonnet::appenv({'request.course.suppupdated' => time}); - } - } - } -} - -sub get_supp_parameter { - my ($resparm,$name)=@_; - return if ($resparm eq ''); - my $value=undef; - my $ptype=undef; - foreach (split('&&&',$resparm)) { - my ($thistype,$thisname,$thisvalue)=split('___',$_); - if ($thisname eq $name) { - $value=$thisvalue; - $ptype=$thistype; - } - } - return $value; + return ($numfiles,$numexttools,$errors); } sub symb_to_docspath { @@ -18450,71 +17918,10 @@ sub symb_to_docspath { return $path; } -sub validate_folderpath { - my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_; - if ($env{'form.folderpath'} ne '') { - my @items = split(/\&/,$env{'form.folderpath'}); - my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids); - for (my $i=0; $i<@items; $i++) { - my $odd = $i%2; - if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) { - $badpath = 1; - } elsif ($odd && $supplementalflag) { - my $idx = $i-1; - if ($items[$i] =~ /^([^:]*)::(|1):::$/) { - my $esc_name = $1; - if ((!$allowed) || ($items[$idx] eq 'supplemental')) { - $supppath .= '&'.$esc_name; - $changed = 1; - } else { - $supppath .= '&'.$items[$i]; - } - } elsif (($allowed) && ($items[$idx] ne 'supplemental')) { - $changed = 1; - my $is_hidden; - unless ($got_supp) { - my ($supplemental) = &get_supplemental($coursenum,$coursedom); - if (ref($supplemental) eq 'HASH') { - if (ref($supplemental->{'hidden'}) eq 'HASH') { - %supphidden = %{$supplemental->{'hidden'}}; - } - if (ref($supplemental->{'ids'}) eq 'HASH') { - %suppids = %{$supplemental->{'ids'}}; - } - } - $got_supp = 1; - } - if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') { - my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0]; - if ($supphidden{$mapid}) { - $is_hidden = 1; - } - } - $supppath .= '&'.$items[$i].'::'.$is_hidden.':::'; - } else { - $supppath .= '&'.$items[$i]; - } - } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) { - $badpath = 1; - } elsif ($supplementalflag) { - $supppath .= '&'.$items[$i]; - } - last if ($badpath); - } - if ($badpath) { - delete($env{'form.folderpath'}); - } elsif ($changed && $supplementalflag) { - $supppath =~ s/^\&//; - $env{'form.folderpath'} = $supppath; - } - } - return; -} - sub captcha_display { my ($context,$lonhost,$defdom) = @_; my ($output,$error); - my ($captcha,$pubkey,$privkey,$version) = + my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom); if ($captcha eq 'original') { $output = &create_captcha(); @@ -18585,7 +17992,7 @@ sub get_captcha_config { $captcha = 'recaptcha'; $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'}; if ($version ne '2') { - $version = 1; + $version = 1; } } else { $captcha = 'original'; @@ -18614,7 +18021,7 @@ sub get_captcha_config { $captcha = 'original'; } } - } + } return ($captcha,$pubkey,$privkey,$version); } @@ -18631,10 +18038,9 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". - ''. &mt('Type in the letters/numbers shown below').' '. - ''. - '
    '. + ''. + '
    '. 'captcha'; last; } @@ -18680,8 +18086,7 @@ sub check_captcha { sub create_recaptcha { my ($pubkey,$version) = @_; if ($version >= 2) { - return '
    '. - '
    '; + return '
    '; } else { my $use_ssl; if ($ENV{'SERVER_PORT'} == 443) { @@ -18693,22 +18098,26 @@ sub create_recaptcha { &mt('If the text is hard to read, [_1] will replace them.', 'reCAPTCHA refresh'). '

    '; - } + } } sub check_recaptcha { my ($privkey,$version) = @_; my $captcha_chk; - my $ip = &Apache::lonnet::get_requestor_ip(); if ($version >= 2) { - my $ua = LWP::UserAgent->new; - $ua->timeout(10); my %info = ( - secret => $privkey, + secret => $privkey, response => $env{'form.g-recaptcha-response'}, - remoteip => $ip, + remoteip => $ENV{'REMOTE_ADDR'}, ); - my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); + my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify'); + $request->content(join('&',map { + my $name = escape($_); + "$name=" . ( ref($info{$_}) eq 'ARRAY' + ? join("&$name=", map {escape($_) } @{$info{$_}}) + : &escape($info{$_}) ); + } keys(%info))); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1); if ($response->is_success) { my $data = JSON::DWIW->from_json($response->decoded_content); if (ref($data) eq 'HASH') { @@ -18722,7 +18131,7 @@ sub check_recaptcha { my $captcha_result = $captcha->check_answer( $privkey, - $ip, + $ENV{'REMOTE_ADDR'}, $env{'form.recaptcha_challenge_field'}, $env{'form.recaptcha_response_field'}, ); @@ -18771,17 +18180,14 @@ sub cleanup_html { # Checks for critical messages and returns a redirect url if one exists. # $interval indicates how often to check for messages. -# $context is the calling context -- roles, grades, contents, menu or flip. +# $context is the calling context -- roles, grades, contents, menu or flip. sub critical_redirect { my ($interval,$context) = @_; - unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) { - return (); - } if ((time-$env{'user.criticalcheck.time'})>$interval) { if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) { my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1); + my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1); if ($blocked) { my $checkrole = "cm./$cdom/$cnum"; if ($env{'request.course.sec'} ne '') { @@ -18793,18 +18199,18 @@ sub critical_redirect { } } } - 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] ne 'no_such_host') && ($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 (); } @@ -19003,7 +18409,6 @@ sub shorten_symbs { } else { foreach my $key (keys(%collisions)) { $failed->{$key} = 1; - $failed->{$key} = 1; } } } @@ -19033,9 +18438,7 @@ sub is_nonframeable { } my $uselink; my $request = new HTTP::Request('HEAD',$url); - my $ua = LWP::UserAgent->new; - $ua->timeout(5); - my $response=$ua->request($request); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5); if ($response->is_success()) { my $secpolicy = lc($response->header('content-security-policy')); my $xframeop = lc($response->header('x-frame-options')); @@ -19163,37 +18566,6 @@ sub is_nonframeable { return $uselink; } -sub page_menu { - my ($menucolls,$menunum) = @_; - my %menu; - foreach my $item (split(/;/,$menucolls)) { - my ($num,$value) = split(/\%/,$item); - if ($num eq $menunum) { - my @entries = split(/\&/,$value); - foreach my $entry (@entries) { - my ($name,$fields) = split(/=/,$entry); - if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) { - $menu{$name} = $fields; - } else { - my @shown; - if ($fields =~ /,/) { - @shown = split(/,/,$fields); - } else { - @shown = ($fields); - } - if (@shown) { - foreach my $field (@shown) { - next if ($field eq ''); - $menu{$field} = 1; - } - } - } - } - } - } - return %menu; -} - 1; __END__;