--- loncom/interface/loncommon.pm 2016/11/13 14:38:30 1.1075.2.117 +++ loncom/interface/loncommon.pm 2017/01/18 21:24:40 1.1270 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.117 2016/11/13 14:38:30 raeburn Exp $ +# $Id: loncommon.pm,v 1.1270 2017/01/18 21:24:40 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -74,12 +74,15 @@ use LONCAPA qw(:DEFAULT :match); 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; # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -164,6 +167,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 +202,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); @@ -262,7 +267,7 @@ BEGIN { next if ($line =~ /^\#/); chomp($line); my ($extension,$category)=(split(/\s+/,$line,2)); - push @{$category_extensions{lc($category)}},$extension; + push(@{$category_extensions{lc($category)}},$extension); } close($fh); } @@ -675,7 +680,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)); @@ -876,6 +881,8 @@ sub selectcourse_link { my $linktext = &mt('Select Course'); if ($selecttype eq 'Community') { $linktext = &mt('Select Community'); + } elsif ($selecttype eq 'Placement') { + $linktext = &mt('Select Placement Test'); } elsif ($selecttype eq 'Course/Community') { $linktext = &mt('Select Course/Community'); $type = ''; @@ -911,12 +918,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; } } @@ -992,7 +999,7 @@ sub select_datelocale { } $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id}); push(@possibles,$id); - } + } } } foreach my $item (sort(@possibles)) { @@ -1028,6 +1035,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 @@ -1060,6 +1094,9 @@ linked_select_forms takes the following =item * $onchangesecond, additional javascript call to execute for an onchange event for the second \n"; + $result .= ""; } +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); +} + +sub import_crsauthor_form { + my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_; + return (0) unless ($env{'request.course.id'}); + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'}; + return (0) unless (($cnum ne '') && ($cdom ne '')); + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + my @ids=&Apache::lonnet::current_machine_ids(); + my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus); + + if (grep(/^\Q$crshome\E$/,@ids)) { + $is_home = 1; + } + $relpath = "/priv/$cdom/$cnum"; + &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files); + my %lt = &Apache::lonlocal::texthash ( + fnam => '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}}))) { + 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; + } + } + } + $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; + } + } + push(@singledirfiles,$file); + } + 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 @@ -2247,7 +2556,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. @@ -2260,7 +2569,11 @@ sub select_form { if ($onchange) { $onchange = ' onchange="'.$onchange.'"'; } - my $selectform = "\n"; my @keys; if (exists($hashref->{'select_form_order'})) { @keys=@{$hashref->{'select_form_order'}}; @@ -2446,7 +2759,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 @@ -2467,7 +2780,7 @@ sub select_dom_form { } if ($includeempty) { @domains=('',@domains); } if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; + map { $exclude{$_} = 1; } @{$excdoms}; } my $selectdomain = "".&mt('Visible input').''; + $result.=''; return $result; } @@ -3017,7 +3330,7 @@ sub authform_local { my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); if ($in{'readonly'}) { $disabled = ' disabled="disabled"'; - } + } if (defined($in{'curr_authtype'})) { if ($in{'curr_authtype'} eq 'loc') { if ($can_assign{'loc'}) { @@ -3087,7 +3400,7 @@ sub authform_filesystem { } else { $result = &mt('Currently Filesystem Authenticated.'); return $result; - } + } } } else { if ($authnum == 1) { @@ -3331,13 +3644,73 @@ sub get_related_words { untie %thesaurus_db; return @Words; } +############################################################### +# +# Spell checking +# =pod =back +=head1 Spell checking + +=over 4 + +=item * &check_spelling($wordlist $language) + +Takes a string containing words and feeds it to an external +spellcheck program via a pipeline. Returns a string containing +them mis-spelled words. + +Parameters: + +=over 4 + +=item - $wordlist + +String that will be fed into the spellcheck program. + +=item - $language + +Language string that specifies the language for which the spell +check will be performed. + +=back + +=back + +Note: This sub assumes that aspell is installed. + + =cut + +sub check_spelling { + my ($wordlist, $language) = @_; + my @misspellings; + + # Generate the speller and set the langauge. + # if explicitly selected: + + my $speller = Text::Aspell->new; + if ($language) { + $speller->set_option('lang', $language); + } + + # Turn the word list into an array of words by splittingon whitespace + + my @words = split(/\s+/, $wordlist); + + foreach my $word (@words) { + if(! $speller->check($word)) { + push(@misspellings, $word); + } + } + return join(' ', @misspellings); + +} + # -------------------------------------------------------------- Plaintext name =pod @@ -3801,7 +4174,11 @@ category sub filecategorytypes { my ($cat) = @_; - return @{$category_extensions{lc($cat)}}; + if (ref($category_extensions{lc($cat)}) eq 'ARRAY') { + return @{$category_extensions{lc($cat)}}; + } else { + return (); + } } =pod @@ -3968,7 +4345,7 @@ Return string with previous attempt on p =item * $usec: section of the desired student -=item * $identifier: counter for student (multiple students one problem) or +=item * $identifier: counter for student (multiple students one problem) or problem (one student; whole sequence). =back @@ -4055,7 +4432,7 @@ sub get_previous_attempt { my (@hidden,@unsolved); if (%typeparts) { foreach my $id (keys(%typeparts)) { - if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || + if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) { push(@hidden,$id); } elsif ($identifier ne '') { @@ -4116,7 +4493,7 @@ sub get_previous_attempt { if ($key =~ /\./) { my $value = $returnhash{$version.':'.$key}; if ($key =~ /\.rndseed$/) { - my ($id) = ($key =~ /^(.+)\.rndseed$/); + my ($id) = ($key =~ /^(.+)\.[^.]+$/); if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) { $value = $returnhash{$version.':'.$id.'.rawrndseed'}; } @@ -4133,7 +4510,7 @@ sub get_previous_attempt { next if ($key =~ /\.foilorder$/); my $value = $returnhash{$version.':'.$key}; if ($key =~ /\.rndseed$/) { - my ($id) = ($key =~ /^(.+)\.rndseed$/); + my ($id) = ($key =~ /^(.+)\.[^.]+$/); if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) { $value = $returnhash{$version.':'.$id.'.rawrndseed'}; } @@ -4164,7 +4541,7 @@ sub get_previous_attempt { if ($key =~/$regexp$/ && (defined &$gradesub)) { $value = &$gradesub($value); } - $prevattempts.=''.$value.' '; + $prevattempts.=''. $value.' '; } else { $prevattempts.=' '; } @@ -4180,7 +4557,7 @@ sub get_previous_attempt { if ($key =~/$regexp$/ && (defined &$gradesub)) { $value = &$gradesub($value); } - $prevattempts.=''.$value.' '; + $prevattempts.=''.$value.' '; } } $prevattempts.= &end_data_table_row().&end_data_table(); @@ -4201,11 +4578,13 @@ sub get_previous_attempt { sub format_previous_attempt_value { my ($key,$value) = @_; if (($key =~ /timestamp/) || ($key=~/duedate/)) { - $value = &Apache::lonlocal::locallocaltime($value); + $value = &Apache::lonlocal::locallocaltime($value); } elsif (ref($value) eq 'ARRAY') { - $value = '('.join(', ', @{ $value }).')'; + $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&'); } elsif ($key =~ /answerstring$/) { my %answers = &Apache::lonnet::str2hash($value); + my @answer = %answers; + %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer; my @anskeys = sort(keys(%answers)); if (@anskeys == 1) { my $answer = $answers{$anskeys[0]}; @@ -4228,7 +4607,7 @@ sub format_previous_attempt_value { } } } else { - $value = &unescape($value); + $value = &HTML::Entities::encode(&unescape($value), '"<>&'); } return $value; } @@ -4895,7 +5274,7 @@ sub blocking_status { my $querystring = "?activity=$activity"; # $uname and $udom decide whose portfolio the user is trying to look at if (($activity eq 'port') || ($activity eq 'passwd')) { - $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); + $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/); } elsif ($activity eq 'docs') { $querystring .= '&url='.&HTML::Entities::encode($url,'&"'); @@ -4946,17 +5325,39 @@ sub check_ip_acc { if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { return 1; } - my $allowed=0; + my $allowed; my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; my $name; - foreach my $pattern (split(',',$acc)) { - $pattern =~ s/^\s*//; - $pattern =~ s/\s*$//; + my %access = ( + allowfrom => 1, + denyfrom => 0, + ); + my @allows; + my @denies; + foreach my $item (split(',',$acc)) { + $item =~ s/^\s*//; + $item =~ s/\s*$//; + my $pattern; + if ($item =~ /^\!(.+)$/) { + push(@denies,$1); + } else { + push(@allows,$item); + } + } + my $numdenies = scalar(@denies); + my $numallows = scalar(@allows); + my $count = 0; + foreach my $pattern (@denies,@allows) { + $count ++; + my $acctype = 'allowfrom'; + if ($count <= $numdenies) { + $acctype = 'denyfrom'; + } if ($pattern =~ /\*$/) { #35.8.* $pattern=~s/\*//; - if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } + if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { #35.8.3.[34-56] my $low=$2; @@ -4964,7 +5365,7 @@ sub check_ip_acc { $pattern=$1; if ($ip =~ /^\Q$pattern\E/) { my $last=(split(/\./,$ip))[3]; - if ($last <=$high && $last >=$low) { $allowed=1; } + if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } } } elsif ($pattern =~ /^\*/) { #*.msu.edu @@ -4974,10 +5375,10 @@ sub check_ip_acc { my $netaddr=inet_aton($ip); ($name)=gethostbyaddr($netaddr,AF_INET); } - if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } + if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { #127.0.0.1 - if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } + if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } } else { #some.name.com if (!defined($name)) { @@ -4985,9 +5386,16 @@ sub check_ip_acc { my $netaddr=inet_aton($ip); ($name)=gethostbyaddr($netaddr,AF_INET); } - if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } + if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } + } + if ($allowed =~ /^(0|1)$/) { last; } + } + if ($allowed eq '') { + if ($numdenies && !$numallows) { + $allowed = 1; + } else { + $allowed = 0; } - if ($allowed) { last; } } return $allowed; } @@ -5052,6 +5460,7 @@ sub get_domainconf { my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'}; $designhash{$udom.'.login.loginvia'} = $server; if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') { + $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'}; } else { $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; @@ -5321,10 +5730,20 @@ sub CSTR_pageheader { $lastitem = $thisdisfn; } + my ($crsauthor,$title); + if (($env{'request.course.id'}) && + ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) && + ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) { + $crsauthor = 1; + $title = &mt('Course Authoring Space'); + } else { + $title = &mt('Authoring Space'); + } + my $output = '
' .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it? - .''.&mt('Authoring Space:').' ' + .''.$title.' ' .'
' #FIXME lonpubdir: target="_parent" .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef); @@ -5335,13 +5754,18 @@ sub CSTR_pageheader { .$lastitem .''; } - $output .= - '
' - #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."
" - .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') - .'
' - .&Apache::lonmenu::constspaceform() - .'
'; + + if ($crsauthor) { + $output .= ''.&Apache::lonmenu::constspaceform(); + } else { + $output .= + '
' + #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."
" + .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') + .'' + .&Apache::lonmenu::constspaceform(); + } + $output .= ''; return $output; } @@ -5383,9 +5807,6 @@ Inputs: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value -=item * $no_inline_link, if true and in remote mode, don't show the - 'Switch To Inline Menu' link - =item * $args, optional argument valid values are no_auto_mt_title -> prevents &mt()ing the title arg @@ -5404,7 +5825,7 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, - $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_; + $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_; my $public; if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) @@ -5441,9 +5862,13 @@ sub bodytag { if ($env{'request.role'} !~ /^cr/) { $role = &Apache::lonnet::plaintext($role,&course_type()); } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) { - $role = &mt('Helpdesk[_1]',' '.$2); + if ($env{'request.role.desc'}) { + $role = $env{'request.role.desc'}; + } else { + $role = &mt('Helpdesk[_1]',' '.$2); + } } else { - $role = (split(/\//,$role,4))[-1]; + $role = (split(/\//,$role,4))[-1]; } if ($env{'request.course.sec'}) { $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'}; @@ -5483,25 +5908,19 @@ sub bodytag { $dc_info =~ s/\s+$//; } - $role = '('.$role.')' if ($role && !$env{'browser.mobile'}); - - if ($env{'request.state'} eq 'construct') { $forcereg=1; } - - - - my $funclist; - if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) { - $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n". - Apache::lonmenu::serverform(); - my $forbodytag; - &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, - $forcereg,$args->{'group'}, - $args->{'bread_crumbs'}, - $advtoolsref,'',\$forbodytag); - unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { - $funclist = $forbodytag; - } + my $crstype; + if ($env{'request.course.id'}) { + $crstype = $env{'course.'.$env{'request.course.id'}.'.type'}; + } elsif ($args->{'crstype'}) { + $crstype = $args->{'crstype'}; + } + if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) { + undef($role); } else { + $role = '('.$role.')' if ($role && !$env{'browser.mobile'}); + } + + if ($env{'request.state'} eq 'construct') { $forcereg=1; } # if ($env{'request.state'} eq 'construct') { # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls @@ -5510,14 +5929,14 @@ sub bodytag { $bodytag .= Apache::lonhtmlcommon::scripttag( Apache::lonmenu::utilityfunctions($httphost), 'start'); - my ($left,$right) = Apache::lonmenu::primary_menu(); + my ($left,$right) = Apache::lonmenu::primary_menu($crstype); if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { - if ($dc_info) { + if ($dc_info) { $dc_info = qq|$dc_info|; - } - $bodytag .= qq|
$left $role
- $realm $dc_info
|; + } + $bodytag .= qq|
$left $role
+ $realm $dc_info
|; return $bodytag; } @@ -5532,7 +5951,7 @@ sub bodytag { } $bodytag .= qq|
$realm $dc_info
|; - #if directed to not display the secondary menu, don't. + #if directed to not display the secondary menu, don't. if ($args->{'no_secondary_menu'}) { return $bodytag; } @@ -5549,14 +5968,11 @@ sub bodytag { $args->{'group'}, $args->{'hide_buttons'}); } else { - my $forbodytag; - &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, - $forcereg,$args->{'group'}, - $args->{'bread_crumbs'}, - $advtoolsref,'',\$forbodytag); - unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { - $bodytag .= $forbodytag; - } + $bodytag .= + &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, + $forcereg,$args->{'group'}, + $args->{'bread_crumbs'}, + $advtoolsref); } }else{ # this is to seperate menu from content when there's no secondary @@ -5566,54 +5982,6 @@ sub bodytag { } return $bodytag; - } - -# -# Top frame rendering, Remote is up -# - - my $imgsrc = $img; - if ($img =~ /^\/adm/) { - $imgsrc = &lonhttpdurl($img); - } - my $upperleft=''.$function.''; - - my $help=($no_inline_link?'' - :&Apache::loncommon::top_nav_help('Help')); - - # Explicit link to get inline menu - my $menu= ($no_inline_link?'' - :''.&mt('Switch to Inline Menu Mode').''); - - if ($dc_info) { - $dc_info = qq|($dc_info)|; - } - - my $name = &plainname($env{'user.name'},$env{'user.domain'}); - unless ($public) { - $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'}, - undef,'LC_menubuttons_link'); - } - - unless ($env{'form.inhibitmenu'}) { - $bodytag .= qq|
$name $role
-
    -
  1. $help
    2. -
  2. $menu
    3. -
$realm $dc_info
|; - } - if ($env{'request.state'} eq 'construct') { - if (!$public){ - if ($env{'request.state'} eq 'construct') { - $funclist = &Apache::lonhtmlcommon::scripttag( - &Apache::lonmenu::utilityfunctions($httphost), 'start'). - &Apache::lonhtmlcommon::scripttag('','end'). - &Apache::lonmenu::innerregister($forcereg, - $args->{'bread_crumbs'}); - } - } - } - return $bodytag."\n".$funclist; } sub dc_courseid_toggle { @@ -5645,15 +6013,8 @@ sub make_attr_string { delete($attr_ref->{$key}); } } - if ($env{'environment.remote'} eq 'on') { - $attr_ref->{'onload'} = - &Apache::lonmenu::loadevents(). $on_load; - $attr_ref->{'onunload'}= - &Apache::lonmenu::unloadevents().$on_unload; - } else { - $attr_ref->{'onload'} = $on_load; - $attr_ref->{'onunload'}= $on_unload; - } + $attr_ref->{'onload'} = $on_load; + $attr_ref->{'onunload'}= $on_unload; } my $attr_string; @@ -5977,6 +6338,12 @@ ul.LC_breadcrumb_tools_outerlist li { float: right; } +.LC_placement_prog { + padding-right: 20px; + font-weight: bold; + font-size: 90%; +} + table#LC_title_bar td { background: $tabbg; } @@ -7035,7 +7402,7 @@ ol.LC_primary_menu li { line-height: 1.5em; } -ol.LC_primary_menu li a, +ol.LC_primary_menu li a, ol.LC_primary_menu li p { display: block; margin: 0; @@ -7050,7 +7417,7 @@ ol.LC_primary_menu li p span.LC_primary_ } ol.LC_primary_menu li p span.LC_primary_menu_innerarrow { - display: inline-block; + display: inline-block; width: 5%; float: right; text-align: right; @@ -7085,9 +7452,9 @@ ol.LC_primary_menu li:hover li, ol.LC_pr float: none; border-left: 1px solid black; border-right: 1px solid black; -/* A dark bottom border to visualize different menu options; +/* A dark bottom border to visualize different menu options; overwritten in the create_submenu routine for the last border-bottom of the menu */ - border-bottom: 1px solid $data_table_dark; + border-bottom: 1px solid $data_table_dark; } ol.LC_primary_menu li li p:hover { @@ -7648,6 +8015,16 @@ ul.LC_funclist li { } /* + styles used for response display +*/ +div.LC_radiofoil, div.LC_rankfoil { + margin: .5em 0em .5em 0em; +} +table.LC_itemgroup { + margin-top: 1em; +} + +/* styles used by TTH when "Default set of options to pass to tth/m when converting TeX" in course settings has been set @@ -7668,6 +8045,120 @@ span.roman {font-family: serif; font-sty span.overacc2 {position: relative; left: .8em; top: -1.2ex;} span.overacc1 {position: relative; left: .6em; top: -1.2ex;} +/* + sections with roles, for content only +*/ +section[class^="role-"] { + padding-left: 10px; + padding-right: 5px; + margin-top: 8px; + margin-bottom: 8px; + border: 1px solid #2A4; + border-radius: 5px; + box-shadow: 0px 1px 1px #BBB; +} +section[class^="role-"]>h1 { + position: relative; + margin: 0px; + padding-top: 10px; + padding-left: 40px; +} +section[class^="role-"]>h1:before { + position: absolute; + left: -5px; + top: 5px; +} +section.role-activity>h1:before { + content:url('/adm/daxe/images/section_icons/activity.png'); +} +section.role-advice>h1:before { + content:url('/adm/daxe/images/section_icons/advice.png'); +} +section.role-bibliography>h1:before { + content:url('/adm/daxe/images/section_icons/bibliography.png'); +} +section.role-citation>h1:before { + content:url('/adm/daxe/images/section_icons/citation.png'); +} +section.role-conclusion>h1:before { + content:url('/adm/daxe/images/section_icons/conclusion.png'); +} +section.role-definition>h1:before { + content:url('/adm/daxe/images/section_icons/definition.png'); +} +section.role-demonstration>h1:before { + content:url('/adm/daxe/images/section_icons/demonstration.png'); +} +section.role-example>h1:before { + content:url('/adm/daxe/images/section_icons/example.png'); +} +section.role-explanation>h1:before { + content:url('/adm/daxe/images/section_icons/explanation.png'); +} +section.role-introduction>h1:before { + content:url('/adm/daxe/images/section_icons/introduction.png'); +} +section.role-method>h1:before { + content:url('/adm/daxe/images/section_icons/method.png'); +} +section.role-more_information>h1:before { + content:url('/adm/daxe/images/section_icons/more_information.png'); +} +section.role-objectives>h1:before { + content:url('/adm/daxe/images/section_icons/objectives.png'); +} +section.role-prerequisites>h1:before { + content:url('/adm/daxe/images/section_icons/prerequisites.png'); +} +section.role-remark>h1:before { + content:url('/adm/daxe/images/section_icons/remark.png'); +} +section.role-reminder>h1:before { + content:url('/adm/daxe/images/section_icons/reminder.png'); +} +section.role-summary>h1:before { + content:url('/adm/daxe/images/section_icons/summary.png'); +} +section.role-syntax>h1:before { + content:url('/adm/daxe/images/section_icons/syntax.png'); +} +section.role-warning>h1:before { + content:url('/adm/daxe/images/section_icons/warning.png'); +} + +#LC_minitab_header { + float:left; + width:100%; + background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom; + font-size:93%; + line-height:normal; + margin: 0.5em 0 0.5em 0; +} +#LC_minitab_header ul { + margin:0; + padding:10px 10px 0; + list-style:none; +} +#LC_minitab_header li { + float:left; + background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top; + margin:0; + padding:0 0 0 9px; +} +#LC_minitab_header a { + display:block; + background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top; + padding:5px 15px 4px 6px; +} +#LC_minitab_header #LC_current_minitab { + background-image:url("/res/adm/pages/minitabmenu_left_on.gif"); +} +#LC_minitab_header #LC_current_minitab a { + background-image:url("/res/adm/pages/minitabmenu_right_on.gif"); + padding-bottom:5px; +} + + END } @@ -7725,8 +8216,8 @@ sub headtag { if (!$args->{'frameset'}) { $result .= &Apache::lonhtmlcommon::htmlareaheaders(); } - if ($args->{'force_register'}) { - $result .= &Apache::lonmenu::registerurl(1); + if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) { + $result .= Apache::lonxml::display_title(); } if (!$args->{'no_nav_bar'} && !$args->{'only_body'} @@ -7846,7 +8337,7 @@ OFFLOAD if (!$args->{'frameset'}) { $result .= ' /'; } - $result .= '>' + $result .= '>' .$inhibitprint .$head_extra; my $clientmobile; @@ -7878,12 +8369,12 @@ sub font_settings { my $headerstring=''; if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) || ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) { - $headerstring.= - '{'frameset'}) { - $headerstring.= ' /'; + $headerstring.= ' /'; } - $headerstring .= '>'."\n"; + $headerstring .= '>'."\n"; } return $headerstring; } @@ -8036,13 +8527,11 @@ $args - additional optional args support skip_phases -> hash ref of head -> skip the generation body -> skip all generation - no_inline_link -> if true and in remote mode, don't show the - 'Switch To Inline Menu' link no_auto_mt_title -> prevent &mt()ing the title arg bread_crumbs -> Array containing breadcrumbs bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs - group -> includes the current group, if page is for a - specific group + group -> includes the current group, if page is for a + specific group =back @@ -8072,8 +8561,8 @@ sub start_page { $args->{'function'}, $args->{'add_entries'}, $args->{'only_body'}, $args->{'domain'}, $args->{'force_register'}, $args->{'no_nav_bar'}, - $args->{'bgcolor'}, $args->{'no_inline_link'}, - $args, \@advtools); + $args->{'bgcolor'}, $args, + \@advtools); } } @@ -8110,14 +8599,12 @@ sub start_page { #if bread_crumbs_component exists show it as headline else show only the breadcrumbs if(exists($args->{'bread_crumbs_component'})){ $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'}); - }else{ + } elsif ($args->{'crstype'} eq 'Placement') { + $result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','', + $args->{'crstype'}); + } else { $result .= &Apache::lonhtmlcommon::breadcrumbs(); } - } elsif (($env{'environment.remote'} eq 'on') && - ($env{'form.inhibitmenu'} ne 'yes') && - ($env{'request.noversionuri'} =~ m{^/res/}) && - ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) { - $result .= '
'; } return $result; } @@ -8213,7 +8700,7 @@ var modalWindow = { }; var openMyModal = function(source,width,height,scrolling,transparency,style) { - source = source.replace("'","'"); + source = source.replace(/'/g,"'"); modalWindow.windowId = "myModal"; modalWindow.width = width; modalWindow.height = height; @@ -8265,7 +8752,7 @@ sub modal_adhoc_inner { my ($funcname,$width,$height,$content)=@_; my $innerwidth=$width-20; $content=&js_ready( - &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). + &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1). $content. &end_scrollbox(). @@ -8910,7 +9397,7 @@ sub get_sections { } } - if ($check_students) { + if ($check_students) { my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); @@ -9232,8 +9719,8 @@ Incoming parameters: 2. user's domain 3. quota name - portfolio, author, or course (if no quota name provided, defaults to portfolio). -4. crstype - official, unofficial, textbook or community, if quota name is - course +4. crstype - official, unofficial, textbook, placement or community, + if quota name is course Returns: 1. Disk quota (in MB) assigned to student. @@ -9306,8 +9793,9 @@ sub get_user_quota { if ($quota eq '' || wantarray) { if ($quotaname eq 'course') { my %domdefs = &Apache::lonnet::get_domain_defaults($udom); - if (($crstype eq 'official') || ($crstype eq 'unofficial') || - ($crstype eq 'community') || ($crstype eq 'textbook')) { + if (($crstype eq 'official') || ($crstype eq 'unofficial') || + ($crstype eq 'community') || ($crstype eq 'textbook') || + ($crstype eq 'placement')) { $defquota = $domdefs{$crstype.'quota'}; } if ($defquota eq '') { @@ -9455,7 +9943,7 @@ Inputs: 7 4. filename of file for which action is being requested 5. filesize (kB) of file 6. action being taken: copy or upload. -7. quotatype (in course context -- official, unofficial, community or textbook). +7. quotatype (in course context -- official, unofficial, textbook, placement or community). Returns: 1 scalar: HTML to display containing warning if quota would be exceeded, otherwise return null. @@ -9491,6 +9979,8 @@ sub excess_filesize_warning { ############################################### + + sub get_secgrprole_info { my ($cdom,$cnum,$needroles,$type) = @_; my %sections_count = &get_sections($cdom,$cnum); @@ -9801,7 +10291,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; @@ -9812,7 +10302,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} = {}; @@ -9882,7 +10372,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 '') { @@ -9905,7 +10395,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'}; } } @@ -9928,7 +10418,7 @@ sub user_rule_check { $id = $inst_results->{$user}->{'id'}; } } - if ($id eq '') { + if ($id eq '') { if (ref($usershash->{$user})) { $id = $usershash->{$user}->{'id'}; } @@ -10107,7 +10597,7 @@ sub get_institutional_codes { foreach (@currxlists) { if (m/^([^:]+):(\w*)$/) { unless (grep/^$1$/,@{$allcourses}) { - push @{$allcourses},$1; + push(@{$allcourses},$1); $$LC_code{$1} = $2; } } @@ -10120,7 +10610,7 @@ sub get_institutional_codes { my $sec = $coursecode.$1; my $lc_sec = $2; unless (grep/^$sec$/,@{$allcourses}) { - push @{$allcourses},$sec; + push(@{$allcourses},$sec); $$LC_code{$sec} = $lc_sec; } } @@ -10230,7 +10720,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. @@ -10240,13 +10730,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)) { @@ -10299,7 +10811,7 @@ sub get_future_slots { $reservable_now{$slot} = { symb => $symb, endreserve => $lastres, - uniqueperiod => $uniqueperiod, + uniqueperiod => $uniqueperiod, }; } elsif (($startreserve > $now) && (!$endreserve || $endreserve > $startreserve)) { @@ -10464,7 +10976,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); @@ -10480,6 +11008,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(); @@ -10487,7 +11018,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'}) { @@ -10519,18 +11050,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"; } @@ -10564,6 +11095,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(.+)$})) { @@ -10606,11 +11147,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') { @@ -10681,6 +11235,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')) { @@ -10719,6 +11276,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) { @@ -10747,17 +11306,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+://}); @@ -10981,7 +11548,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. @@ -11000,7 +11567,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; @@ -11339,7 +11906,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 { @@ -11474,7 +12041,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{/([^/]+)$}); @@ -12084,7 +12651,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; @@ -12536,7 +13103,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -12656,7 +13223,7 @@ sub process_extracted_files { } } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; } } for (my $i=1; $i<=$numitems; $i++) { @@ -12678,7 +13245,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}}"; @@ -12725,12 +13292,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; } } @@ -12740,7 +13307,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)) { @@ -13491,7 +14058,7 @@ sub DrawBarGraph { @Labels = @$labels; } else { for (my $i=0;$i<@{$Values[0]};$i++) { - push (@Labels,$i+1); + push(@Labels,$i+1); } } # @@ -13930,14 +14497,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. @@ -13950,9 +14517,9 @@ Returns: comma separated list of address sub build_recipient_list { my ($defmail,$mailing,$defdom,$origmail) = @_; my @recipients; - my $otheremails; + my ($otheremails,$lastresort,$allbcc,$addtext); my %domconfig = - &Apache::lonnet::get_dom('configuration',['contacts'],$defdom); + &Apache::lonnet::get_dom('configuration',['contacts'],$defdom); if (ref($domconfig{'contacts'}) eq 'HASH') { if (exists($domconfig{'contacts'}{$mailing})) { if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') { @@ -13964,14 +14531,96 @@ sub build_recipient_list { push(@recipients,$addr); } } - $otheremails = $domconfig{'contacts'}{$mailing}{'others'}; + } + $otheremails = $domconfig{'contacts'}{$mailing}{'others'}; + if ($mailing eq 'helpdeskmail') { + if ($domconfig{'contacts'}{$mailing}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{$mailing}{'include'}; } } } elsif ($origmail ne '') { - push(@recipients,$origmail); + $lastresort = $origmail; } } elsif ($origmail ne '') { - push(@recipients,$origmail); + $lastresort = $origmail; + } + + if (($mailing eq 'helpdesk') && ($lastresort ne '')) { + unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'}; + my %what = ( + perlvar => 1, + ); + my $primary = &Apache::lonnet::domain($defdom,'primary'); + if ($primary) { + my $gotaddr; + my ($result,$returnhash) = + &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 }); + if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) { + if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) { + $lastresort = $returnhash->{'lonSupportEMail'}; + $gotaddr = 1; + } + } + unless ($gotaddr) { + my $uintdom = &Apache::lonnet::internet_dom($primary); + my $intdom = &Apache::lonnet::internet_dom($lonhost); + unless ($uintdom eq $intdom) { + my %domconfig = + &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom); + if (ref($domconfig{'contacts'}) eq 'HASH') { + if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') { + my @contacts = ('adminemail','supportemail'); + foreach my $item (@contacts) { + if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) { + my $addr = $domconfig{'contacts'}{$item}; + if (!grep(/^\Q$addr\E$/,@recipients)) { + push(@recipients,$addr); + } + } + } + if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) { + $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'}; + } + if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'}; + } + } + } + } + } + } } if (defined($defmail)) { if ($defmail ne '') { @@ -13991,8 +14640,102 @@ sub build_recipient_list { } } } + if ($mailing eq 'helpdesk') { + if ((!@recipients) && ($lastresort ne '')) { + push(@recipients,$lastresort); + } + } elsif ($lastresort ne '') { + if (!grep(/^\Q$lastresort\E$/,@recipients)) { + push(@recipients,$lastresort); + } + } my $recipientlist = join(',',@recipients); - return $recipientlist; + if (wantarray) { + return ($recipientlist,$allbcc,$addtext); + } else { + return $recipientlist; + } +} + +############################################################ +############################################################ + +=pod + +=over 4 + +=item * &mime_email() + +Sends an email with a possible attachment + +Inputs: + +=over 4 + +from - Sender's 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 + +type - File type of attachment + +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, $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 ($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'); } ############################################################ @@ -14102,6 +14845,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; } @@ -14243,8 +14988,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'; @@ -14257,6 +15004,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 .= ''. ' 1}); if ($args->{'crstype'} eq 'Community') { if ($clonedesc{'type'} ne 'Community') { - $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); + $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); return ($can_clone, $clonemsg, $cloneid, $clonehome); } } - if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && + if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) { $can_clone = 1; } else { @@ -14584,7 +15333,7 @@ sub check_clone { if ($args->{'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'})) { @@ -14603,7 +15352,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) { @@ -14642,12 +15391,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'})) { @@ -14659,7 +15408,7 @@ sub check_clone { $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'}); - } + } } } } @@ -14667,7 +15416,8 @@ sub check_clone { } sub construct_course { - my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_; + my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, + $cnum,$category,$coderef) = @_; my $outcome; my $linefeed = '
    '."\n"; if ($context eq 'auto') { @@ -14695,7 +15445,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'}, @@ -14712,7 +15467,7 @@ sub construct_course { # Utils::Course. This needs to at least be output as a comment # if anyone ever decides to not show this, and Utils::Course::new # will need to be suitably modified. - $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); } @@ -14732,7 +15487,7 @@ sub construct_course { # Do the cloning # if ($can_clone && $cloneid) { - $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome); + $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome); if ($context ne 'auto') { $clonemsg = ''.$clonemsg.''; } @@ -14815,7 +15570,7 @@ sub construct_course { my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'}); $cenv{'internal.sectionnums'} .= $item.','; unless ($addcheck eq 'ok') { - push @badclasses, $class; + push(@badclasses,$class); } } $cenv{'internal.sectionnums'} =~ s/,$//; @@ -14843,7 +15598,7 @@ sub construct_course { my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'}); $cenv{'internal.crosslistings'} .= $item.','; unless ($addcheck eq 'ok') { - push @badclasses, $xl; + push(@badclasses,$xl); } } $cenv{'internal.crosslistings'} =~ s/,$//; @@ -14878,27 +15633,28 @@ sub construct_course { } if (@badclasses > 0) { my %lt=&Apache::lonlocal::texthash( - 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course', - 'dnhr' => 'does not have rights to access enrollment in these classes', - 'adby' => 'as determined by the policies of your institution on access to official classlists' + 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.', + 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.', + 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.', ); - my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}. - ' ('.$lt{'adby'}.')'; + my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed. + &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'}; if ($context eq 'auto') { $outcome .= $badclass_msg.$linefeed; + } else { $outcome .= '
    '.$badclass_msg.$linefeed.'
      '."\n"; - foreach my $item (@badclasses) { - if ($context eq 'auto') { - $outcome .= " - $item\n"; - } else { - $outcome .= "
    • $item
      • \n"; - } - } + } + foreach my $item (@badclasses) { if ($context eq 'auto') { - $outcome .= $linefeed; + $outcome .= " - $item\n"; } else { - $outcome .= "


    \n"; + $outcome .= "
  • $item
    • \n"; } + } + if ($context eq 'auto') { + $outcome .= $linefeed; + } else { + $outcome .= "

    \n"; } } if ($args->{'no_end_date'}) { @@ -14968,7 +15724,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; } @@ -15040,6 +15796,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); } @@ -15053,7 +15833,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; @@ -15100,8 +15880,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)) { @@ -15119,17 +15898,19 @@ sub group_term { my %names = ( 'Course' => 'group', 'Community' => 'group', + 'Placement' => 'group', ); return $names{$crstype}; } sub course_types { - my @types = ('official','unofficial','community','textbook'); + my @types = ('official','unofficial','community','textbook','placement'); my %typename = ( official => 'Official course', unofficial => 'Unofficial course', community => 'Community', textbook => 'Textbook course', + placement => 'Placement test', ); return (\@types,\%typename); } @@ -15332,6 +16113,15 @@ sub init_user_environment { $env{'user.noloadbalance'} = $lonhost; } + if ($form->{'noloadbalance'}) { + my @hosts = &Apache::lonnet::current_machine_ids(); + my $hosthere = $form->{'noloadbalance'}; + if (grep(/^\Q$hosthere\E$/,@hosts)) { + $initial_env{"user.noloadbalance"} = $hosthere; + $env{'user.noloadbalance'} = $hosthere; + } + } + my %is_adv = ( is_adv => $env{'user.adv'} ); my %domdef; unless ($domain eq 'public') { @@ -15344,7 +16134,7 @@ sub init_user_environment { undef,\%userenv,\%domdef,\%is_adv); } - foreach my $crstype ('official','unofficial','community','textbook') { + foreach my $crstype ('official','unofficial','community','textbook','placement') { $userenv{'canrequest.'.$crstype} = &Apache::lonnet::usertools_access($username,$domain,$crstype, 'reload','requestcourses', @@ -15358,7 +16148,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'}; @@ -15468,12 +16258,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 @@ -15489,19 +16279,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 @@ -15592,15 +16382,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', ); @@ -15608,6 +16402,8 @@ sub build_filters { my $typeval = 'Course'; if ($crstype eq 'Community') { $typeval = 'Community'; + } elsif ($crstype eq 'Placement') { + $typeval = 'Placement'; } $typeselectform = ''; } else { @@ -15616,9 +16412,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.=""; } @@ -15643,7 +16445,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', @@ -15772,7 +16574,7 @@ $typeelement return $jscript.$clonewarning.$output; } -=pod +=pod =item * &timebased_select_form() @@ -15787,7 +16589,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 @@ -15824,7 +16626,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 @@ -15863,7 +16665,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). @@ -15875,7 +16677,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). @@ -15885,8 +16687,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. @@ -15969,7 +16771,7 @@ sub search_courses { if (ref($courses{$cid}) eq 'HASH') { if (ref($courses{$cid}{roles}) eq 'ARRAY') { if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) { - push (@{$courses{$cid}{roles}},$courserole); + push(@{$courses{$cid}{roles}},$courserole); } } else { $courses{$cid}{roles} = [$courserole]; @@ -16012,8 +16814,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. @@ -16126,7 +16928,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: @@ -16134,9 +16936,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. @@ -16144,10 +16946,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. @@ -16299,8 +17101,8 @@ sub recurse_supplemental { } sub symb_to_docspath { - my ($symb) = @_; - return unless ($symb); + my ($symb,$navmapref) = @_; + return unless ($symb && ref($navmapref)); my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb); if ($resurl=~/\.(sequence|page)$/) { $mapurl=$resurl; @@ -16308,9 +17110,11 @@ sub symb_to_docspath { $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'}; } my $mapresobj; - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - $mapresobj = $navmap->getResourceByUrl($mapurl); + unless (ref($$navmapref)) { + $$navmapref = Apache::lonnavmaps::navmap->new(); + } + if (ref($$navmapref)) { + $mapresobj = $$navmapref->getResourceByUrl($mapurl); } $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1}; my $type=$2; @@ -16320,7 +17124,7 @@ sub symb_to_docspath { if ($pcslist ne '') { foreach my $pc (split(/,/,$pcslist)) { next if ($pc <= 1); - my $res = $navmap->getByMapPc($pc); + my $res = $$navmapref->getByMapPc($pc); if (ref($res)) { my $thisurl = $res->src(); $thisurl=~s{^.*/([^/]+)\.\w+$}{$1}; @@ -16369,7 +17173,7 @@ sub symb_to_docspath { sub captcha_display { my ($context,$lonhost) = @_; my ($output,$error); - my ($captcha,$pubkey,$privkey,$version) = + my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost); if ($captcha eq 'original') { $output = &create_captcha(); @@ -16440,7 +17244,7 @@ sub get_captcha_config { $captcha = 'recaptcha'; $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'}; if ($version ne '2') { - $version = 1; + $version = 1; } } else { $captcha = 'original'; @@ -16522,7 +17326,7 @@ sub create_recaptcha { &mt('If the text is hard to read, [_1] will replace them.', 'reCAPTCHA refresh'). '

    '; - } + } } sub check_recaptcha { @@ -16532,7 +17336,7 @@ sub check_recaptcha { my $ua = LWP::UserAgent->new; $ua->timeout(10); my %info = ( - secret => $privkey, + secret => $privkey, response => $env{'form.g-recaptcha-response'}, remoteip => $ENV{'REMOTE_ADDR'}, ); @@ -16602,18 +17406,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 (); }