--- loncom/interface/loncommon.pm 2018/05/01 13:30:49 1.1317
+++ loncom/interface/loncommon.pm 2019/04/24 01:44:30 1.1327
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1317 2018/05/01 13:30:49 raeburn Exp $
+# $Id: loncommon.pm,v 1.1327 2019/04/24 01:44:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -5941,6 +5941,10 @@ Inputs:
context, this will contain the URL for the landing item in
the course, after launch from an LTI Consumer
+=item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
+ context, this will contain a reference to hash of items
+ to be included in the page header and/or inline menu.
+
=back
Returns: A uniform header for LON-CAPA web pages.
@@ -5952,7 +5956,7 @@ other decorations will be returned.
sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
- $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri)=@_;
+ $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_;
my $public;
if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
@@ -6023,7 +6027,18 @@ sub bodytag {
if ($public) {
undef($role);
}
-
+
+ if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
+ if (ref($ltimenu) eq 'HASH') {
+ unless ($ltimenu->{'role'}) {
+ undef($role);
+ }
+ unless ($ltimenu->{'coursetitle'}) {
+ $realm=' ';
+ }
+ }
+ }
+
my $titleinfo = '<h1>'.$title.'</h1>';
#
# Extra info if you are the DC
@@ -6057,27 +6072,29 @@ sub bodytag {
$bodytag .= Apache::lonhtmlcommon::scripttag(
Apache::lonmenu::utilityfunctions($httphost), 'start');
- my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
+ unless ($args->{'no_primary_menu'}) {
+ my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu);
- if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
- if ($dc_info) {
- $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
- }
- $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
- <em>$realm</em> $dc_info</div>|;
- return $bodytag;
- }
+ if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
+ if ($dc_info) {
+ $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
+ }
+ $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
+ <em>$realm</em> $dc_info</div>|;
+ return $bodytag;
+ }
- unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
- $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
- }
+ unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
+ $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
+ }
- $bodytag .= $right;
+ $bodytag .= $right;
- if ($dc_info) {
- $dc_info = &dc_courseid_toggle($dc_info);
+ if ($dc_info) {
+ $dc_info = &dc_courseid_toggle($dc_info);
+ }
+ $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
}
- $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
#if directed to not display the secondary menu, don't.
if ($args->{'no_secondary_menu'}) {
@@ -6085,7 +6102,10 @@ sub bodytag {
}
#don't show menus for public users
if (!$public){
- $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope);
+ unless ($args->{'no_inline_menu'}) {
+ $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
+ $args->{'no_primary_menu'});
+ }
$bodytag .= Apache::lonmenu::serverform();
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
if ($env{'request.state'} eq 'construct') {
@@ -8697,13 +8717,38 @@ sub start_page {
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
$env{'internal.start_page'}++;
- my ($result,@advtools,$ltiscope,$ltiuri);
+ my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu);
if (! exists($args->{'skip_phases'}{'head'}) ) {
$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
}
if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
+ if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
+ unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
+ $args->{'no_primary_menu'} = 1;
+ }
+ unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
+ $args->{'no_inline_menu'} = 1;
+ }
+ if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
+ map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
+ }
+ } else {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
+ if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
+ unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
+ $args->{'no_primary_menu'} = 1;
+ }
+ unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
+ $args->{'no_inline_menu'} = 1;
+ }
+ if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
+ map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
+ }
+ }
+ }
($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
@@ -8721,7 +8766,7 @@ sub start_page {
$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'no_nav_bar'},
$args->{'bgcolor'}, $args,
- \@advtools,$ltiscope,$ltiuri);
+ \@advtools,$ltiscope,$ltiuri,\%ltimenu);
}
}
@@ -13892,7 +13937,7 @@ sub load_tmp_file {
sub valid_datatoken {
my ($datatoken) = @_;
- if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) {
+ if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
return $datatoken;
}
return;
@@ -15200,6 +15245,8 @@ 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.
@@ -15207,7 +15254,7 @@ Side effects: populates trails and allit
=cut
sub extract_categories {
- my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
+ my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
if (ref($categories) eq 'HASH') {
&gather_categories($categories,$cats,$idx,$jsarray);
if (ref($cats->[0]) eq 'ARRAY') {
@@ -15235,12 +15282,15 @@ 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);
+ &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
}
} else {
if (ref($subcats) eq 'HASH') {
$subcats->{$item} = [];
}
+ if (ref($maxd) eq 'HASH') {
+ $maxd->{$name} = 1;
+ }
}
}
}
@@ -15278,13 +15328,13 @@ Side effects: populates trails and allit
=cut
sub recurse_categories {
- my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
+ my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
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;
@@ -15305,16 +15355,21 @@ sub recurse_categories {
}
}
&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
- $subcats);
+ $subcats,$maxd);
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;
}
@@ -15346,8 +15401,8 @@ sub assign_categories_table {
my ($cathash,$currcat,$type,$disabled) = @_;
my $output;
if (ref($cathash) eq 'HASH') {
- my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
- &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
+ my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
+ &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
$maxdepth = scalar(@cats);
if (@cats > 0) {
my $itemcount = 0;
@@ -16365,6 +16420,24 @@ 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) = @_;
@@ -16399,18 +16472,18 @@ sub init_user_environment {
opendir(DIR,$lonids);
while ($filename=readdir(DIR)) {
if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
- if ($ENV{'SERVER_PORT'} == 443) {
+ if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
+ &GDBM_READER(),0640)) {
my $linkedfile;
- if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id",
- &GDBM_READER(),0640)) {
- if (exists($oldenv{'user.linkedenv'})) {
- $linkedfile = $oldenv{'user.linkedenv'};
- }
- untie(%oldenv);
+ if (exists($oldenv{'user.linkedenv'})) {
+ $linkedfile = $oldenv{'user.linkedenv'};
}
- if (unlink($lonids.'/'.$filename)) {
- if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) {
- unlink($lonids.'/'.$linkedfile);
+ untie(%oldenv);
+ if (unlink("$lonids/$filename")) {
+ if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
+ if (-l "$lonids/$linkedfile.id") {
+ unlink("$lonids/$linkedfile.id");
+ }
}
}
} else {
@@ -17411,7 +17484,7 @@ sub needs_coursereinit {
}
sub update_content_constraints {
- my ($cdom,$cnum,$chome,$cid) = @_;
+ my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
my (%checkresponsetypes,%checkcrsrestypes);
@@ -17459,10 +17532,24 @@ sub update_content_constraints {
}
undef($navmap);
}
+ my (@resources,@order,@resparms,@zombies);
+ if ($keeporder) {
+ use LONCAPA::map;
+ @resources = @LONCAPA::map::resources;
+ @order = @LONCAPA::map::order;
+ @resparms = @LONCAPA::map::resparms;
+ @zombies = @LONCAPA::map::zombies;
+ }
my $suppmap = 'supplemental.sequence';
my ($suppcount,$supptools,$errors) = (0,0,0);
($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
$suppcount,$supptools,$errors);
+ if ($keeporder) {
+ @LONCAPA::map::resources = @resources;
+ @LONCAPA::map::order = @order;
+ @LONCAPA::map::resparms = @resparms;
+ @LONCAPA::map::zombies = @zombies;
+ }
if ($supptools) {
my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
@@ -17489,7 +17576,7 @@ sub allmaps_incourse {
if ($lastchange > $env{'request.course.tied'}) {
my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
unless ($ferr) {
- &update_content_constraints($cdom,$cnum,$chome,$cid);
+ &update_content_constraints($cdom,$cnum,$chome,$cid,1);
}
}
my $navmap = Apache::lonnavmaps::navmap->new();
@@ -17623,10 +17710,10 @@ sub symb_to_docspath {
}
sub captcha_display {
- my ($context,$lonhost) = @_;
+ my ($context,$lonhost,$defdom) = @_;
my ($output,$error);
my ($captcha,$pubkey,$privkey,$version) =
- &get_captcha_config($context,$lonhost);
+ &get_captcha_config($context,$lonhost,$defdom);
if ($captcha eq 'original') {
$output = &create_captcha();
unless ($output) {
@@ -17642,9 +17729,9 @@ sub captcha_display {
}
sub captcha_response {
- my ($context,$lonhost) = @_;
+ my ($context,$lonhost,$defdom) = @_;
my ($captcha_chk,$captcha_error);
- my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
+ my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
if ($captcha eq 'original') {
($captcha_chk,$captcha_error) = &check_captcha();
} elsif ($captcha eq 'recaptcha') {
@@ -17656,7 +17743,7 @@ sub captcha_response {
}
sub get_captcha_config {
- my ($context,$lonhost) = @_;
+ my ($context,$lonhost,$dom_in_effect) = @_;
my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
my $hostname = &Apache::lonnet::hostname($lonhost);
my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
@@ -17704,7 +17791,28 @@ sub get_captcha_config {
} 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);
}
@@ -17728,6 +17836,9 @@ sub create_captcha {
last;
}
}
+ if ($output eq '') {
+ &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
+ }
return $output;
}
@@ -17979,7 +18090,7 @@ sub make_short_symbs {
while (($gotlock ne 'ok') && ($tries<3)) {
$tries ++;
sleep 1;
- $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+ $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
}
if ($gotlock eq 'ok') {
$init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,