--- loncom/interface/loncommon.pm 2024/07/04 23:00:26 1.1075.2.167
+++ loncom/interface/loncommon.pm 2013/12/30 01:56:41 1.1169
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1075.2.167 2024/07/04 23:00:26 raeburn Exp $
+# $Id: loncommon.pm,v 1.1169 2013/12/30 01:56:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,6 +61,7 @@ use POSIX qw(strftime mktime);
use Apache::lonmenu();
use Apache::lonenc();
use Apache::lonlocal;
+use Apache::lonnet();
use HTML::Entities;
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
@@ -68,20 +69,12 @@ use Apache::lontexconvert();
use Apache::lonclonecourse();
use Apache::lonuserutils();
use Apache::lonuserstate();
-use Apache::courseclassifier();
use LONCAPA qw(:DEFAULT :match);
-use HTTP::Request;
use DateTime::TimeZone;
-use DateTime::Locale;
-use Encode();
+use DateTime::Locale::Catalog;
+use Text::Aspell;
use Authen::Captcha;
use Captcha::reCAPTCHA;
-use JSON::DWIW;
-use LWP::UserAgent;
-use Crypt::DES;
-use DynaLoader; # for Crypt::DES version
-use File::Copy();
-use File::Path();
# ---------------------------------------------- Designs
use vars qw(%defaultdesign);
@@ -166,6 +159,7 @@ sub ssi_with_retries {
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
my %supported_language;
+my %supported_codes;
my %latex_language; # For choosing hyphenation in
my %latex_language_bykey; # for choosing hyphenation from metadata
my %cprtag;
@@ -196,18 +190,19 @@ BEGIN {
{
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab';
- if ( open(my $fh,'<',$langtabfile) ) {
+ if ( open(my $fh,"<$langtabfile") ) {
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);
@@ -217,7 +212,7 @@ BEGIN {
{
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/copyright.tab';
- if ( open (my $fh,'<',$copyrightfile) ) {
+ if ( open (my $fh,"<$copyrightfile") ) {
while (my $line = <$fh>) {
next if ($line=~/^\#/);
chomp($line);
@@ -231,7 +226,7 @@ BEGIN {
{
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/source_copyright.tab';
- if ( open (my $fh,'<',$sourcecopyrightfile) ) {
+ if ( open (my $fh,"<$sourcecopyrightfile") ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -245,7 +240,7 @@ BEGIN {
# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/default.tab';
- if ( open (my $fh,'<',$designfile) ) {
+ if ( open (my $fh,"<$designfile") ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -259,12 +254,12 @@ BEGIN {
{
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab';
- if ( open (my $fh,'<',$categoryfile) ) {
+ if ( open (my $fh,"<$categoryfile") ) {
while (my $line = <$fh>) {
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);
}
@@ -274,7 +269,7 @@ BEGIN {
{
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filetypes.tab';
- if ( open (my $fh,'<',$typesfile) ) {
+ if ( open (my $fh,"<$typesfile") ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -427,7 +422,7 @@ sub studentbrowser_javascript {
-COLORFULEDIT
-}
-
-sub xmleditor_js {
- return <
-
-XMLEDIT
-}
-
-sub insert_folding_button {
- my $curDepth = $Apache::lonxml::curdepth;
- my $lastresource = $env{'request.ambiguous'};
-
- return " ";
-}
-
-
=pod
=head1 Excel and CSV file utility routines
@@ -2250,15 +2011,12 @@ sub multiple_select_form {
=pod
-=item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
+=item * &select_form($defdom,$name,$hashref,$onchange)
Returns a string containing a form to
allow a user to select options from a ref to a hash containing:
option_name => displayed text. An optional $onchange can include
-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.
+a javascript onchange item, e.g., onchange="this.form.submit();"
See lonrights.pm for an example invocation and use.
@@ -2266,16 +2024,12 @@ See lonrights.pm for an example invocati
#-------------------------------------------
sub select_form {
- my ($def,$name,$hashref,$onchange,$readonly) = @_;
+ my ($def,$name,$hashref,$onchange) = @_;
return unless (ref($hashref) eq 'HASH');
if ($onchange) {
$onchange = ' onchange="'.$onchange.'"';
}
- my $disabled;
- if ($readonly) {
- $disabled = ' disabled="disabled"';
- }
- my $selectform = "\n";
+ my $selectform = "\n";
my @keys;
if (exists($hashref->{'select_form_order'})) {
@keys=@{$hashref->{'select_form_order'}};
@@ -2444,7 +2198,7 @@ sub select_level_form {
=pod
-=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
+=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
Returns a string containing a form to
allow a user to select the domain to preform an operation in.
@@ -2461,19 +2215,14 @@ 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.
-
=cut
#-------------------------------------------
sub select_dom_form {
- my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
+ my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
if ($onchange) {
$onchange = ' onchange="'.$onchange.'"';
}
- if ($disabled) {
- $disabled = ' disabled="disabled"';
- }
my (@domains,%exclude);
if (ref($incdoms) eq 'ARRAY') {
@domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
@@ -2482,9 +2231,9 @@ sub select_dom_form {
}
if ($includeempty) { @domains=('',@domains); }
if (ref($excdoms) eq 'ARRAY') {
- map { $exclude{$_} = 1; } @{$excdoms};
+ map { $exclude{$_} = 1; } @{$excdoms};
}
- my $selectdomain = "\n";
+ my $selectdomain = "\n";
foreach my $dom (@domains) {
next if ($exclude{$dom});
$selectdomain.=" 'MSU.EDU',
@_,
);
- my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
+ my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
my $result;
if (!$authnum) {
$result = &mt('Under your current role you are not permitted to change login settings for this user');
@@ -2860,16 +2600,13 @@ sub authform_kerberos {
@_,
);
my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
- $autharg,$jscall,$disabled);
+ $autharg,$jscall);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
if ($in{'kerb_def_auth'} eq 'krb5') {
$check5 = ' checked="checked"';
} else {
$check4 = ' checked="checked"';
}
- if ($in{'readonly'}) {
- $disabled = ' disabled="disabled"';
- }
$krbarg = $in{'kerb_def_dom'};
if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'krb') {
@@ -2914,7 +2651,7 @@ sub authform_kerberos {
if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {
- $authtype = ' ';
+ $authtype = ' ';
}
}
}
@@ -2923,7 +2660,7 @@ sub authform_kerberos {
if ($authtype eq '') {
$authtype = ' ';
+ $krbcheck.' />';
}
if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
($can_assign{'krb4'} && !$can_assign{'krb5'} &&
@@ -2936,9 +2673,9 @@ sub authform_kerberos {
''.$authtype,
' ',
- ' ',
- ' ',
+ 'onchange="'.$jscall.'" />',
+ ' ',
+ ' ',
' ');
} elsif ($can_assign{'krb4'}) {
$result .= &mt
@@ -2947,7 +2684,7 @@ sub authform_kerberos {
''.$authtype,
' ',
+ 'onchange="'.$jscall.'" />',
' ',
' ');
} elsif ($can_assign{'krb5'}) {
@@ -2957,7 +2694,7 @@ sub authform_kerberos {
''.$authtype,
' ',
+ 'onchange="'.$jscall.'" />',
' ',
' ');
}
@@ -2970,11 +2707,8 @@ sub authform_internal {
kerb_def_dom => 'MSU.EDU',
@_,
);
- my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
+ my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
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 'int') {
if ($can_assign{'int'}) {
@@ -3003,7 +2737,7 @@ sub authform_internal {
if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {
- $authtype = ' ';
+ $authtype = ' ';
}
}
}
@@ -3011,14 +2745,14 @@ sub authform_internal {
$jscall = "javascript:changed_radio('int',$in{'formname'});";
if ($authtype eq '') {
$authtype = ' ';
+ ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
}
$autharg = ' ';
+ $intarg.'" onchange="'.$jscall.'" />';
$result = &mt
('[_1] Internally authenticated (with initial password [_2])',
''.$authtype,' '.$autharg);
- $result.=' '.&mt('Visible input').' ';
+ $result.=" ".&mt('Visible input').' ';
return $result;
}
@@ -3028,11 +2762,8 @@ sub authform_local {
kerb_def_dom => 'MSU.EDU',
@_,
);
- my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
+ my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
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'}) {
@@ -3061,7 +2792,7 @@ sub authform_local {
if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {
- $authtype = ' ';
+ $authtype = ' ';
}
}
}
@@ -3070,10 +2801,10 @@ sub authform_local {
if ($authtype eq '') {
$authtype = ' ';
+ $jscall.'" />';
}
$autharg = ' ';
+ $locarg.'" onchange="'.$jscall.'" />';
$result = &mt('[_1] Local Authentication with argument [_2]',
''.$authtype,' '.$autharg);
return $result;
@@ -3085,11 +2816,8 @@ sub authform_filesystem {
kerb_def_dom => 'MSU.EDU',
@_,
);
- my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
+ my ($fsyscheck,$result,$authtype,$autharg,$jscall);
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 'fsys') {
if ($can_assign{'fsys'}) {
@@ -3115,7 +2843,7 @@ sub authform_filesystem {
if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {
- $authtype = ' ';
+ $authtype = ' ';
}
}
}
@@ -3124,13 +2852,16 @@ sub authform_filesystem {
if ($authtype eq '') {
$authtype = ' ';
+ $jscall.'" />';
}
- $autharg = ' ';
+ $autharg = ' ';
$result = &mt
('[_1] Filesystem Authenticated (with initial password [_2])',
- ''.$authtype,' '.$autharg);
+ ' ',
+ ' ');
return $result;
}
@@ -3152,7 +2883,7 @@ sub get_assignable_auth {
my $context;
if ($env{'request.role'} =~ /^au/) {
$context = 'author';
- } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
+ } elsif ($env{'request.role'} =~ /^dc/) {
$context = 'domain';
} elsif ($env{'request.course.id'}) {
$context = 'course';
@@ -3176,79 +2907,6 @@ sub get_assignable_auth {
return ($authnum,%can_assign);
}
-sub check_passwd_rules {
- my ($domain,$plainpass) = @_;
- my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
- my ($min,$max,@chars,@brokerule,$warning);
- $min = $Apache::lonnet::passwdmin;
- if (ref($passwdconf{'chars'}) eq 'ARRAY') {
- if ($passwdconf{'min'} =~ /^\d+$/) {
- if ($passwdconf{'min'} > $min) {
- $min = $passwdconf{'min'};
- }
- }
- if ($passwdconf{'max'} =~ /^\d+$/) {
- $max = $passwdconf{'max'};
- }
- @chars = @{$passwdconf{'chars'}};
- }
- if (($min) && (length($plainpass) < $min)) {
- push(@brokerule,'min');
- }
- if (($max) && (length($plainpass) > $max)) {
- push(@brokerule,'max');
- }
- if (@chars) {
- my %rules;
- map { $rules{$_} = 1; } @chars;
- if ($rules{'uc'}) {
- unless ($plainpass =~ /[A-Z]/) {
- push(@brokerule,'uc');
- }
- }
- if ($rules{'lc'}) {
- unless ($plainpass =~ /[a-z]/) {
- push(@brokerule,'lc');
- }
- }
- if ($rules{'num'}) {
- unless ($plainpass =~ /\d/) {
- push(@brokerule,'num');
- }
- }
- if ($rules{'spec'}) {
- unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
- push(@brokerule,'spec');
- }
- }
- }
- if (@brokerule) {
- my %rulenames = &Apache::lonlocal::texthash(
- uc => 'At least one upper case letter',
- lc => 'At least one lower case letter',
- num => 'At least one number',
- spec => 'At least one non-alphanumeric',
- );
- $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
- $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
- $rulenames{'num'} .= ': 0123456789';
- $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
- $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
- $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
- $warning = &mt('Password did not satisfy the following:').'';
- foreach my $rule ('min','max','uc','lc','num','spec') {
- if (grep(/^$rule$/,@brokerule)) {
- $warning .= ''.$rulenames{$rule}.' ';
- }
- }
- $warning .= ' ';
- }
- if (wantarray) {
- return @brokerule;
- }
- return $warning;
-}
-
###############################################################
## Get Kerberos Defaults for Domain ##
###############################################################
@@ -3416,13 +3074,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
@@ -3669,30 +3387,6 @@ sub syllabuswrapper {
# -----------------------------------------------------------------------------
-sub aboutme_on {
- my ($uname,$udom)=@_;
- unless ($uname) { $uname=$env{'user.name'}; }
- unless ($udom) { $udom=$env{'user.domain'}; }
- return if ($udom eq 'public' && $uname eq 'public');
- my $hashkey=$uname.':'.$udom;
- my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
- if ($cached) {
- return $aboutme;
- }
- $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
- &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
- return $aboutme;
-}
-
-sub devalidate_aboutme_cache {
- my ($uname,$udom)=@_;
- if (!$udom) { $udom =$env{'user.domain'}; }
- if (!$uname) { $uname=$env{'user.name'}; }
- return if ($udom eq 'public' && $uname eq 'public');
- my $id=$uname.':'.$udom;
- &Apache::lonnet::devalidate_cache_new('aboutme',$id);
-}
-
sub track_student_link {
my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
my $link ="/adm/trackstudent?";
@@ -4053,7 +3747,7 @@ sub user_lang {
=over 4
=item * &get_previous_attempt($symb, $username, $domain, $course,
- $getattempt, $regexp, $gradesub, $usec, $identifier)
+ $getattempt, $regexp, $gradesub)
Return string with previous attempt on problem. Arguments:
@@ -4075,11 +3769,6 @@ Return string with previous attempt on p
=item * $gradesub: routine that processes the string if it matches $regexp
-=item * $usec: section of the desired student
-
-=item * $identifier: counter for student (multiple students one problem) or
- problem (one student; whole sequence).
-
=back
The output string is a table containing all desired attempts, if any.
@@ -4087,7 +3776,7 @@ The output string is a table containing
=cut
sub get_previous_attempt {
- my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
+ my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
my $prevattempts='';
no strict 'refs';
if ($symb) {
@@ -4097,18 +3786,13 @@ sub get_previous_attempt {
my %lasthash=();
my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {
- foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
- if ($key =~ /\.rawrndseed$/) {
- my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
- $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
- } else {
- $lasthash{$key}=$returnhash{$version.':'.$key};
- }
+ foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
+ $lasthash{$key}=$returnhash{$version.':'.$key};
}
}
$prevattempts=&start_data_table().&start_data_table_header_row();
$prevattempts.=''.&mt('History').' ';
- my (%typeparts,%lasthidden,%regraded,%hidestatus);
+ my (%typeparts,%lasthidden);
my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
foreach my $key (sort(keys(%lasthash))) {
my ($ign,@parts) = split(/\./,$key);
@@ -4125,18 +3809,6 @@ sub get_previous_attempt {
$lasthidden{$ign.'.'.$id} = 1;
}
}
- if ($identifier ne '') {
- my $id = join(',',@parts);
- if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
- $domain,$username,$usec,undef,$course) =~ /^no/) {
- $hidestatus{$ign.'.'.$id} = 1;
- }
- }
- } elsif ($data eq 'regrader') {
- if (($identifier ne '') && (@parts)) {
- my $id = join(',',@parts);
- $regraded{$ign.'.'.$id} = 1;
- }
}
} else {
if ($#parts == 0) {
@@ -4148,60 +3820,17 @@ sub get_previous_attempt {
}
$prevattempts.=&end_data_table_header_row();
if ($getattempt eq '') {
- my (%solved,%resets,%probstatus);
- if (($identifier ne '') && (keys(%regraded) > 0)) {
- for ($version=1;$version<=$returnhash{'version'};$version++) {
- foreach my $id (keys(%regraded)) {
- if (($returnhash{$version.':'.$id.'.regrader'}) &&
- ($returnhash{$version.':'.$id.'.tries'} eq '') &&
- ($returnhash{$version.':'.$id.'.award'} eq '')) {
- push(@{$resets{$id}},$version);
- }
- }
- }
- }
for ($version=1;$version<=$returnhash{'version'};$version++) {
- my (@hidden,@unsolved);
+ my @hidden;
if (%typeparts) {
foreach my $id (keys(%typeparts)) {
- if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
- ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
+ if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
push(@hidden,$id);
- } elsif ($identifier ne '') {
- unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
- ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
- ($hidestatus{$id})) {
- next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
- if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
- push(@{$solved{$id}},$version);
- } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
- (ref($solved{$id}) eq 'ARRAY')) {
- my $skip;
- if (ref($resets{$id}) eq 'ARRAY') {
- foreach my $reset (@{$resets{$id}}) {
- if ($reset > $solved{$id}[-1]) {
- $skip=1;
- last;
- }
- }
- }
- unless ($skip) {
- my ($ign,$partslist) = split(/\./,$id,2);
- push(@unsolved,$partslist);
- }
- }
- }
}
}
}
$prevattempts.=&start_data_table_row().
- ''.&mt('Transaction [_1]',$version);
- if (@unsolved) {
- $prevattempts .= ''.
- ' '.
- &mt('Hide').' ';
- }
- $prevattempts .= ' ';
+ ''.&mt('Transaction [_1]',$version).' ';
if (@hidden) {
foreach my $key (sort(keys(%lasthash))) {
next if ($key =~ /\.foilorder$/);
@@ -4223,15 +3852,9 @@ sub get_previous_attempt {
}
} else {
if ($key =~ /\./) {
- my $value = $returnhash{$version.':'.$key};
- if ($key =~ /\.rndseed$/) {
- my ($id) = ($key =~ /^(.+)\.rndseed$/);
- if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
- $value = $returnhash{$version.':'.$id.'.rawrndseed'};
- }
- }
- $prevattempts.=''.&format_previous_attempt_value($key,$value).
- ' ';
+ my $value = &format_previous_attempt_value($key,
+ $returnhash{$version.':'.$key});
+ $prevattempts.=''.$value.' ';
} else {
$prevattempts.=' ';
}
@@ -4240,15 +3863,9 @@ sub get_previous_attempt {
} else {
foreach my $key (sort(keys(%lasthash))) {
next if ($key =~ /\.foilorder$/);
- my $value = $returnhash{$version.':'.$key};
- if ($key =~ /\.rndseed$/) {
- my ($id) = ($key =~ /^(.+)\.rndseed$/);
- if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
- $value = $returnhash{$version.':'.$id.'.rawrndseed'};
- }
- }
- $prevattempts.=''.&format_previous_attempt_value($key,$value).
- ' ';
+ my $value = &format_previous_attempt_value($key,
+ $returnhash{$version.':'.$key});
+ $prevattempts.=''.$value.' ';
}
}
$prevattempts.=&end_data_table_row();
@@ -4443,59 +4060,6 @@ sub get_student_view_with_retries {
}
}
-sub css_links {
- my ($currsymb,$level) = @_;
- my ($links,@symbs,%cssrefs,%httpref);
- if ($level eq 'map') {
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (ref($navmap)) {
- my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
- my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
- foreach my $res (@resources) {
- if (ref($res) && $res->symb()) {
- push(@symbs,$res->symb());
- }
- }
- }
- } else {
- @symbs = ($currsymb);
- }
- foreach my $symb (@symbs) {
- my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
- if ($css_href =~ /\S/) {
- unless ($css_href =~ m{https?://}) {
- my $url = (&Apache::lonnet::decode_symb($symb))[-1];
- my $proburl = &Apache::lonnet::clutter($url);
- my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
- unless ($css_href =~ m{^/}) {
- $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
- }
- if ($css_href =~ m{^/(res|uploaded)/}) {
- unless (($httpref{'httpref.'.$css_href}) ||
- (&Apache::lonnet::is_on_map($css_href))) {
- my $thisurl = $proburl;
- if ($env{'httpref.'.$proburl}) {
- $thisurl = $env{'httpref.'.$proburl};
- }
- $httpref{'httpref.'.$css_href} = $thisurl;
- }
- }
- }
- $cssrefs{$css_href} = 1;
- }
- }
- if (keys(%httpref)) {
- &Apache::lonnet::appenv(\%httpref);
- }
- if (keys(%cssrefs)) {
- foreach my $css_href (keys(%cssrefs)) {
- next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
- $links .= ' '."\n";
- }
- }
- return $links;
-}
-
=pod
=item * &get_student_answers()
@@ -4751,117 +4315,33 @@ sub findallcourses {
###############################################
sub blockcheck {
- my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
+ my ($setters,$activity,$uname,$udom,$url) = @_;
- unless ($activity eq 'docs') {
- my ($has_evb,$check_ipaccess);
- my $dom = $env{'user.domain'};
- if ($env{'request.course.id'}) {
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $checkrole = "cm./$cdom/$cnum";
- my $sec = $env{'request.course.sec'};
- if ($sec ne '') {
- $checkrole .= "/$sec";
- }
- if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
- ($env{'request.role'} !~ /^st/)) {
- $has_evb = 1;
- }
- unless ($has_evb) {
- if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
- ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
- if ($udom eq $cdom) {
- $check_ipaccess = 1;
- }
- }
- }
- } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
- ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
- my $checkrole;
- if ($env{'request.role.domain'} eq '') {
- $checkrole = "cm./$env{'user.domain'}/";
- } else {
- $checkrole = "cm./$env{'request.role.domain'}/";
- }
- if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
- $has_evb = 1;
- }
- }
- unless ($has_evb || $check_ipaccess) {
- my @machinedoms = &Apache::lonnet::current_machine_domains();
- if (($dom eq 'public') && ($activity eq 'port')) {
- $dom = $udom;
- }
- if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
- $check_ipaccess = 1;
- } else {
- my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
- my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
- my $prim = &Apache::lonnet::domain($dom,'primary');
- my $intdom = &Apache::lonnet::internet_dom($prim);
- if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
- if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
- $check_ipaccess = 1;
- }
- }
- }
- }
- if ($check_ipaccess) {
- my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
- unless (defined($cached)) {
- my %domconfig =
- &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
- $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
- }
- if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
- foreach my $id (keys(%{$ipaccessref})) {
- if (ref($ipaccessref->{$id}) eq 'HASH') {
- my $range = $ipaccessref->{$id}->{'ip'};
- if ($range) {
- if (&Apache::lonnet::ip_match($clientip,$range)) {
- if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
- if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
- return ('','','',$id,$dom);
- last;
- }
- }
- }
- }
- }
- }
- }
- }
- if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
- return ();
- }
- }
- if (defined($udom) && defined($uname)) {
- # If uname and udom are for a course, check for blocks in the course.
- if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
- my ($startblock,$endblock,$triggerblock) =
- &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
- return ($startblock,$endblock,$triggerblock);
- }
- } else {
+ if (!defined($udom)) {
$udom = $env{'user.domain'};
+ }
+ if (!defined($uname)) {
$uname = $env{'user.name'};
}
+ # If uname and udom are for a course, check for blocks in the course.
+
+ if (&Apache::lonnet::is_course($udom,$uname)) {
+ my ($startblock,$endblock,$triggerblock) =
+ &get_blocks($setters,$activity,$udom,$uname,$url);
+ return ($startblock,$endblock,$triggerblock);
+ }
+
my $startblock = 0;
my $endblock = 0;
my $triggerblock = '';
- my %live_courses;
- unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
- %live_courses = &findallcourses(undef,$uname,$udom);
- }
+ my %live_courses = &findallcourses(undef,$uname,$udom);
# If uname is for a user, and activity is course-specific, i.e.,
# boards, chat or groups, check for blocking in current course only.
if (($activity eq 'boards' || $activity eq 'chat' ||
- $activity eq 'groups' || $activity eq 'printout') &&
- ($env{'request.course.id'})) {
+ $activity eq 'groups') && ($env{'request.course.id'})) {
foreach my $key (keys(%live_courses)) {
if ($key ne $env{'request.course.id'}) {
delete($live_courses{$key});
@@ -4944,7 +4424,7 @@ sub blockcheck {
$tdom,$spec,$trest,$area);
}
}
- my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
+ my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
if ($1) {
$no_userblock = 1;
@@ -4966,11 +4446,11 @@ sub blockcheck {
($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
next if ($no_userblock);
- # Retrieve blocking times and identity of blocker for course
+ # Retrieve blocking times and identity of locker for course
# of specified user, unless user has 'evb' privilege.
my ($start,$end,$trigger) =
- &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
+ &get_blocks($setters,$activity,$cdom,$cnum,$url);
if (($start != 0) &&
(($startblock == 0) || ($startblock > $start))) {
$startblock = $start;
@@ -4990,7 +4470,7 @@ sub blockcheck {
}
sub get_blocks {
- my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
+ my ($setters,$activity,$cdom,$cnum,$url) = @_;
my $startblock = 0;
my $endblock = 0;
my $triggerblock = '';
@@ -5003,13 +4483,7 @@ sub get_blocks {
my $now = time;
my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
if ($activity eq 'docs') {
- my ($blocked,$nosymbcache,$noenccheck);
- if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
- $blocked = 1;
- $nosymbcache = 1;
- $noenccheck = 1;
- }
- @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
+ @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
foreach my $block (@blockers) {
if ($block =~ /^firstaccess____(.+)$/) {
my $item = $1;
@@ -5061,19 +4535,13 @@ sub get_blocks {
my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
if ($start && $end) {
if (($start <= time) && ($end >= time)) {
- if (ref($commblocks{$block}) eq 'HASH') {
- if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
- if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
- unless(grep(/^\Q$block\E$/,@blockers)) {
- push(@blockers,$block);
- $triggered{$block} = {
- start => $start,
- end => $end,
- type => $type,
- };
- }
- }
- }
+ unless (grep(/^\Q$block\E$/,@blockers)) {
+ push(@blockers,$block);
+ $triggered{$block} = {
+ start => $start,
+ end => $end,
+ type => $type,
+ };
}
}
}
@@ -5137,17 +4605,14 @@ sub parse_block_record {
}
sub blocking_status {
- my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
+ my ($activity,$uname,$udom,$url) = @_;
my %setters;
# check for active blocking
- if ($clientip eq '') {
- $clientip = &Apache::lonnet::get_requestor_ip();
- }
- my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
- &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
+ my ($startblock,$endblock,$triggerblock) =
+ &blockcheck(\%setters,$activity,$uname,$udom,$url);
my $blocked = 0;
- if (($startblock && $endblock) || ($by_ip)) {
+ if ($startblock && $endblock) {
$blocked = 1;
}
@@ -5156,17 +4621,12 @@ sub blocking_status {
# build a link to a popup window containing the details
my $querystring = "?activity=$activity";
-# $uname and $udom decide whose portfolio (or information page) the user is trying to look at
- if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
- $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
- $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
+# $uname and $udom decide whose portfolio the user is trying to look at
+ if ($activity eq 'port') {
+ $querystring .= "&udom=$udom" if $udom;
+ $querystring .= "&uname=$uname" if $uname;
} elsif ($activity eq 'docs') {
- my $showurl = &Apache::lonenc::check_encrypt($url);
- $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
- if ($symb) {
- my $showsymb = &Apache::lonenc::check_encrypt($symb);
- $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
- }
+ $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
}
my $output .= <<'END_MYBLOCK';
@@ -5183,27 +4643,13 @@ END_MYBLOCK
my $popupUrl = "/adm/blockingstatus/$querystring";
my $text = &mt('Communication Blocked');
- my $class = 'LC_comblock';
if ($activity eq 'docs') {
$text = &mt('Content Access Blocked');
- $class = '';
} elsif ($activity eq 'printout') {
$text = &mt('Printing Blocked');
- } elsif ($activity eq 'passwd') {
- $text = &mt('Password Changing Blocked');
- } elsif ($activity eq 'grades') {
- $text = &mt('Gradebook Blocked');
- } elsif ($activity eq 'search') {
- $text = &mt('Search Blocked');
- } elsif ($activity eq 'about') {
- $text = &mt('Access to User Information Pages Blocked');
- } elsif ($activity eq 'wishlist') {
- $text = &mt('Access to Stored Links Blocked');
- } elsif ($activity eq 'annotate') {
- $text = &mt('Access to Annotations Blocked');
}
$output .= <<"END_BLOCK";
-
+
@@ -5219,20 +4665,13 @@ END_BLOCK
###############################################
sub check_ip_acc {
- my ($acc,$clientip)=@_;
+ my ($acc)=@_;
&Apache::lonxml::debug("acc is $acc");
if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
return 1;
}
my $allowed=0;
- my $ip;
- if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
- ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
- $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
- } else {
- my $remote_ip = &Apache::lonnet::get_requestor_ip();
- $ip = $remote_ip || $env{'request.host'} || $clientip;
- }
+ my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
my $name;
foreach my $pattern (split(',',$acc)) {
@@ -5328,39 +4767,23 @@ sub get_domainconf {
if (keys(%{$domconfig{'login'}})) {
foreach my $key (keys(%{$domconfig{'login'}})) {
if (ref($domconfig{'login'}{$key}) eq 'HASH') {
- if (($key eq 'loginvia') || ($key eq 'headtag')) {
- if (ref($domconfig{'login'}{$key}) eq 'HASH') {
- foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
- if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
- if ($key eq 'loginvia') {
- if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
- 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'};
- }
+ if ($key eq 'loginvia') {
+ if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
+ foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
+ if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
+ if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
+ 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'};
}
- } elsif ($key eq 'headtag') {
- if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
- $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
+ if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
+ $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
}
}
- if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
- $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
- }
- }
- }
- }
- } elsif ($key eq 'saml') {
- if (ref($domconfig{'login'}{$key}) eq 'HASH') {
- foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
- if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
- $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
- foreach my $item ('text','img','alt','url','title','notsso') {
- $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
- }
}
}
}
@@ -5428,7 +4851,7 @@ sub get_legacy_domconf {
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/'.$udom.'.tab';
if (-e $designfile) {
- if ( open (my $fh,'<',$designfile) ) {
+ if ( open (my $fh,"<$designfile") ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -5468,12 +4891,8 @@ sub domainlogo {
&Apache::lonnet::repcopy($local_name);
}
$imgsrc = &lonhttpdurl($imgsrc);
- }
- my $alttext = $domain;
- if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
- $alttext = $designhash{$domain.'.login.alttext_domlogo'};
- }
- return '
';
+ }
+ return '
';
} elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
return &Apache::lonnet::domain($domain,'description');
} else {
@@ -5683,15 +5102,11 @@ 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
- use_absolute -> for external resource or syllabus, this will
- contain https://
if server uses
- https (as per hosts.tab), but request is for http
- hostname -> hostname, from $r->hostname().
+ inherit_jsmath -> when creating popup window in a page,
+ should it have jsmath forced on by the
+ current page
=item * $advtoolsref, optional argument, ref to an array containing
inlineremote items to be added in "Functions" menu below
@@ -5708,7 +5123,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'))
@@ -5717,7 +5132,6 @@ sub bodytag {
}
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
my $httphost = $args->{'use_absolute'};
- my $hostname = $args->{'hostname'};
$function = &get_users_function() if (!$function);
my $img = &designparm($function.'.img',$domain);
@@ -5733,43 +5147,20 @@ sub bodytag {
@design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
# role and realm
- my ($role,$realm) = split(m{\./},$env{'request.role'},2);
- if ($realm) {
- $realm = '/'.$realm;
- }
- if ($role eq 'ca') {
+ my ($role,$realm) = split(/\./,$env{'request.role'},2);
+ if ($role eq 'ca') {
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
$realm = &plainname($rname,$rdom);
}
# realm
- my ($cid,$sec);
if ($env{'request.course.id'}) {
- $cid = $env{'request.course.id'};
- if ($env{'request.course.sec'}) {
- $sec = $env{'request.course.sec'};
- }
- } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
- if (&Apache::lonnet::is_course($1,$2)) {
- $cid = $1.'_'.$2;
- $sec = $3;
- }
- }
- if ($cid) {
if ($env{'request.role'} !~ /^cr/) {
$role = &Apache::lonnet::plaintext($role,&course_type());
- } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
- if ($env{'request.role.desc'}) {
- $role = $env{'request.role.desc'};
- } else {
- $role = &mt('Helpdesk[_1]',' '.$2);
- }
- } else {
- $role = (split(/\//,$role,4))[-1];
}
- if ($sec) {
- $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
+ if ($env{'request.course.sec'}) {
+ $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
}
- $realm = $env{'course.'.$cid.'.description'};
+ $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
} else {
$role = &Apache::lonnet::plaintext($role);
}
@@ -5780,7 +5171,7 @@ sub bodytag {
# construct main body tag
my $bodytag = "".
- &Apache::lontexconvert::init_math_support();
+ &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
&get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
@@ -5791,36 +5182,22 @@ sub bodytag {
if ($public) {
undef($role);
}
-
+
my $titleinfo = ''.$title.' ';
#
# Extra info if you are the DC
my $dc_info = '';
- if (($env{'user.adv'}) && ($env{'request.course.id'}) &&
- (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
+ if ($env{'user.adv'} && exists($env{'user.role.dc./'.
+ $env{'course.'.$env{'request.course.id'}.
+ '.domain'}.'/'})) {
+ my $cid = $env{'request.course.id'};
$dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info =~ s/\s+$//;
}
- $role = '('.$role.') ' if ($role && !$env{'browser.mobile'});
-
- if ($env{'request.state'} eq 'construct') { $forcereg=1; }
-
+ $role = '('.$role.') ' if $role;
-
- 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;
- }
- } else {
+ 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
@@ -5829,14 +5206,14 @@ sub bodytag {
$bodytag .= Apache::lonhtmlcommon::scripttag(
Apache::lonmenu::utilityfunctions($httphost), 'start');
- my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
+ my ($left,$right) = Apache::lonmenu::primary_menu();
if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
- if ($dc_info) {
- $dc_info = qq|$dc_info |;
- }
- $bodytag .= qq|$left $role
- $realm $dc_info
|;
+ if ($dc_info) {
+ $dc_info = qq|$dc_info |;
+ }
+ $bodytag .= qq|$left $role
+ $realm $dc_info
|;
return $bodytag;
}
@@ -5851,33 +5228,27 @@ 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;
}
#don't show menus for public users
if (!$public){
- $bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'});
+ $bodytag .= Apache::lonmenu::secondary_menu($httphost);
$bodytag .= Apache::lonmenu::serverform();
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
if ($env{'request.state'} eq 'construct') {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,
- $args->{'bread_crumbs'},'','',$hostname);
+ $args->{'bread_crumbs'});
} elsif ($forcereg) {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
- $args->{'group'},
- $args->{'hide_buttons'},
- $hostname);
+ $args->{'group'});
} else {
- my $forbodytag;
- &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
- $forcereg,$args->{'group'},
- $args->{'bread_crumbs'},
- $advtoolsref,'',$hostname,
- \$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
@@ -5887,54 +5258,6 @@ sub bodytag {
}
return $bodytag;
- }
-
-#
-# Top frame rendering, Remote is up
-#
-
- my $imgsrc = $img;
- if ($img =~ /^\/adm/) {
- $imgsrc = &lonhttpdurl($img);
- }
- my $upperleft=' ';
-
- 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
- $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 {
@@ -5966,15 +5289,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;
@@ -6008,6 +5324,7 @@ sub endbodytag {
unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
$endbodytag='';
}
+ $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
if ( exists( $env{'internal.head.redirect'} ) ) {
if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
$endbodytag=
@@ -6016,9 +5333,6 @@ sub endbodytag {
$endbodytag;
}
}
- if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
- $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
- }
return $endbodytag;
}
@@ -6185,17 +5499,6 @@ div.LC_confirm_box .LC_success img {
vertical-align: middle;
}
-.LC_maxwidth {
- max-width: 100%;
- height: auto;
-}
-
-.LC_textsize_mobile {
- \@media only screen and (max-device-width: 480px) {
- -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
- }
-}
-
.LC_icon {
border: none;
vertical-align: middle;
@@ -6317,10 +5620,6 @@ table#LC_menubuttons img {
vertical-align: middle;
}
-.LC_breadcrumbs_hoverable {
- background: $sidebg;
-}
-
td.LC_table_cell_checkbox {
text-align: center;
}
@@ -6391,11 +5690,6 @@ td.LC_menubuttons_text {
background: $tabbg;
}
-td.LC_zero_height {
- line-height: 0;
- cellpadding: 0;
-}
-
table.LC_data_table {
border: 1px solid #000000;
border-collapse: separate;
@@ -6986,8 +6280,7 @@ table.LC_prior_tries td {
padding: 6px;
}
-.LC_answer_unknown,
-.LC_answer_warning {
+.LC_answer_unknown {
background: orange;
color: black;
padding: 6px;
@@ -7069,7 +6362,6 @@ table.LC_data_table tr > td.LC_docs_entr
color: #990000;
}
-.LC_domprefs_email,
.LC_docs_reinit_warn,
.LC_docs_ext_edit {
font-size: x-small;
@@ -7185,7 +6477,7 @@ div.LC_edit_problem_footer,
div.LC_edit_problem_footer div,
div.LC_edit_problem_editxml_header,
div.LC_edit_problem_editxml_header div {
- z-index: 100;
+ margin-top: 5px;
}
div.LC_edit_problem_header_title {
@@ -7201,17 +6493,14 @@ table.LC_edit_problem_header_title {
background: $tabbg;
}
-div.LC_edit_actionbar {
- background-color: $sidebg;
- margin: 0;
- padding: 0;
- line-height: 200%;
+div.LC_edit_problem_discards {
+ float: left;
+ padding-bottom: 5px;
}
-div.LC_edit_actionbar div{
- padding: 0;
- margin: 0;
- display: inline-block;
+div.LC_edit_problem_saves {
+ float: right;
+ padding-bottom: 5px;
}
.LC_edit_opt {
@@ -7227,10 +6516,6 @@ div.LC_edit_actionbar div{
margin-left: 40px;
}
-#LC_edit_problem_codemirror div{
- margin-left: 0px;
-}
-
img.stift {
border-width: 0;
vertical-align: middle;
@@ -7318,10 +6603,6 @@ fieldset {
/* overflow: hidden; */
}
-article.geogebraweb div {
- margin: 0;
-}
-
fieldset > legend {
font-weight: bold;
padding: 0 5px 0 5px;
@@ -7349,6 +6630,7 @@ fieldset > legend {
ol.LC_primary_menu {
margin: 0;
padding: 0;
+ background-color: $pgbg_or_bgcolor;
}
ol#LC_PathBreadcrumbs {
@@ -7360,48 +6642,23 @@ ol.LC_primary_menu li {
vertical-align: middle;
text-align: left;
list-style: none;
- position: relative;
float: left;
- z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
- line-height: 1.5em;
}
-ol.LC_primary_menu li a,
-ol.LC_primary_menu li p {
+ol.LC_primary_menu li a {
display: block;
margin: 0;
padding: 0 5px 0 10px;
text-decoration: none;
}
-ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
- display: inline-block;
- width: 95%;
- text-align: left;
-}
-
-ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
- display: inline-block;
- width: 5%;
- float: right;
- text-align: right;
- font-size: 70%;
-}
-
-ol.LC_primary_menu ul {
+ol.LC_primary_menu li ul {
display: none;
- width: 15em;
+ width: 10em;
background-color: $data_table_light;
- position: absolute;
- top: 100%;
-}
-
-ol.LC_primary_menu ul ul {
- left: 100%;
- top: 0;
}
-ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
+ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
display: block;
position: absolute;
margin: 0;
@@ -7410,21 +6667,15 @@ ol.LC_primary_menu li:hover > ul, ol.LC_
}
ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
-/* First Submenu -> size should be smaller than the menu title of the whole menu */
font-size: 90%;
vertical-align: top;
float: none;
border-left: 1px solid black;
border-right: 1px solid black;
-/* 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;
}
-ol.LC_primary_menu li li p:hover {
- color:$button_hover;
- text-decoration:none;
- background-color:$data_table_dark;
+ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
+ background-color:$data_table_light;
}
ol.LC_primary_menu li li a:hover {
@@ -7432,11 +6683,6 @@ ol.LC_primary_menu li li a:hover {
background-color:$data_table_dark;
}
-/* Font-size equal to the size of the predecessors*/
-ol.LC_primary_menu li:hover li li {
- font-size: 100%;
-}
-
ol.LC_primary_menu li img {
vertical-align: bottom;
height: 1.1em;
@@ -7978,26 +7224,6 @@ ul.LC_funclist li {
cursor:pointer;
}
-.LCisDisabled {
- cursor: not-allowed;
- opacity: 0.5;
-}
-
-a[aria-disabled="true"] {
- color: currentColor;
- display: inline-block; /* For IE11/ MS Edge bug */
- pointer-events: none;
- text-decoration: none;
-}
-
-pre.LC_wordwrap {
- white-space: pre-wrap;
- white-space: -moz-pre-wrap;
- white-space: -pre-wrap;
- white-space: -o-pre-wrap;
- word-wrap: break-word;
-}
-
/*
styles used by TTH when "Default set of options to pass to tth/m
when converting TeX" in course settings has been set
@@ -8019,39 +7245,6 @@ 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;}
-#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
}
@@ -8073,7 +7266,6 @@ Inputs: $title - optional title for the
(side effect of setting
$env{'internal.head.redirect'} to the url
redirected too)
- 4- whether encrypt check should be skipped
domain -> force to color decorate a page for a specific
domain
function -> force usage of a specific rolish color scheme
@@ -8102,16 +7294,13 @@ sub headtag {
''.
&font_settings($args);
- my $inhibitprint;
- if ($args->{'print_suppress'}) {
- $inhibitprint = &print_suppression();
- }
+ my $inhibitprint = &print_suppression();
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'}
@@ -8136,10 +7325,8 @@ sub headtag {
}
}
if (ref($args->{'redirect'})) {
- my ($time,$url,$inhibit_continue,$skip_enc_check) = @{$args->{'redirect'}};
- if (!$skip_enc_check) {
- $url = &Apache::lonenc::check_encrypt($url);
- }
+ my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
+ $url = &Apache::lonenc::check_encrypt($url);
if (!$inhibit_continue) {
$env{'internal.head.redirect'} = $url;
}
@@ -8147,137 +7334,6 @@ sub headtag {
ADDMETA
- } else {
- unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
- my $requrl = $env{'request.uri'};
- if ($requrl eq '') {
- $requrl = $ENV{'REQUEST_URI'};
- $requrl =~ s/\?.+$//;
- }
- unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
- (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
- ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
- my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
- unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
- my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
- my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
- my ($offload,$offloadoth);
- if (ref($domdefs{'offloadnow'}) eq 'HASH') {
- if ($domdefs{'offloadnow'}{$lonhost}) {
- $offload = 1;
- if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
- (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
- unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
- $offloadoth = 1;
- $dom_in_use = $env{'user.domain'};
- }
- }
- }
- }
- unless ($offload) {
- if (ref($domdefs{'offloadoth'}) eq 'HASH') {
- if ($domdefs{'offloadoth'}{$lonhost}) {
- if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
- (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
- unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
- $offload = 1;
- $offloadoth = 1;
- $dom_in_use = $env{'user.domain'};
- }
- }
- }
- }
- }
- if ($offload) {
- my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
- if (($newserver eq '') && ($offloadoth)) {
- my @domains = &Apache::lonnet::current_machine_domains();
- if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
- ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
- }
- }
- if (($newserver) && ($newserver ne $lonhost)) {
- my $numsec = 5;
- my $timeout = $numsec * 1000;
- my ($newurl,$locknum,%locks,$msg);
- if ($env{'request.role.adv'}) {
- ($locknum,%locks) = &Apache::lonnet::get_locks();
- }
- my $disable_submit = 0;
- if ($requrl =~ /$LONCAPA::assess_re/) {
- $disable_submit = 1;
- }
- if ($locknum) {
- my @lockinfo = sort(values(%locks));
- $msg = &mt('Once the following tasks are complete:')." \n".
- join(", ",sort(values(%locks)))."\n";
- if (&show_course()) {
- $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
- } else {
- $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
- }
- } else {
- if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
- $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
- }
- $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
- $newurl = '/adm/switchserver?otherserver='.$newserver;
- if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
- $newurl .= '&role='.$env{'request.role'};
- }
- if ($env{'request.symb'}) {
- my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
- if ($shownsymb =~ m{^/enc/}) {
- my $reqdmajor = 2;
- my $reqdminor = 11;
- my $reqdsubminor = 3;
- my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
- my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
- my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
- if (($major eq '' && $minor eq '') ||
- (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
- (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
- ($reqdsubminor > $subminor))))) {
- undef($shownsymb);
- }
- }
- if ($shownsymb) {
- &js_escape(\$shownsymb);
- $newurl .= '&symb='.$shownsymb;
- }
- } else {
- my $shownurl = &Apache::lonenc::check_encrypt($requrl);
- &js_escape(\$shownurl);
- $newurl .= '&origurl='.$shownurl;
- }
- }
- &js_escape(\$msg);
- $result.=<
-
-OFFLOAD
- }
- }
- }
- }
- }
}
if (!defined($title)) {
$title = 'The LearningOnline Network with CAPA';
@@ -8288,21 +7344,14 @@ OFFLOAD
if (!$args->{'frameset'}) {
$result .= ' /';
}
- $result .= '>'
+ $result .= '>'
.$inhibitprint
.$head_extra;
- my $clientmobile;
- if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
- (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
- } else {
- $clientmobile = $env{'browser.mobile'};
- }
- if ($clientmobile) {
+ if ($env{'browser.mobile'}) {
$result .= '
';
}
- $result .= ' '."\n";
return $result.'';
}
@@ -8321,12 +7370,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;
}
@@ -8371,8 +7420,7 @@ sub print_suppression {
}
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $clientip = &Apache::lonnet::get_requestor_ip();
- my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
+ my $blocked = &blocking_status('printout',$cnum,$cdom);
if ($blocked) {
my $checkrole = "cm./$cdom/$cnum";
if ($env{'request.course.sec'} ne '') {
@@ -8480,22 +7528,14 @@ $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
+ inherit_jsmath -> when creating popup window in a page,
+ should it have jsmath forced on by the
+ current page
bread_crumbs -> Array containing breadcrumbs
bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
- bread_crumbs_nomenu -> if true will pass false as the value of $menulink
- to lonhtmlcommon::breadcrumbs
- group -> includes the current group, if page is for a
- specific group
- use_absolute -> for request for external resource or syllabus, this
- will contain https:// if server uses
- https (as per hosts.tab), but request is for http
- hostname -> hostname, originally from $r->hostname(), (optional).
- links_disabled -> Links in primary and secondary menus are disabled
- (Can enable them once page has loaded - see lonroles.pm
- for an example).
+ group -> includes the current group, if page is for a
+ specific group
=back
@@ -8525,8 +7565,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);
}
}
@@ -8559,24 +7599,13 @@ sub start_page {
if (@advtools > 0) {
&Apache::lonmenu::advtools_crumbs(@advtools);
}
- my $menulink;
- # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
- if (exists($args->{'bread_crumbs_nomenu'})) {
- $menulink = 0;
- } else {
- undef($menulink);
- }
+
#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'},'',$menulink);
+ $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
}else{
- $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
+ $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;
}
@@ -8623,13 +7652,9 @@ function set_wishlistlink(title, path) {
title = document.title;
title = title.replace(/^LON-CAPA /,'');
}
- title = encodeURIComponent(title);
- title = title.replace("'","\\\'");
if (!path) {
path = location.pathname;
}
- path = encodeURIComponent(path);
- path = path.replace("'","\\\'");
Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
'wishlistNewLink','width=560,height=350,scrollbars=0');
}
@@ -8672,13 +7697,12 @@ var modalWindow = {
};
var openMyModal = function(source,width,height,scrolling,transparency,style)
{
- source = source.replace(/'/g,"'");
modalWindow.windowId = "myModal";
modalWindow.width = width;
modalWindow.height = height;
- modalWindow.content = "";
+ modalWindow.content = "
ENDPROGBAR
- } else {
- $starting=&mt('Loading...');
- $LClastpercent='false';
- $content=(<
- $starting
-
-ENDPROGBAR
- }
- &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
+ &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
}
sub LCprogressbarUpdate {
- my ($r,$val,$text,$number_to_do)=@_;
- if ($number_to_do) {
- unless ($val) {
- if ($LClastpercent) {
- $val=$LClastpercent;
- } else {
- $val=0;
- }
- }
- if ($val<0) { $val=0; }
- if ($val>100) { $val=0; }
- $LClastpercent=$val;
- unless ($text) { $text=$val.'%'; }
- } else {
- $val = 'false';
+ my ($r,$val,$text)=@_;
+ unless ($val) {
+ if ($LClastpercent) {
+ $val=$LClastpercent;
+ } else {
+ $val=0;
+ }
}
+ if ($val<0) { $val=0; }
+ if ($val>100) { $val=0; }
+ $LClastpercent=$val;
+ unless ($text) { $text=$val.'%'; }
$text=&js_ready($text);
&r_print($r,<
//
ENDUPDATE
@@ -9328,7 +8304,7 @@ role status: active, previous or future.
sub check_user_status {
my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
- my @uroles = keys(%userinfo);
+ my @uroles = keys %userinfo;
my $srchstr;
my $active_chk = 'none';
my $now = time;
@@ -9417,7 +8393,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();
@@ -9813,8 +8789,8 @@ 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')) {
$defquota = $domdefs{$crstype.'quota'};
}
if ($defquota eq '') {
@@ -9985,10 +8961,10 @@ sub excess_filesize_warning {
}
$disk_quota = int($disk_quota * 1000);
if (($current_disk_usage + $filesize) > $disk_quota) {
- return ''.
+ return '
'.
&mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
- ''.$filename.' ',$filesize).'
'.
- ''.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
+ ''.$filename.' ',$filesize).''.
+ ' '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
$disk_quota,$current_disk_usage).
'
';
}
@@ -9998,6 +8974,8 @@ sub excess_filesize_warning {
###############################################
+
+
sub get_secgrprole_info {
my ($cdom,$cnum,$needroles,$type) = @_;
my %sections_count = &get_sections($cdom,$cnum);
@@ -10036,24 +9014,8 @@ sub get_secgrprole_info {
}
sub user_picker {
- my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
+ my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
my $currdom = $dom;
- my @alldoms = &Apache::lonnet::all_domains();
- if (@alldoms == 1) {
- my %domsrch = &Apache::lonnet::get_dom('configuration',
- ['directorysrch'],$alldoms[0]);
- my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
- my $showdom = $domdesc;
- if ($showdom eq '') {
- $showdom = $dom;
- }
- if (ref($domsrch{'directorysrch'}) eq 'HASH') {
- if ((!$domsrch{'directorysrch'}{'available'}) &&
- ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
- return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
- }
- }
- }
my %curr_selected = (
srchin => 'dom',
srchby => 'lastname',
@@ -10074,7 +9036,7 @@ sub user_picker {
}
$srchterm = $srch->{'srchterm'};
}
- my %html_lt=&Apache::lonlocal::texthash(
+ my %lt=&Apache::lonlocal::texthash(
'usr' => 'Search criteria',
'doma' => 'Domain/institution to search',
'uname' => 'username',
@@ -10087,8 +9049,6 @@ sub user_picker {
'exact' => 'is',
'contains' => 'contains',
'begins' => 'begins with',
- );
- my %js_lt=&Apache::lonlocal::texthash(
'youm' => "You must include some text to search for.",
'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
@@ -10098,16 +9058,7 @@ sub user_picker {
'whse' => "When searching by last,first you must include at least one character in the first name.",
'thfo' => "The following need to be corrected before the search can be run:",
);
- &html_escape(\%html_lt);
- &js_escape(\%js_lt);
- my $domform;
- my $allow_blank = 1;
- if ($fixeddom) {
- $allow_blank = 0;
- $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
- } else {
- $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
- }
+ my $domform = &select_dom_form($currdom,'srchdomain',1,1);
my $srchinsel = ' ';
my @srchins = ('crs','dom','alc','instd');
@@ -10119,13 +9070,12 @@ sub user_picker {
next if ($option eq 'alc');
next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
next if ($option eq 'crs' && !$env{'request.course.id'});
- next if (($option eq 'instd') && ($noinstd));
if ($curr_selected{'srchin'} eq $option) {
$srchinsel .= '
- '.$html_lt{$option}.' ';
+ '.$lt{$option}.' ';
} else {
$srchinsel .= '
- '.$html_lt{$option}.' ';
+ '.$lt{$option}.' ';
}
}
$srchinsel .= "\n \n";
@@ -10134,10 +9084,10 @@ sub user_picker {
foreach my $option ('lastname','lastfirst','uname') {
if ($curr_selected{'srchby'} eq $option) {
$srchbysel .= '
- '.$html_lt{$option}.' ';
+ '.$lt{$option}.' ';
} else {
$srchbysel .= '
- '.$html_lt{$option}.' ';
+ '.$lt{$option}.' ';
}
}
$srchbysel .= "\n \n";
@@ -10146,10 +9096,10 @@ sub user_picker {
foreach my $option ('begins','contains','exact') {
if ($curr_selected{'srchtype'} eq $option) {
$srchtypesel .= '
- '.$html_lt{$option}.' ';
+ '.$lt{$option}.' ';
} else {
$srchtypesel .= '
- '.$html_lt{$option}.' ';
+ '.$lt{$option}.' ';
}
}
$srchtypesel .= "\n \n";
@@ -10234,46 +9184,46 @@ function validateEntry(callingForm) {
if (srchterm == "") {
checkok = 0;
- msg += "$js_lt{'youm'}\\n";
+ msg += "$lt{'youm'}\\n";
}
if (srchtype== 'begins') {
if (srchterm.length < 2) {
checkok = 0;
- msg += "$js_lt{'thte'}\\n";
+ msg += "$lt{'thte'}\\n";
}
}
if (srchtype== 'contains') {
if (srchterm.length < 3) {
checkok = 0;
- msg += "$js_lt{'thet'}\\n";
+ msg += "$lt{'thet'}\\n";
}
}
if (srchin == 'instd') {
if (srchdomain == '') {
checkok = 0;
- msg += "$js_lt{'yomc'}\\n";
+ msg += "$lt{'yomc'}\\n";
}
}
if (srchin == 'dom') {
if (srchdomain == '') {
checkok = 0;
- msg += "$js_lt{'ymcd'}\\n";
+ msg += "$lt{'ymcd'}\\n";
}
}
if (srchby == 'lastfirst') {
if (srchterm.indexOf(",") == -1) {
checkok = 0;
- msg += "$js_lt{'whus'}\\n";
+ msg += "$lt{'whus'}\\n";
}
if (srchterm.indexOf(",") == srchterm.length -1) {
checkok = 0;
- msg += "$js_lt{'whse'}\\n";
+ msg += "$lt{'whse'}\\n";
}
}
if (checkok == 0) {
- alert("$js_lt{'thfo'}\\n"+msg);
+ alert("$lt{'thfo'}\\n"+msg);
return;
}
if (checkok == 1) {
@@ -10291,10 +9241,10 @@ $new_user_create
END_BLOCK
$output .= &Apache::lonhtmlcommon::start_pick_box().
- &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
+ &Apache::lonhtmlcommon::row_title($lt{'doma'}).
$domform.
&Apache::lonhtmlcommon::row_closure().
- &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
+ &Apache::lonhtmlcommon::row_title($lt{'usr'}).
$srchbysel.
$srchtypesel.
' '.
@@ -10302,165 +9252,61 @@ END_BLOCK
&Apache::lonhtmlcommon::row_closure(1).
&Apache::lonhtmlcommon::end_pick_box().
' ';
- return ($output,1);
+ return $output;
}
sub user_rule_check {
my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
- my ($response,%inst_response);
+ my $response;
if (ref($usershash) eq 'HASH') {
- if (keys(%{$usershash}) > 1) {
- my (%by_username,%by_id,%userdoms);
- my $checkid;
- if (ref($checks) eq 'HASH') {
- if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
- $checkid = 1;
- }
- }
- foreach my $user (keys(%{$usershash})) {
- my ($uname,$udom) = split(/:/,$user);
- if ($checkid) {
- if (ref($usershash->{$user}) eq 'HASH') {
- if ($usershash->{$user}->{'id'} ne '') {
- $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
- $userdoms{$udom} = 1;
- if (ref($inst_results) eq 'HASH') {
- $inst_results->{$uname.':'.$udom} = {};
- }
- }
- }
- } else {
- $by_username{$udom}{$uname} = 1;
- $userdoms{$udom} = 1;
- if (ref($inst_results) eq 'HASH') {
- $inst_results->{$uname.':'.$udom} = {};
- }
- }
- }
- foreach my $udom (keys(%userdoms)) {
- if (!$got_rules->{$udom}) {
- my %domconfig = &Apache::lonnet::get_dom('configuration',
- ['usercreation'],$udom);
- if (ref($domconfig{'usercreation'}) eq 'HASH') {
- foreach my $item ('username','id') {
- if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
- $$curr_rules{$udom}{$item} =
- $domconfig{'usercreation'}{$item.'_rule'};
- }
- }
- }
- $got_rules->{$udom} = 1;
- }
+ foreach my $user (keys(%{$usershash})) {
+ my ($uname,$udom) = split(/:/,$user);
+ next if ($udom eq '' || $uname eq '');
+ my ($id,$newuser);
+ if (ref($usershash->{$user}) eq 'HASH') {
+ $newuser = $usershash->{$user}->{'newuser'};
+ $id = $usershash->{$user}->{'id'};
}
- if ($checkid) {
- foreach my $udom (keys(%by_id)) {
- my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
- if ($outcome eq 'ok') {
- foreach my $id (keys(%{$by_id{$udom}})) {
- my $uname = $by_id{$udom}{$id};
- $inst_response{$uname.':'.$udom} = $outcome;
- }
- if (ref($results) eq 'HASH') {
- foreach my $uname (keys(%{$results})) {
- if (exists($inst_response{$uname.':'.$udom})) {
- $inst_response{$uname.':'.$udom} = $outcome;
- $inst_results->{$uname.':'.$udom} = $results->{$uname};
- }
- }
- }
- }
+ my $inst_response;
+ if (ref($checks) eq 'HASH') {
+ if (defined($checks->{'username'})) {
+ ($inst_response,%{$inst_results->{$user}}) =
+ &Apache::lonnet::get_instuser($udom,$uname);
+ } elsif (defined($checks->{'id'})) {
+ ($inst_response,%{$inst_results->{$user}}) =
+ &Apache::lonnet::get_instuser($udom,undef,$id);
}
} else {
- foreach my $udom (keys(%by_username)) {
- my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
- if ($outcome eq 'ok') {
- foreach my $uname (keys(%{$by_username{$udom}})) {
- $inst_response{$uname.':'.$udom} = $outcome;
- }
- if (ref($results) eq 'HASH') {
- foreach my $uname (keys(%{$results})) {
- $inst_results->{$uname.':'.$udom} = $results->{$uname};
- }
- }
- }
- }
+ ($inst_response,%{$inst_results->{$user}}) =
+ &Apache::lonnet::get_instuser($udom,$uname);
+ return;
}
- } elsif (keys(%{$usershash}) == 1) {
- my $user = (keys(%{$usershash}))[0];
- my ($uname,$udom) = split(/:/,$user);
- if (($udom ne '') && ($uname ne '')) {
- if (ref($usershash->{$user}) eq 'HASH') {
- if (ref($checks) eq 'HASH') {
- if (defined($checks->{'username'})) {
- ($inst_response{$user},%{$inst_results->{$user}}) =
- &Apache::lonnet::get_instuser($udom,$uname);
- } elsif (defined($checks->{'id'})) {
- if ($usershash->{$user}->{'id'} ne '') {
- ($inst_response{$user},%{$inst_results->{$user}}) =
- &Apache::lonnet::get_instuser($udom,undef,
- $usershash->{$user}->{'id'});
- } else {
- ($inst_response{$user},%{$inst_results->{$user}}) =
- &Apache::lonnet::get_instuser($udom,$uname);
- }
+ if (!$got_rules->{$udom}) {
+ my %domconfig = &Apache::lonnet::get_dom('configuration',
+ ['usercreation'],$udom);
+ if (ref($domconfig{'usercreation'}) eq 'HASH') {
+ foreach my $item ('username','id') {
+ if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
+ $$curr_rules{$udom}{$item} =
+ $domconfig{'usercreation'}{$item.'_rule'};
}
- } else {
- ($inst_response{$user},%{$inst_results->{$user}}) =
- &Apache::lonnet::get_instuser($udom,$uname);
- return;
- }
- if (!$got_rules->{$udom}) {
- my %domconfig = &Apache::lonnet::get_dom('configuration',
- ['usercreation'],$udom);
- if (ref($domconfig{'usercreation'}) eq 'HASH') {
- foreach my $item ('username','id') {
- if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
- $$curr_rules{$udom}{$item} =
- $domconfig{'usercreation'}{$item.'_rule'};
- }
- }
- }
- $got_rules->{$udom} = 1;
}
}
- } else {
- return;
- }
- } else {
- return;
- }
- foreach my $user (keys(%{$usershash})) {
- my ($uname,$udom) = split(/:/,$user);
- next if (($udom eq '') || ($uname eq ''));
- my $id;
- if (ref($inst_results) eq 'HASH') {
- if (ref($inst_results->{$user}) eq 'HASH') {
- $id = $inst_results->{$user}->{'id'};
- }
- }
- if ($id eq '') {
- if (ref($usershash->{$user})) {
- $id = $usershash->{$user}->{'id'};
- }
+ $got_rules->{$udom} = 1;
}
foreach my $item (keys(%{$checks})) {
if (ref($$curr_rules{$udom}) eq 'HASH') {
if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
if (@{$$curr_rules{$udom}{$item}} > 0) {
- my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
- $$curr_rules{$udom}{$item});
+ my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
if ($rule_check{$rule}) {
$$rulematch{$user}{$item} = $rule;
- if ($inst_response{$user} eq 'ok') {
+ if ($inst_response eq 'ok') {
if (ref($inst_results) eq 'HASH') {
if (ref($inst_results->{$user}) eq 'HASH') {
if (keys(%{$inst_results->{$user}}) == 0) {
$$alerts{$item}{$udom}{$uname} = 1;
- } elsif ($item eq 'id') {
- if ($inst_results->{$user}->{'id'} eq '') {
- $$alerts{$item}{$udom}{$uname} = 1;
- }
}
}
}
@@ -10571,14 +9417,7 @@ sub personal_data_fieldtitles {
sub sorted_inst_types {
my ($dom) = @_;
- my ($usertypes,$order);
- my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
- if (ref($domdefaults{'inststatus'}) eq 'HASH') {
- $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
- $order = $domdefaults{'inststatus'}{'inststatusorder'};
- } else {
- ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
- }
+ my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
my $othertitle = &mt('All users');
if ($env{'request.course.id'}) {
$othertitle = &mt('Any users');
@@ -10599,15 +9438,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'});
@@ -10618,37 +9453,24 @@ 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);
+ push @{$allcourses},$1;
$$LC_code{$1} = $2;
}
}
}
}
-
+
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}) {
- push(@{$allcourses},$sec);
- $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
+ unless (grep/^$sec$/,@{$allcourses}) {
+ push @{$allcourses},$sec;
+ $$LC_code{$sec} = $lc_sec;
}
}
}
@@ -10745,9 +9567,7 @@ reservable_now - ref to hash of student_
Keys in inner hash are:
(a) symb: either blank or symb to which slot use is restricted.
- (b) endreserve: end date of reservation period.
- (c) uniqueperiod: start,end dates when slot is to be uniquely
- selected.
+ (b) endreserve: end date of reservation period.
sorted_future - ref to array of student_schedulable slots reservable in
the future, ordered by start date of reservation period.
@@ -10758,8 +9578,6 @@ future_reservable - ref to hash of stude
Keys in inner hash are:
(a) symb: either blank or symb to which slot use is restricted.
(b) startreserve: start date of reservation period.
- (c) uniqueperiod: start,end dates when slot is to be uniquely
- selected.
=back
@@ -10813,10 +9631,6 @@ sub get_future_slots {
my $startreserve = $slots{$slot}->{'startreserve'};
my $endreserve = $slots{$slot}->{'endreserve'};
my $symb = $slots{$slot}->{'symb'};
- my $uniqueperiod;
- if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
- $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
- }
if (($startreserve < $now) &&
(!$endreserve || $endreserve > $now)) {
my $lastres = $endreserve;
@@ -10825,15 +9639,13 @@ sub get_future_slots {
}
$reservable_now{$slot} = {
symb => $symb,
- endreserve => $lastres,
- uniqueperiod => $uniqueperiod,
+ endreserve => $lastres
};
} elsif (($startreserve > $now) &&
(!$endreserve || $endreserve > $startreserve)) {
$future_reservable{$slot} = {
symb => $symb,
- startreserve => $startreserve,
- uniqueperiod => $uniqueperiod,
+ startreserve => $startreserve
};
}
}
@@ -11014,7 +9826,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'}) {
@@ -11046,18 +9858,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";
}
@@ -11068,15 +9880,7 @@ sub ask_for_embedded_content {
($path) =
($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
}
- if ($toplevel=~/^\/*(uploaded|editupload)/) {
- $fileloc = $toplevel;
- $fileloc=~ s/^\s*(\S+)\s*$/$1/;
- my ($udom,$uname,$fname) =
- ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
- $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
- } else {
- $fileloc = &Apache::lonnet::filelocation('',$toplevel);
- }
+ $fileloc = &Apache::lonnet::filelocation('',$toplevel);
$fileloc =~ s{^/}{};
($filename) = ($fileloc =~ m{.+/([^/]+)$});
$heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
@@ -11136,8 +9940,8 @@ sub ask_for_embedded_content {
my $dirptr = 16384;
foreach my $path (keys(%subdependencies)) {
$currsubfile{$path} = {};
- if (($actionurl eq '/adm/portfolio') ||
- ($actionurl eq '/adm/coursegrp_portfolio')) {
+ if (($actionurl eq '/adm/portfolio') ||
+ ($actionurl eq '/adm/coursegrp_portfolio')) {
my ($sublistref,$listerror) =
&Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
if (ref($sublistref) eq 'ARRAY') {
@@ -11279,7 +10083,7 @@ sub ask_for_embedded_content {
$counter = scalar(keys(%existing));
$numpathchg = scalar(keys(%pathchanges));
return ($output,$counter,$numpathchg,\%existing);
- } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
+ } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
(ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
$counter = scalar(keys(%existing));
$numpathchg = scalar(keys(%pathchanges));
@@ -11508,7 +10312,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.
@@ -11527,7 +10331,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;
@@ -11866,7 +10670,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 {
@@ -11898,7 +10702,7 @@ sub modify_html_refs {
return;
}
}
- if (open(my $fh,'<',$container)) {
+ if (open(my $fh,"<$container")) {
$content = join('', <$fh>);
close($fh);
} else {
@@ -11963,7 +10767,7 @@ sub modify_html_refs {
}
}
} else {
- if (open(my $fh,'>',$container)) {
+ if (open(my $fh,">$container")) {
print $fh $content;
close($fh);
$output = ''.&mt('Updated [quant,_1,reference] in [_2].',
@@ -12001,7 +10805,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{/([^/]+)$});
@@ -12107,11 +10911,11 @@ sub check_for_upload {
if ($currsize < $filesize) {
my $extra = $filesize - $currsize;
if (($current_disk_usage + $extra) > $disk_quota) {
- my $msg = '
'.
+ my $msg = ''.
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
- ''.$fname.' ',$filesize,$currsize).'
'.
- ''.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
- $disk_quota,$current_disk_usage).'
';
+ ''.$fname.' ',$filesize,$currsize).''.
+ ' '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
+ $disk_quota,$current_disk_usage);
return ('will_exceed_quota',$msg);
}
}
@@ -12120,21 +10924,21 @@ sub check_for_upload {
}
}
if (($current_disk_usage + $filesize) > $disk_quota){
- my $msg = ''.
- &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$fname.' ',$filesize).'
'.
- ''.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'
';
+ my $msg = ''.
+ &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$fname.' ',$filesize).' '.
+ ' '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
return ('will_exceed_quota',$msg);
} elsif ($found_file) {
if ($locked_file) {
- my $msg = '';
+ my $msg = '';
$msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].',''.$fname.' ',''.$port_path.$env{'form.currentpath'}.' ');
- $msg .= '
';
+ $msg .= ' ';
$msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.',''.$fname.' ');
return ('file_locked',$msg);
} else {
- my $msg = '';
+ my $msg = '';
$msg .= &mt(' A file by that name: [_1] was found in [_2].',''.$fname.' ',$port_path.$env{'form.currentpath'});
- $msg .= '
';
+ $msg .= '';
return ('existingfile',$msg);
}
}
@@ -12232,7 +11036,7 @@ sub decompress_form {
"$topdir/media/player.swf",
"$topdir/media/swfobject.js",
"$topdir/media/expressInstall.swf");
- my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
+ my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
"$topdir/$topdir.mp4",
"$topdir/$topdir\_config.xml",
"$topdir/$topdir\_controller.swf",
@@ -12254,36 +11058,13 @@ sub decompress_form {
"$topdir/skins/express_show/",
"$topdir/skins/express_show/player-min.css",
"$topdir/skins/express_show/spritesheet.png");
- my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
- "$topdir/$topdir.mp4",
- "$topdir/$topdir\_config.xml",
- "$topdir/$topdir\_controller.swf",
- "$topdir/$topdir\_embed.css",
- "$topdir/$topdir\_First_Frame.png",
- "$topdir/$topdir\_player.html",
- "$topdir/$topdir\_Thumbnails.png",
- "$topdir/playerProductInstall.swf",
- "$topdir/scripts/",
- "$topdir/scripts/config_xml.js",
- "$topdir/scripts/techsmith-smart-player.min.js",
- "$topdir/skins/",
- "$topdir/skins/configuration_express.xml",
- "$topdir/skins/express_show/",
- "$topdir/skins/express_show/spritesheet.min.css",
- "$topdir/skins/express_show/spritesheet.png",
- "$topdir/skins/express_show/techsmith-smart-player.min.css");
my @diffs = &compare_arrays(\@paths,\@camtasia6);
if (@diffs == 0) {
$is_camtasia = 6;
} else {
- @diffs = &compare_arrays(\@paths,\@camtasia8_1);
+ @diffs = &compare_arrays(\@paths,\@camtasia8);
if (@diffs == 0) {
$is_camtasia = 8;
- } else {
- @diffs = &compare_arrays(\@paths,\@camtasia8_4);
- if (@diffs == 0) {
- $is_camtasia = 8;
- }
}
}
}
@@ -12297,6 +11078,7 @@ function camtasiaToggle() {
for (var i=0; i'.&mt('Not extracted.').' '.
- &mt('Unexpected file path.').'
'."\n";
- }
- unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
- return ''.&mt('Not extracted.').' '.
- &mt('Unexpected course context.').'
'."\n";
- }
- unless ($file eq &Apache::lonnet::clean_filename($file)) {
- return ''.&mt('Not extracted.').' '.
- &mt('Filename contained unexpected characters.').'
'."\n";
- }
my ($dir,$error,$warning,$output);
- if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
+ if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
$error = &mt('Filename not a supported archive file type.').
' '.&mt('Filename should end with one of: [_1].',
'.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
@@ -12526,44 +11296,30 @@ sub process_decompression {
}
}
my $numskip = scalar(@to_skip);
- my $numoverwrite = scalar(@to_overwrite);
- if (($numskip) && (!$numoverwrite)) {
+ if (($numskip > 0) &&
+ ($numskip == $env{'form.archive_itemcount'})) {
$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.');
} elsif (!$error) {
my ($decompressed,$display);
- if (($numskip) || ($numoverwrite)) {
+ if ($numskip > 0) {
my $tempdir = time.'_'.$$.int(rand(10000));
mkdir("$dir/$tempdir",0755);
- if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
- ($decompressed,$display) =
- &decompress_uploaded_file($file,"$dir/$tempdir");
- foreach my $item (@to_skip) {
- if (($item ne '') && ($item !~ /\.\./)) {
- if (-f "$dir/$tempdir/$item") {
- unlink("$dir/$tempdir/$item");
- } elsif (-d "$dir/$tempdir/$item") {
- &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
- }
- }
- }
- foreach my $item (@to_overwrite) {
- if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
- if (($item ne '') && ($item !~ /\.\./)) {
- if (-f "$dir/$item") {
- unlink("$dir/$item");
- } elsif (-d "$dir/$item") {
- &File::Path::remove_tree("$dir/$item",{ safe => 1 });
- }
- &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
- }
+ system("mv $dir/$file $dir/$tempdir/$file");
+ ($decompressed,$display) =
+ &decompress_uploaded_file($file,"$dir/$tempdir");
+ foreach my $item (@to_skip) {
+ if (($item ne '') && ($item !~ /\.\./)) {
+ if (-f "$dir/$tempdir/$item") {
+ unlink("$dir/$tempdir/$item");
+ } elsif (-d "$dir/$tempdir/$item") {
+ system("rm -rf $dir/$tempdir/$item");
}
}
- if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
- &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
- }
}
+ system("mv $dir/$tempdir/* $dir");
+ rmdir("$dir/$tempdir");
} else {
($decompressed,$display) =
&decompress_uploaded_file($file,$dir);
@@ -12581,7 +11337,8 @@ 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) ||
+ ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
push(@newitems,$item);
if ($dirptr&$testdir) {
$is_dir{$item} = 1;
@@ -12636,7 +11393,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;
@@ -13066,7 +11823,7 @@ END
sub process_extracted_files {
my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
my $numitems = $env{'form.archive_count'};
- return if ((!$numitems) || ($numitems =~ /\D/));
+ return unless ($numitems);
my @ids=&Apache::lonnet::current_machine_ids();
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
%folders,%containers,%mapinner,%prompttofetch);
@@ -13079,7 +11836,7 @@ sub process_extracted_files {
} else {
$prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
$pathtocheck = "$dir_root/$docudom/$docuname/$destination";
- $dir = "$dir_root/$docudom/$docuname";
+ $dir = "$dir_root/$docudom/$docuname";
}
my $currdir = "$dir_root/$destination";
(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
@@ -13088,7 +11845,7 @@ sub process_extracted_files {
$folders{'0'} = $items[-2];
if ($env{'form.folderpath'} =~ /\:1$/) {
$containers{'0'}='page';
- } else {
+ } else {
$containers{'0'}='sequence';
}
}
@@ -13168,9 +11925,7 @@ sub process_extracted_files {
'.'.$containers{$outer},1,1);
$newseqid{$i} = $newidx;
unless ($errtext) {
- $result .= ''.&mt('Folder: [_1] added to course',
- &HTML::Entities::encode($docstitle,'<>&"'))..
- ' '."\n";
+ $result .= ''.&mt('Folder: [_1] added to course',$docstitle).' '."\n";
}
}
} else {
@@ -13179,49 +11934,38 @@ 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 (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
- mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
- }
- if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
- mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
- }
- if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
- if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
- $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
- unless ($ishome) {
- my $fetch = "$newdest{$i}/$title";
- $fetch =~ s/^\Q$prefix$dir\E//;
- $prompttofetch{$fetch} = 1;
- }
- }
+ if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
+ mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
+ }
+ if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+ mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
+ }
+ if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+ system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
+ $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
+ unless ($ishome) {
+ my $fetch = "$newdest{$i}/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
}
- $LONCAPA::map::resources[$newidx]=
- $docstitle.':'.$url.':false:normal:res';
- push(@LONCAPA::map::order, $newidx);
- my ($outtext,$errtext)=
- &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
- $docuname.'/'.$folders{$outer}.
- '.'.$containers{$outer},1,1);
- unless ($errtext) {
- if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
- $result .= ''.&mt('File: [_1] added to course',
- &HTML::Entities::encode($docstitle,'<>&"')).
- ' '."\n";
- }
+ }
+ $LONCAPA::map::resources[$newidx]=
+ $docstitle.':'.$url.':false:normal:res';
+ push(@LONCAPA::map::order, $newidx);
+ my ($outtext,$errtext)=
+ &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
+ $docuname.'/'.$folders{$outer}.
+ '.'.$containers{$outer},1,1);
+ unless ($errtext) {
+ if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
+ $result .= ''.&mt('File: [_1] added to course',$docstitle).' '."\n";
}
- } else {
- $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
- &HTML::Entities::encode($path,'<>&"')).' ';
}
}
}
}
} else {
- $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
- &HTML::Entities::encode($path,'<>&"')).' ';
+ $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).' ';
}
}
for (my $i=1; $i<=$numitems; $i++) {
@@ -13243,7 +11987,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}}";
@@ -13282,9 +12026,7 @@ sub process_extracted_files {
}
if ($fullpath ne '') {
if (-e "$prefix$path") {
- unless (rename("$prefix$path","$fullpath/$title")) {
- $warning .= &mt('Failed to rename dependency').' ';
- }
+ system("mv $prefix$path $fullpath/$title");
}
if (-e "$fullpath/$title") {
my $showpath;
@@ -13292,27 +12034,22 @@ 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//;
- $prompttofetch{$fetch} = 1;
- }
+ }
+ $result .= ''.&mt('[_1] included as a dependency',$showpath).' '."\n";
+ }
+ unless ($ishome) {
+ my $fetch = "$fullpath/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
}
}
}
} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
$warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
- &HTML::Entities::encode($path,'<>&"'),
- &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
- ' ';
+ $path,$env{'form.archive_content_'.$referrer{$i}}).' ';
}
} else {
- $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
- &HTML::Entities::encode($path)).' ';
+ $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).' ';
}
}
if (keys(%todelete)) {
@@ -13586,15 +12323,12 @@ sub upfile_store {
$env{'form.upfile'}=~s/\n+/\n/gs;
$env{'form.upfile'}=~s/\n+$//gs;
- my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
- '_enroll_'.$env{'request.course.id'}.'_'.
- time.'_'.$$);
- return if ($datatoken eq '');
-
+ my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
+ '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
{
my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';
- if ( open(my $fh,'>',$datafile) ) {
+ if ( open(my $fh,">$datafile") ) {
print $fh $env{'form.upfile'};
close($fh);
}
@@ -13604,22 +12338,21 @@ sub upfile_store {
=pod
-=item * &load_tmp_file($r,$datatoken)
+=item * &load_tmp_file($r)
Load uploaded file from tmp, $r should be the HTTP Request object,
-$datatoken is the name to assign to the temporary file.
+needs $env{'form.datatoken'},
sets $env{'form.upfile'} to the contents of the file
=cut
sub load_tmp_file {
- my ($r,$datatoken) = @_;
- return if ($datatoken eq '');
+ my $r=shift;
my @studentdata=();
{
my $studentfile = $r->dir_config('lonDaemons').
- '/tmp/'.$datatoken.'.tmp';
- if ( open(my $fh,'<',$studentfile) ) {
+ '/tmp/'.$env{'form.datatoken'}.'.tmp';
+ if ( open(my $fh,"<$studentfile") ) {
@studentdata=<$fh>;
close($fh);
}
@@ -13627,14 +12360,6 @@ sub load_tmp_file {
$env{'form.upfile'}=join('',@studentdata);
}
-sub valid_datatoken {
- my ($datatoken) = @_;
- if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
- return $datatoken;
- }
- return;
-}
-
=pod
=item * &upfile_record_sep()
@@ -14075,7 +12800,7 @@ sub DrawBarGraph {
@Labels = @$labels;
} else {
for (my $i=0;$i<@{$Values[0]};$i++) {
- push(@Labels,$i+1);
+ push (@Labels,$i+1);
}
}
#
@@ -14514,20 +13239,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
-
-$requname username of requester (if mailing type is helpdeskmail)
-
-$requdom domain of requester (if mailing type is helpdeskmail)
-
-$reqemail e-mail address of requester (if mailing type is helpdeskmail)
+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.
@@ -14538,11 +13257,11 @@ Returns: comma separated list of address
############################################################
############################################################
sub build_recipient_list {
- my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
+ my ($defmail,$mailing,$defdom,$origmail) = @_;
my @recipients;
- my ($otheremails,$lastresort,$allbcc,$addtext);
+ my $otheremails;
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') {
@@ -14554,183 +13273,14 @@ sub build_recipient_list {
push(@recipients,$addr);
}
}
- }
- $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'};
+ $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
}
}
} elsif ($origmail ne '') {
- $lastresort = $origmail;
- }
- if ($mailing eq 'helpdeskmail') {
- if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
- (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
- my ($inststatus,$inststatus_checked);
- if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
- ($env{'user.domain'} ne 'public')) {
- $inststatus_checked = 1;
- $inststatus = $env{'environment.inststatus'};
- }
- unless ($inststatus_checked) {
- if (($requname ne '') && ($requdom ne '')) {
- if (($requname =~ /^$match_username$/) &&
- ($requdom =~ /^$match_domain$/) &&
- (&Apache::lonnet::domain($requdom))) {
- my $requhome = &Apache::lonnet::homeserver($requname,
- $requdom);
- unless ($requhome eq 'no_host') {
- my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
- $inststatus = $userenv{'inststatus'};
- $inststatus_checked = 1;
- }
- }
- }
- }
- unless ($inststatus_checked) {
- if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
- my %srch = (srchby => 'email',
- srchdomain => $defdom,
- srchterm => $reqemail,
- srchtype => 'exact');
- my %srch_results = &Apache::lonnet::usersearch(\%srch);
- foreach my $uname (keys(%srch_results)) {
- if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
- $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
- $inststatus_checked = 1;
- last;
- }
- }
- unless ($inststatus_checked) {
- my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
- if ($dirsrchres eq 'ok') {
- foreach my $uname (keys(%srch_results)) {
- if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
- $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
- $inststatus_checked = 1;
- last;
- }
- }
- }
- }
- }
- }
- if ($inststatus ne '') {
- foreach my $status (split(/\:/,$inststatus)) {
- if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
- my @contacts = ('adminemail','supportemail');
- foreach my $item (@contacts) {
- if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
- my $addr = $domconfig{'contacts'}{'overrides'}{$status};
- if (!grep(/^\Q$addr\E$/,@recipients)) {
- push(@recipients,$addr);
- }
- }
- }
- $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
- if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
- my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'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'}{'overrides'}{$status}{'include'};
- last;
- }
- }
- }
- }
+ push(@recipients,$origmail);
}
} elsif ($origmail ne '') {
- $lastresort = $origmail;
- }
- if (($mailing eq 'helpdeskmail') && ($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'};
- }
- }
- }
- }
- }
- }
+ push(@recipients,$origmail);
}
if (defined($defmail)) {
if ($defmail ne '') {
@@ -14750,21 +13300,8 @@ sub build_recipient_list {
}
}
}
- if ($mailing eq 'helpdeskmail') {
- if ((!@recipients) && ($lastresort ne '')) {
- push(@recipients,$lastresort);
- }
- } elsif ($lastresort ne '') {
- if (!grep(/^\Q$lastresort\E$/,@recipients)) {
- push(@recipients,$lastresort);
- }
- }
- my $recipientlist = join(',',@recipients);
- if (wantarray) {
- return ($recipientlist,$allbcc,$addtext);
- } else {
- return $recipientlist;
- }
+ my $recipientlist = join(',',@recipients);
+ return $recipientlist;
}
############################################################
@@ -14855,8 +13392,6 @@ jsarray (reference to array of categorie
subcats (reference to hash of arrays containing all subcategories within each
category, -recursive)
-maxd (reference to hash used to hold max depth for all top-level categories).
-
Returns: nothing
Side effects: populates trails and allitems hash references.
@@ -14864,7 +13399,7 @@ Side effects: populates trails and allit
=cut
sub extract_categories {
- my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
+ my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
if (ref($categories) eq 'HASH') {
&gather_categories($categories,$cats,$idx,$jsarray);
if (ref($cats->[0]) eq 'ARRAY') {
@@ -14890,15 +13425,12 @@ sub extract_categories {
if (ref($subcats) eq 'HASH') {
push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
}
- &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
+ &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
}
} else {
if (ref($subcats) eq 'HASH') {
$subcats->{$item} = [];
}
- if (ref($maxd) eq 'HASH') {
- $maxd->{$name} = 1;
- }
}
}
}
@@ -14936,13 +13468,13 @@ Side effects: populates trails and allit
=cut
sub recurse_categories {
- my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
+ my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
my $shallower = $depth - 1;
if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
my $name = $cats->[$depth]{$category}[$k];
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
- my $trailstr = join(' » ',(@{$parents},$category));
+ my $trailstr = join(' -> ',(@{$parents},$category));
if ($allitems->{$item} eq '') {
push(@{$trails},$trailstr);
$allitems->{$item} = scalar(@{$trails})-1;
@@ -14963,21 +13495,16 @@ sub recurse_categories {
}
}
&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
- $subcats,$maxd);
+ $subcats);
pop(@{$parents});
}
} else {
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
- my $trailstr = join(' » ',(@{$parents},$category));
+ my $trailstr = join(' -> ',(@{$parents},$category));
if ($allitems->{$item} eq '') {
push(@{$trails},$trailstr);
$allitems->{$item} = scalar(@{$trails})-1;
}
- if (ref($maxd) eq 'HASH') {
- if ($depth > $maxd->{$parents->[0]}) {
- $maxd->{$parents->[0]} = $depth;
- }
- }
}
return;
}
@@ -14998,19 +13525,16 @@ currcat - scalar with an & separated lis
type - scalar contains course type (Course or Community).
-disabled - scalar (optional) contains disabled="disabled" if input elements are
- to be readonly (e.g., Domain Helpdesk role viewing course settings).
-
Returns: $output (markup to be displayed)
=cut
sub assign_categories_table {
- my ($cathash,$currcat,$type,$disabled) = @_;
+ my ($cathash,$currcat,$type) = @_;
my $output;
if (ref($cathash) eq 'HASH') {
- my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
- &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
+ my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
+ &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
$maxdepth = scalar(@cats);
if (@cats > 0) {
my $itemcount = 0;
@@ -15042,11 +13566,11 @@ sub assign_categories_table {
}
$table .= ''.
' '.$parent_title.' '.
+ $item.'"'.$checked.' />'.$parent_title.''.
' ';
my $depth = 1;
push(@path,$parent);
- $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
+ $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
pop(@path);
$table .= ' ';
$itemcount ++;
@@ -15085,15 +13609,12 @@ path - Array containing all categories b
currcategories - reference to array of current categories assigned to the course
-disabled - scalar (optional) contains disabled="disabled" if input elements are
- to be readonly (e.g., Domain Helpdesk role viewing course settings).
-
Returns: $output (markup to be displayed).
=cut
sub assign_category_rows {
- my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
+ my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
my ($text,$name,$item,$chgstr);
if (ref($cats) eq 'ARRAY') {
my $maxdepth = scalar(@{$cats});
@@ -15116,12 +13637,12 @@ sub assign_category_rows {
}
$text .= ''.
' '.$name.' '.
+ $item.'"'.$checked.' />'.$name.''.
' '.
'';
if (ref($path) eq 'ARRAY') {
push(@{$path},$name);
- $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
+ $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
pop(@{$path});
}
$text .= ' ';
@@ -15133,12 +13654,6 @@ sub assign_category_rows {
return $text;
}
-=pod
-
-=back
-
-=cut
-
############################################################
############################################################
@@ -15220,8 +13735,7 @@ sub commit_studentrole {
}
$oldsecurl = $uurl;
$expire_role_result =
- &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,
- '','','',$context);
+ &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
if ($env{'request.course.sec'} ne '') {
if ($expire_role_result eq 'refused') {
my @roles = ('st');
@@ -15270,7 +13784,7 @@ sub commit_studentrole {
}
}
} else {
- if ($secchange) {
+ if ($secchange) {
$$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
} else {
$$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
@@ -15353,95 +13867,37 @@ sub check_clone {
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 {
- my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
+ my %clonehash = &Apache::lonnet::get('environment',['cloners'],
$args->{'clonedomain'},$args->{'clonecourse'});
- if ($clonehash{'cloners'} eq '') {
- my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
- if ($domdefs{'canclone'}) {
- unless ($domdefs{'canclone'} eq 'none') {
- if ($domdefs{'canclone'} eq 'domain') {
- if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
- $can_clone = 1;
- }
- } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
- ($args->{'clonedomain'} eq $args->{'course_domain'})) {
- if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
- $clonehash{'internal.coursecode'},$args->{'crscode'})) {
- $can_clone = 1;
- }
- }
- }
- }
+ my @cloners = split(/,/,$clonehash{'cloners'});
+ if (grep(/^\*$/,@cloners)) {
+ $can_clone = 1;
+ } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
+ $can_clone = 1;
} else {
- my @cloners = split(/,/,$clonehash{'cloners'});
- if (grep(/^\*$/,@cloners)) {
- $can_clone = 1;
- } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
- $can_clone = 1;
- } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
- $can_clone = 1;
- }
- unless ($can_clone) {
- if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
- ($args->{'clonedomain'} eq $args->{'course_domain'})) {
- my (%gotdomdefaults,%gotcodedefaults);
- foreach my $cloner (@cloners) {
- if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
- ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
- my (%codedefaults,@code_order);
- if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
- if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
- %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
- }
- if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
- @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
- }
- } else {
- &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
- \%codedefaults,
- \@code_order);
- $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
- $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
- }
- if (@code_order > 0) {
- if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
- $cloner,$clonehash{'internal.coursecode'},
- $args->{'crscode'})) {
- $can_clone = 1;
- last;
- }
- }
- }
- }
- }
- }
- }
- unless ($can_clone) {
my $ccrole = 'cc';
if ($args->{'crstype'} eq 'Community') {
$ccrole = 'co';
}
- my %roleshash =
- &Apache::lonnet::get_my_roles($args->{'ccuname'},
- $args->{'ccdomain'},
- 'userroles',['active'],[$ccrole],
- [$args->{'clonedomain'}]);
- if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
+ my %roleshash =
+ &Apache::lonnet::get_my_roles($args->{'ccuname'},
+ $args->{'ccdomain'},
+ 'userroles',['active'],[$ccrole],
+ [$args->{'clonedomain'}]);
+ if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
$can_clone = 1;
- } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
- $args->{'ccuname'},$args->{'ccdomain'})) {
+ } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
$can_clone = 1;
- }
- }
- unless ($can_clone) {
- if ($args->{'crstype'} eq 'Community') {
- $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
} else {
- $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ if ($args->{'crstype'} eq 'Community') {
+ $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ } else {
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ }
}
}
}
@@ -15450,8 +13906,7 @@ sub check_clone {
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
- $cnum,$category,$coderef) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
my $outcome;
my $linefeed = ' '."\n";
if ($context eq 'auto') {
@@ -15548,11 +14003,9 @@ sub construct_course {
'plc.users.denied',
'hidefromcat',
'checkforpriv',
- 'categories'],
+ 'categories',
+ 'internal.uniquecode'],
$$crsudom,$$crsunum);
- if ($args->{'textbook'}) {
- $cenv{'internal.textbook'} = $args->{'textbook'};
- }
}
#
@@ -15584,7 +14037,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/,/) {
@@ -15598,12 +14050,8 @@ 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 {
- push(@badclasses,$class);
+ unless ($addcheck eq 'ok') {
+ push @badclasses, $class;
}
}
$cenv{'internal.sectionnums'} =~ s/,$//;
@@ -15630,12 +14078,8 @@ 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 {
- push(@badclasses,$xl);
+ unless ($addcheck eq 'ok') {
+ push @badclasses, $xl;
}
}
$cenv{'internal.crosslistings'} =~ s/,$//;
@@ -15670,63 +14114,32 @@ 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.',
- '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.',
+ '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'
);
- 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'};
+ my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
+ ' ('.$lt{'adby'}.')';
if ($context eq 'auto') {
$outcome .= $badclass_msg.$linefeed;
- } else {
$outcome .= ''.$badclass_msg.$linefeed.'
'."\n";
- }
- foreach my $item (@badclasses) {
+ foreach my $item (@badclasses) {
+ if ($context eq 'auto') {
+ $outcome .= " - $item\n";
+ } else {
+ $outcome .= "$item \n";
+ }
+ }
if ($context eq 'auto') {
- $outcome .= " - $item\n";
+ $outcome .= $linefeed;
} else {
- $outcome .= "$item \n";
+ $outcome .= " \n";
}
- }
- if ($context eq 'auto') {
- $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'};
@@ -15754,9 +14167,6 @@ sub construct_course {
if ($args->{'setcontent'}) {
$cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
}
- if ($args->{'setcomment'}) {
- $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
- }
}
if ($args->{'reshome'}) {
$cenv{'reshome'}=$args->{'reshome'}.'/';
@@ -15791,7 +14201,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;
}
@@ -15828,17 +14238,12 @@ sub construct_course {
# Open all assignments
#
if ($args->{'openall'}) {
- my $opendate = time;
- if ($args->{'openallfrom'} =~ /^\d+$/) {
- $opendate = $args->{'openallfrom'};
- }
my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
- my %storecontent = ($storeunder => $opendate,
+ my %storecontent = ($storeunder => time,
$storeunder.'.type' => 'date_start');
- $outcome .= &mt('All assignments open starting [_1]',
- &Apache::lonlocal::locallocaltime($opendate)).': '.
- &Apache::lonnet::cput
- ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
+
+ $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
+ ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
}
#
# Set first page
@@ -15881,7 +14286,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;
@@ -16018,7 +14423,7 @@ sub escape_url {
my ($url) = @_;
my @urlslices = split(/\//, $url,-1);
my $lastitem = &escape(pop(@urlslices));
- return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
+ return join('/',@urlslices).'/'.$lastitem;
}
sub compare_arrays {
@@ -16037,24 +14442,6 @@ sub compare_arrays {
return @difference;
}
-sub lon_status_items {
- my %defaults = (
- E => 100,
- W => 4,
- N => 1,
- U => 5,
- threshold => 200,
- sysmail => 2500,
- );
- my %names = (
- E => 'Errors',
- W => 'Warnings',
- N => 'Notices',
- U => 'Unsent',
- );
- return (\%defaults,\%names);
-}
-
# -------------------------------------------------------- Initialize user login
sub init_user_environment {
my ($r, $username, $domain, $authhost, $form, $args) = @_;
@@ -16090,37 +14477,10 @@ sub init_user_environment {
opendir(DIR,$lonids);
while ($filename=readdir(DIR)) {
if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
- if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
- &GDBM_READER(),0640)) {
- my $linkedfile;
- if (exists($oldenv{'user.linkedenv'})) {
- $linkedfile = $oldenv{'user.linkedenv'};
- }
- untie(%oldenv);
- if (unlink("$lonids/$filename")) {
- if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
- if (-l "$lonids/$linkedfile.id") {
- unlink("$lonids/$linkedfile.id");
- }
- }
- }
- } else {
- unlink($lonids.'/'.$filename);
- }
+ unlink($lonids.'/'.$filename);
}
}
closedir(DIR);
-# If there is a undeleted lockfile for the user's paste buffer remove it.
- my $namespace = 'nohist_courseeditor';
- my $lockingkey = 'paste'."\0".'locked_num';
- my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
- $domain,$username);
- if (exists($lockhash{$lockingkey})) {
- my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
- unless ($delresult eq 'ok') {
- &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
- }
- }
}
# Give them a new cookie
my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
@@ -16134,8 +14494,8 @@ sub init_user_environment {
}
# ------------------------------------ Check browser type and MathML capability
- my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
- $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
+ my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
+ $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
# ------------------------------------------------------------- Get environment
@@ -16157,7 +14517,6 @@ sub init_user_environment {
# --------------------------------------------------------- Write first profile
{
- my $ip = &Apache::lonnet::get_requestor_ip();
my %initial_env =
("user.name" => $username,
"user.domain" => $domain,
@@ -16169,14 +14528,13 @@ sub init_user_environment {
"browser.os" => $clientos,
"browser.mobile" => $clientmobile,
"browser.info" => $clientinfo,
- "browser.osversion" => $clientosversion,
"server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
"request.course.fn" => '',
"request.course.uri" => '',
"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'};
@@ -16195,44 +14553,36 @@ 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') {
- my %is_adv = ( is_adv => $env{'user.adv'} );
- my %domdef = &Apache::lonnet::get_domain_defaults($domain);
-
- foreach my $tool ('aboutme','blog','webdav','portfolio') {
- $userenv{'availabletools.'.$tool} =
- &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
- undef,\%userenv,\%domdef,\%is_adv);
- }
+ %domdef = &Apache::lonnet::get_domain_defaults($domain);
+ }
- foreach my $crstype ('official','unofficial','community','textbook') {
- $userenv{'canrequest.'.$crstype} =
- &Apache::lonnet::usertools_access($username,$domain,$crstype,
- 'reload','requestcourses',
- \%userenv,\%domdef,\%is_adv);
- }
+ foreach my $tool ('aboutme','blog','webdav','portfolio') {
+ $userenv{'availabletools.'.$tool} =
+ &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
+ undef,\%userenv,\%domdef,\%is_adv);
+ }
- $userenv{'canrequest.author'} =
- &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
- 'reload','requestauthor',
+ foreach my $crstype ('official','unofficial','community','textbook') {
+ $userenv{'canrequest.'.$crstype} =
+ &Apache::lonnet::usertools_access($username,$domain,$crstype,
+ 'reload','requestcourses',
\%userenv,\%domdef,\%is_adv);
- my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
- $domain,$username);
- my $reqstatus = $reqauthor{'author_status'};
- if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
- if (ref($reqauthor{'author'}) eq 'HASH') {
- $userenv{'requestauthorqueued'} = $reqstatus.':'.
- $reqauthor{'author'}{'timestamp'};
- }
+ }
+
+ $userenv{'canrequest.author'} =
+ &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
+ 'reload','requestauthor',
+ \%userenv,\%domdef,\%is_adv);
+ my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
+ $domain,$username);
+ my $reqstatus = $reqauthor{'author_status'};
+ if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
+ if (ref($reqauthor{'author'}) eq 'HASH') {
+ $userenv{'requestauthorqueued'} = $reqstatus.':'.
+ $reqauthor{'author'}{'timestamp'};
}
}
@@ -16320,745 +14670,36 @@ sub clean_symb {
return ($symb,$enc);
}
-############################################################
-############################################################
-
-=pod
-
-=head1 Routines for building display used to search for courses
-
-
-=over 4
-
-=item * &build_filters()
-
-Create markup for a table used to set filters to use when selecting
-courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
-and quotacheck.pl
-
-
-Inputs:
-
-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").
-
-multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
-
-filter - anonymous hash of criteria and their values
-
-action - form action
-
-numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
-
-caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
-
-cloneruname - username of owner of new course who wants to clone
-
-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)
-
-codetitlesref - reference to array of titles of components in institutional codes (official courses)
-
-codedom - domain
-
-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
-
-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
-
-cdomelement - name of form element in form on opener page which will receive domain of selected course
-
-setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
-
-clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
-
-clonewarning - warning message about missing information for intended course owner when DC creates a course
-
-
-Returns: $output - HTML for display of search criteria, and hidden form elements.
-
-
-Side Effects: None
-
-=cut
-
-# ---------------------------------------------- search for courses based on last activity etc.
-
-sub build_filters {
- my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
- $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
- $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
- $cnameelement,$cnumelement,$cdomelement,$setroles,
- $clonetext,$clonewarning) = @_;
- my ($list,$jscript);
- my $onchange = 'javascript:updateFilters(this)';
- my ($domainselectform,$sincefilterform,$createdfilterform,
- $ownerdomselectform,$persondomselectform,$instcodeform,
- $typeselectform,$instcodetitle);
- if ($formname eq '') {
- $formname = $caller;
- }
- foreach my $item (@{$filterlist}) {
- unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
- ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
- if ($item eq 'domainfilter') {
- $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
- } elsif ($item eq 'coursefilter') {
- $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
- } elsif ($item eq 'ownerfilter') {
- $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
- } elsif ($item eq 'ownerdomfilter') {
- $filter->{'ownerdomfilter'} =
- &LONCAPA::clean_domain($filter->{$item});
- $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
- 'ownerdomfilter',1);
- } elsif ($item eq 'personfilter') {
- $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
- } elsif ($item eq 'persondomfilter') {
- $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
- 'persondomfilter',1);
- } else {
- $filter->{$item} =~ s/\W//g;
- }
- if (!$filter->{$item}) {
- $filter->{$item} = '';
- }
- }
- if ($item eq 'domainfilter') {
- my $allow_blank = 1;
- if ($formname eq 'portform') {
- $allow_blank=0;
- } elsif ($formname eq 'studentform') {
- $allow_blank=0;
- }
- if ($fixeddom) {
- $domainselectform = ' '.
- &Apache::lonnet::domain($codedom,'description');
+sub build_release_hashes {
+ my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
+ return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
+ (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
+ (ref($randomizetry) eq 'HASH'));
+ foreach my $key (keys(%Apache::lonnet::needsrelease)) {
+ my ($item,$name,$value) = split(/:/,$key);
+ if ($item eq 'parameter') {
+ if (ref($checkparms->{$name}) eq 'ARRAY') {
+ unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
+ push(@{$checkparms->{$name}},$value);
+ }
} else {
- $domainselectform = &select_dom_form($filter->{$item},
- 'domainfilter',
- $allow_blank,'',$onchange);
+ push(@{$checkparms->{$name}},$value);
}
- } else {
- $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
- }
- }
-
- # last course activity filter and selection
- $sincefilterform = &timebased_select_form('sincefilter',$filter);
-
- # course created filter and selection
- if (exists($filter->{'createdfilter'})) {
- $createdfilterform = &timebased_select_form('createdfilter',$filter);
- }
-
- my %lt = &Apache::lonlocal::texthash(
- 'cac' => "$crstype Activity",
- 'ccr' => "$crstype Created",
- 'cde' => "$crstype Title",
- 'cdo' => "$crstype Domain",
- 'ins' => 'Institutional Code',
- 'inc' => 'Institutional Categorization',
- 'cow' => "$crstype Owner/Co-owner",
- 'cop' => "$crstype Personnel Includes",
- 'cog' => 'Type',
- );
-
- if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
- my $typeval = 'Course';
- if ($crstype eq 'Community') {
- $typeval = 'Community';
- }
- $typeselectform = ' ';
- } else {
- $typeselectform = '".&mt($posstype)."\n";
- }
- $typeselectform.=" ";
- }
-
- my ($cloneableonlyform,$cloneabletitle);
- if (exists($filter->{'cloneableonly'})) {
- my $cloneableon = '';
- my $cloneableoff = ' checked="checked"';
- if ($filter->{'cloneableonly'}) {
- $cloneableon = $cloneableoff;
- $cloneableoff = '';
- }
- $cloneableonlyform = ' '.&mt('Required').' '.(' 'x3).' '.&mt('No restriction').' ';
- if ($formname eq 'ccrs') {
- $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
- } else {
- $cloneabletitle = &mt('Cloneable by you');
- }
- }
- my $officialjs;
- if ($crstype eq 'Course') {
- if (exists($filter->{'instcodefilter'})) {
-# if (($fixeddom) || ($formname eq 'requestcrs') ||
-# ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
- if ($codedom) {
- $officialjs = 1;
- ($instcodeform,$jscript,$$numtitlesref) =
- &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
- $officialjs,$codetitlesref);
- if ($jscript) {
- $jscript = ''."\n";
- }
- }
- if ($instcodeform eq '') {
- $instcodeform =
- ' ';
- $instcodetitle = $lt{'ins'};
- } else {
- $instcodetitle = $lt{'inc'};
+ } elsif ($item eq 'resourcetag') {
+ if ($name eq 'responsetype') {
+ $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
}
- if ($fixeddom) {
- $instcodetitle .= ' ('.$codedom.')';
+ } elsif ($item eq 'course') {
+ if ($name eq 'crstype') {
+ $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
}
}
}
- my $output = qq|
-'."\n".' '."\n";
- return $jscript.$clonewarning.$output;
-}
-
-=pod
-
-=item * &timebased_select_form()
-
-Create markup for a dropdown list used to select a time-based
-filter e.g., Course Activity, Course Created, when searching for courses
-or communities
-
-Inputs:
-
-item - name of form element (sincefilter or createdfilter)
-
-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.
-
-Side Effects: None
-
-=cut
-
-sub timebased_select_form {
- my ($item,$filter) = @_;
- if (ref($filter) eq 'HASH') {
- $filter->{$item} =~ s/[^\d-]//g;
- if (!$filter->{$item}) { $filter->{$item}=-1; }
- return &select_form(
- $filter->{$item},
- $item,
- { '-1' => '',
- '86400' => &mt('today'),
- '604800' => &mt('last week'),
- '2592000' => &mt('last month'),
- '7776000' => &mt('last three months'),
- '15552000' => &mt('last six months'),
- '31104000' => &mt('last year'),
- 'select_form_order' =>
- ['-1','86400','604800','2592000','7776000',
- '15552000','31104000']});
- }
-}
-
-=pod
-
-=item * &js_changer()
-
-Create script tag containing Javascript used to submit course search form
-when course type or domain is changed, and also to hide 'Searching ...' on
-page load completion for page showing search result.
-
-Inputs: None
-
-Returns: markup containing updateFilters() and hideSearching() javascript functions.
-
-Side Effects: None
-
-=cut
-
-sub js_changer {
- return <
-// {major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
+ ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
return;
}
-// ]]>
-
-
-ENDJS
-}
-
-=pod
-
-=item * &search_courses()
-
-Process selected filters form course search form and pass to lonnet::courseiddump
-to retrieve a hash for which keys are courseIDs which match the selected filters.
-
-Inputs:
-
-dom - domain being searched
-
-type - course type ('Course' or 'Community' or '.' if any).
-
-filter - anonymous hash of criteria and their values
-
-numtitles - for institutional codes - number of categories
-
-cloneruname - optional username of new course owner
-
-clonerudom - optional domain of new course owner
-
-domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
- (used when DC is using course creation form)
-
-codetitles - reference to array of titles of components in institutional codes (official courses).
-
-cc_clone - escaped comma separated list of courses for which course cloner has active CC role
- (and so can clone automatically)
-
-reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
-
-reqinstcode - institutional code of new course, where search_courses is used to identify potential
- courses to clone
-
-Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
-
-
-Side Effects: None
-
-=cut
-
-
-sub search_courses {
- my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
- $cc_clone,$reqcrsdom,$reqinstcode) = @_;
- my (%courses,%showcourses,$cloner);
- if (($filter->{'ownerfilter'} ne '') ||
- ($filter->{'ownerdomfilter'} ne '')) {
- $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
- $filter->{'ownerdomfilter'};
- }
- foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
- if (!$filter->{$item}) {
- $filter->{$item}='.';
- }
- }
- my $now = time;
- my $timefilter =
- ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
- my ($createdbefore,$createdafter);
- if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
- $createdbefore = $now;
- $createdafter = $now-$filter->{'createdfilter'};
- }
- my ($instcodefilter,$regexpok);
- if ($numtitles) {
- if ($env{'form.official'} eq 'on') {
- $instcodefilter =
- &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
- $regexpok = 1;
- } elsif ($env{'form.official'} eq 'off') {
- $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
- unless ($instcodefilter eq '') {
- $regexpok = -1;
- }
- }
- } else {
- $instcodefilter = $filter->{'instcodefilter'};
- }
- if ($instcodefilter eq '') { $instcodefilter = '.'; }
- if ($type eq '') { $type = '.'; }
-
- if (($clonerudom ne '') && ($cloneruname ne '')) {
- $cloner = $cloneruname.':'.$clonerudom;
- }
- %courses = &Apache::lonnet::courseiddump($dom,
- $filter->{'descriptfilter'},
- $timefilter,
- $instcodefilter,
- $filter->{'combownerfilter'},
- $filter->{'coursefilter'},
- undef,undef,$type,$regexpok,undef,undef,
- undef,undef,$cloner,$cc_clone,
- $filter->{'cloneableonly'},
- $createdbefore,$createdafter,undef,
- $domcloner,undef,$reqcrsdom,$reqinstcode);
- if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
- my $ccrole;
- if ($type eq 'Community') {
- $ccrole = 'co';
- } else {
- $ccrole = 'cc';
- }
- my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
- $filter->{'persondomfilter'},
- 'userroles',undef,
- [$ccrole,'in','ad','ep','ta','cr'],
- $dom);
- foreach my $role (keys(%rolehash)) {
- my ($cnum,$cdom,$courserole) = split(':',$role);
- my $cid = $cdom.'_'.$cnum;
- if (exists($courses{$cid})) {
- 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);
- }
- } else {
- $courses{$cid}{roles} = [$courserole];
- }
- $showcourses{$cid} = $courses{$cid};
- }
- }
- }
- %courses = %showcourses;
- }
- return %courses;
-}
-
-=pod
-
-=back
-
-=head1 Routines for version requirements for current course.
-
-=over 4
-
-=item * &check_release_required()
-
-Compares required LON-CAPA version with version on server, and
-if required version is newer looks for a server with the required version.
-
-Looks first at servers in user's owen domain; if none suitable, looks at
-servers in course's domain are permitted to host sessions for user's domain.
-
-Inputs:
-
-$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
-
-$courseid - Course ID of current course
-
-$rolecode - User's current role in course (for switchserver query string).
-
-$required - LON-CAPA version needed by course (format: Major.Minor).
-
-
-Returns:
-
-$switchserver - query string tp append to /adm/switchserver call (if
- current server's LON-CAPA version is too old.
-
-$warning - Message is displayed if no suitable server could be found.
-
-=cut
-
-sub check_release_required {
- my ($loncaparev,$courseid,$rolecode,$required) = @_;
- my ($switchserver,$warning);
- if ($required ne '') {
- my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
- my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
- if ($reqdmajor ne '' && $reqdminor ne '') {
- my $otherserver;
- if (($major eq '' && $minor eq '') ||
- (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
- my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
- my $switchlcrev =
- &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
- $userdomserver);
- my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
- if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
- (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
- my $cdom = $env{'course.'.$courseid.'.domain'};
- if ($cdom ne $env{'user.domain'}) {
- my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
- my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
- my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
- my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
- my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
- my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
- my $canhost =
- &Apache::lonnet::can_host_session($env{'user.domain'},
- $coursedomserver,
- $remoterev,
- $udomdefaults{'remotesessions'},
- $defdomdefaults{'hostedsessions'});
-
- if ($canhost) {
- $otherserver = $coursedomserver;
- } else {
- $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).' '. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
- }
- } else {
- $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).' '.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
- }
- } else {
- $otherserver = $userdomserver;
- }
- }
- if ($otherserver ne '') {
- $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
- }
- }
- }
- return ($switchserver,$warning);
-}
-
-=pod
-
-=item * &check_release_result()
-
-Inputs:
-
-$switchwarning - Warning message if no suitable server found to host session.
-
-$switchserver - query string to append to /adm/switchserver containing lonHostID
- and current role.
-
-Returns: HTML to display with information about requirement to switch server.
- Either displaying warning with link to Roles/Courses screen or
- display link to switchserver.
-
-=cut
-
-sub check_release_result {
- my ($switchwarning,$switchserver) = @_;
- my $output = &start_page('Selected course unavailable on this server').
- '';
- if ($switchwarning) {
- $output .= $switchwarning.'';
- if (&show_course()) {
- $output .= &mt('Display courses');
- } else {
- $output .= &mt('Display roles');
- }
- $output .= ' ';
- } elsif ($switchserver) {
- $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
- ' '.
- ''.
- &mt('Switch Server').
- ' ';
- }
- $output .= '
'.&end_page();
- return $output;
-}
-
-=pod
-
-=item * &needs_coursereinit()
-
-Determine if course contents stored for user's session needs to be
-refreshed, because content has changed since "Big Hash" last tied.
-
-Check for change is made if time last checked is more than 10 minutes ago
-(by default).
-
-Inputs:
-
-$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
-
-$interval (optional) - Time which may elapse (in s) between last check for content
- change in current course. (default: 600 s).
-
-Returns: an array; first element is:
-
-=over 4
-
-'switch' - if content updates mean user's session
- needs to be switched to a server running a newer LON-CAPA version
-
-'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
- on current server hosting user's session
-
-'' - if no action required.
-
-=back
-
-If first item element is 'switch':
-
-second item is $switchwarning - Warning message if no suitable server found to host session.
-
-third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
- and current role.
-
-otherwise: no other elements returned.
-
-=back
-
-=cut
-
-sub needs_coursereinit {
- my ($loncaparev,$interval) = @_;
- return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $now = time;
- if ($interval eq '') {
- $interval = 600;
- }
- if (($now-$env{'request.course.timechecked'})>$interval) {
- my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
- &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
- if ($lastchange > $env{'request.course.tied'}) {
- my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
- if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
- my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
- if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
- &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
- $curr_reqd_hash{'internal.releaserequired'}});
- my ($switchserver,$switchwarning) =
- &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
- $curr_reqd_hash{'internal.releaserequired'});
- if ($switchwarning ne '' || $switchserver ne '') {
- return ('switch',$switchwarning,$switchserver);
- }
- }
- }
- return ('update');
- }
- }
- return ();
-}
-
sub update_content_constraints {
my ($cdom,$cnum,$chome,$cid) = @_;
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
@@ -17152,12 +14793,9 @@ sub recurse_supplemental {
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')) {
if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
@@ -17173,8 +14811,8 @@ sub recurse_supplemental {
}
sub symb_to_docspath {
- my ($symb,$navmapref) = @_;
- return unless ($symb && ref($navmapref));
+ my ($symb) = @_;
+ return unless ($symb);
my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
if ($resurl=~/\.(sequence|page)$/) {
$mapurl=$resurl;
@@ -17182,11 +14820,9 @@ sub symb_to_docspath {
$mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
}
my $mapresobj;
- unless (ref($$navmapref)) {
- $$navmapref = Apache::lonnavmaps::navmap->new();
- }
- if (ref($$navmapref)) {
- $mapresobj = $$navmapref->getResourceByUrl($mapurl);
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (ref($navmap)) {
+ $mapresobj = $navmap->getResourceByUrl($mapurl);
}
$mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
my $type=$2;
@@ -17196,7 +14832,7 @@ sub symb_to_docspath {
if ($pcslist ne '') {
foreach my $pc (split(/,/,$pcslist)) {
next if ($pc <= 1);
- my $res = $$navmapref->getByMapPc($pc);
+ my $res = $navmap->getByMapPc($pc);
if (ref($res)) {
my $thisurl = $res->src();
$thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
@@ -17243,32 +14879,31 @@ sub symb_to_docspath {
}
sub captcha_display {
- my ($context,$lonhost,$defdom) = @_;
+ my ($context,$lonhost) = @_;
my ($output,$error);
- my ($captcha,$pubkey,$privkey,$version) =
- &get_captcha_config($context,$lonhost,$defdom);
+ my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
if ($captcha eq 'original') {
$output = &create_captcha();
unless ($output) {
- $error = 'captcha';
+ $error = 'captcha';
}
} elsif ($captcha eq 'recaptcha') {
- $output = &create_recaptcha($pubkey,$version);
+ $output = &create_recaptcha($pubkey);
unless ($output) {
- $error = 'recaptcha';
+ $error = 'recaptcha';
}
}
- return ($output,$error,$captcha,$version);
+ return ($output,$error);
}
sub captcha_response {
- my ($context,$lonhost,$defdom) = @_;
+ my ($context,$lonhost) = @_;
my ($captcha_chk,$captcha_error);
- my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
+ my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
if ($captcha eq 'original') {
($captcha_chk,$captcha_error) = &check_captcha();
} elsif ($captcha eq 'recaptcha') {
- $captcha_chk = &check_recaptcha($privkey,$version);
+ $captcha_chk = &check_recaptcha($privkey);
} else {
$captcha_chk = 1;
}
@@ -17276,8 +14911,8 @@ sub captcha_response {
}
sub get_captcha_config {
- my ($context,$lonhost,$dom_in_effect) = @_;
- my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
+ my ($context,$lonhost) = @_;
+ my ($captcha,$pubkey,$privkey,$hashtocheck);
my $hostname = &Apache::lonnet::hostname($lonhost);
my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
@@ -17293,10 +14928,6 @@ sub get_captcha_config {
}
if ($privkey && $pubkey) {
$captcha = 'recaptcha';
- $version = $hashtocheck->{'recaptchaversion'};
- if ($version ne '2') {
- $version = 1;
- }
} else {
$captcha = 'original';
}
@@ -17314,39 +14945,14 @@ sub get_captcha_config {
$privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
if ($privkey && $pubkey) {
$captcha = 'recaptcha';
- $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
- if ($version ne '2') {
- $version = 1;
- }
} else {
$captcha = 'original';
}
} elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
$captcha = 'original';
}
- } elsif ($context eq 'passwords') {
- if ($dom_in_effect) {
- my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
- if ($passwdconf{'captcha'} eq 'recaptcha') {
- if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
- $pubkey = $passwdconf{'recaptchakeys'}{'public'};
- $privkey = $passwdconf{'recaptchakeys'}{'private'};
- }
- if ($privkey && $pubkey) {
- $captcha = 'recaptcha';
- $version = $passwdconf{'recaptchaversion'};
- if ($version ne '2') {
- $version = 1;
- }
- } else {
- $captcha = 'original';
- }
- } elsif ($passwdconf{'captcha'} ne 'notused') {
- $captcha = 'original';
- }
- }
}
- return ($captcha,$pubkey,$privkey,$version);
+ return ($captcha,$pubkey,$privkey);
}
sub create_captcha {
@@ -17362,17 +14968,12 @@ sub create_captcha {
if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
$output = ' '."\n".
- ''.
&mt('Type in the letters/numbers shown below').' '.
- ' '.
- ' '.
- ' ';
+ ' '.
+ ' ';
last;
}
}
- if ($output eq '') {
- &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
- }
return $output;
}
@@ -17409,75 +15010,36 @@ sub check_captcha {
}
sub create_recaptcha {
- my ($pubkey,$version) = @_;
- if ($version >= 2) {
- return '
'.
- '
';
- } else {
- my $use_ssl;
- if ($ENV{'SERVER_PORT'} == 443) {
- $use_ssl = 1;
- }
- my $captcha = Captcha::reCAPTCHA->new;
- return $captcha->get_options_setter({theme => 'white'})."\n".
- $captcha->get_html($pubkey,undef,$use_ssl).
- &mt('If the text is hard to read, [_1] will replace them.',
- ' ').
- ' ';
- }
+ my ($pubkey) = @_;
+ my $use_ssl;
+ if ($ENV{'SERVER_PORT'} == 443) {
+ $use_ssl = 1;
+ }
+ my $captcha = Captcha::reCAPTCHA->new;
+ return $captcha->get_options_setter({theme => 'white'})."\n".
+ $captcha->get_html($pubkey,undef,$use_ssl).
+ &mt('If either word is hard to read, [_1] will replace them.',
+ ' ').
+ ' ';
}
sub check_recaptcha {
- my ($privkey,$version) = @_;
+ my ($privkey) = @_;
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,
- response => $env{'form.g-recaptcha-response'},
- remoteip => $ip,
- );
- my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
- if ($response->is_success) {
- my $data = JSON::DWIW->from_json($response->decoded_content);
- if (ref($data) eq 'HASH') {
- if ($data->{'success'}) {
- $captcha_chk = 1;
- }
- }
- }
- } else {
- my $captcha = Captcha::reCAPTCHA->new;
- my $captcha_result =
- $captcha->check_answer(
- $privkey,
- $ip,
- $env{'form.recaptcha_challenge_field'},
- $env{'form.recaptcha_response_field'},
- );
- if ($captcha_result->{is_valid}) {
- $captcha_chk = 1;
- }
+ my $captcha = Captcha::reCAPTCHA->new;
+ my $captcha_result =
+ $captcha->check_answer(
+ $privkey,
+ $ENV{'REMOTE_ADDR'},
+ $env{'form.recaptcha_challenge_field'},
+ $env{'form.recaptcha_response_field'},
+ );
+ if ($captcha_result->{is_valid}) {
+ $captcha_chk = 1;
}
return $captcha_chk;
}
-sub emailusername_info {
- my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
- my %titles = &Apache::lonlocal::texthash (
- lastname => 'Last Name',
- firstname => 'First Name',
- institution => 'School/college/university',
- location => "School's city, state/province, country",
- web => "School's web address",
- officialemail => 'E-mail address at institution (if different)',
- id => 'Student/Employee ID',
- );
- return (\@fields,\%titles);
-}
-
sub cleanup_html {
my ($incoming) = @_;
my $outgoing;
@@ -17500,231 +15062,11 @@ sub cleanup_html {
return $outgoing;
}
-# Checks for critical messages and returns a redirect url if one exists.
-# $interval indicates how often to check for messages.
-sub critical_redirect {
- my ($interval) = @_;
- unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
- return ();
- }
- if ((time-$env{'user.criticalcheck.time'})>$interval) {
- 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;
- return (1, $url);
- }
- }
- }
- return ();
-}
+=pod
-# Use:
-# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
-#
-##################################################
-# password associated functions #
-##################################################
-sub des_keys {
- # Make a new key for DES encryption.
- # Each key has two parts which are returned separately.
- # Please note: Each key must be passed through the &hex function
- # before it is output to the web browser. The hex versions cannot
- # be used to decrypt.
- my @hexstr=('0','1','2','3','4','5','6','7',
- '8','9','a','b','c','d','e','f');
- my $lkey='';
- for (0..7) {
- $lkey.=$hexstr[rand(15)];
- }
- my $ukey='';
- for (0..7) {
- $ukey.=$hexstr[rand(15)];
- }
- return ($lkey,$ukey);
-}
-
-sub des_decrypt {
- my ($key,$cyphertext) = @_;
- my $keybin=pack("H16",$key);
- my $cypher;
- if ($Crypt::DES::VERSION>=2.03) {
- $cypher=new Crypt::DES $keybin;
- } else {
- $cypher=new DES $keybin;
- }
- my $plaintext='';
- my $cypherlength = length($cyphertext);
- my $numchunks = int($cypherlength/32);
- for (my $j=0; $j<$numchunks; $j++) {
- my $start = $j*32;
- my $cypherblock = substr($cyphertext,$start,32);
- my $chunk =
- $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
- $chunk .=
- $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
- $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
- $plaintext .= $chunk;
- }
- return $plaintext;
-}
-
-sub is_nonframeable {
- my ($url,$absolute,$hostname,$ip,$nocache) = @_;
- my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
- return if (($remprotocol eq '') || ($remhost eq ''));
-
- $remprotocol = lc($remprotocol);
- $remhost = lc($remhost);
- my $remport = 80;
- if ($remprotocol eq 'https') {
- $remport = 443;
- }
- my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
- if ($cached) {
- unless ($nocache) {
- if ($result) {
- return 1;
- } else {
- return 0;
- }
- }
- }
- my $uselink;
- my $request = new HTTP::Request('HEAD',$url);
- my $ua = LWP::UserAgent->new;
- $ua->timeout(5);
- my $response=$ua->request($request);
- if ($response->is_success()) {
- my $secpolicy = lc($response->header('content-security-policy'));
- my $xframeop = lc($response->header('x-frame-options'));
- $secpolicy =~ s/^\s+|\s+$//g;
- $xframeop =~ s/^\s+|\s+$//g;
- if (($secpolicy ne '') || ($xframeop ne '')) {
- my $remotehost = $remprotocol.'://'.$remhost;
- my ($origin,$protocol,$port);
- if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
- $port = $ENV{'SERVER_PORT'};
- } else {
- $port = 80;
- }
- if ($absolute eq '') {
- $protocol = 'http:';
- if ($port == 443) {
- $protocol = 'https:';
- }
- $origin = $protocol.'//'.lc($hostname);
- } else {
- $origin = lc($absolute);
- ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
- }
- if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
- my $framepolicy = $1;
- $framepolicy =~ s/^\s+|\s+$//g;
- my @policies = split(/\s+/,$framepolicy);
- if (@policies) {
- if (grep(/^\Q'none'\E$/,@policies)) {
- $uselink = 1;
- } else {
- $uselink = 1;
- if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
- (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
- (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
- undef($uselink);
- }
- if ($uselink) {
- if (grep(/^\Q'self'\E$/,@policies)) {
- if (($origin ne '') && ($remotehost eq $origin)) {
- undef($uselink);
- }
- }
- }
- if ($uselink) {
- my @possok;
- if ($ip ne '') {
- push(@possok,$ip);
- }
- my $hoststr = '';
- foreach my $part (reverse(split(/\./,$hostname))) {
- if ($hoststr eq '') {
- $hoststr = $part;
- } else {
- $hoststr = "$part.$hoststr";
- }
- if ($hoststr eq $hostname) {
- push(@possok,$hostname);
- } else {
- push(@possok,"*.$hoststr");
- }
- }
- if (@possok) {
- foreach my $poss (@possok) {
- last if (!$uselink);
- foreach my $policy (@policies) {
- if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
- undef($uselink);
- last;
- }
- }
- }
- }
- }
- }
- }
- } elsif ($xframeop ne '') {
- $uselink = 1;
- my @policies = split(/\s*,\s*/,$xframeop);
- if (@policies) {
- unless (grep(/^deny$/,@policies)) {
- if ($origin ne '') {
- if (grep(/^sameorigin$/,@policies)) {
- if ($remotehost eq $origin) {
- undef($uselink);
- }
- }
- if ($uselink) {
- foreach my $policy (@policies) {
- if ($policy =~ /^allow-from\s*(.+)$/) {
- my $allowfrom = $1;
- if (($allowfrom ne '') && ($allowfrom eq $origin)) {
- undef($uselink);
- last;
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- if ($nocache) {
- if ($cached) {
- my $devalidate;
- if ($uselink && !$result) {
- $devalidate = 1;
- } elsif (!$uselink && $result) {
- $devalidate = 1;
- }
- if ($devalidate) {
- &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
- }
- }
- } else {
- if ($uselink) {
- $result = 1;
- } else {
- $result = 0;
- }
- &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
- }
- return $uselink;
-}
+=back
+
+=cut
1;
__END__;