--- loncom/interface/loncommon.pm 2018/04/27 23:01:05 1.1316
+++ loncom/interface/loncommon.pm 2018/11/07 19:23:45 1.1323
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1316 2018/04/27 23:01:05 raeburn Exp $
+# $Id: loncommon.pm,v 1.1323 2018/11/07 19:23:45 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -203,7 +203,7 @@ 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);
@@ -225,7 +225,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);
@@ -239,7 +239,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);
@@ -253,7 +253,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);
@@ -267,7 +267,7 @@ 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);
@@ -282,7 +282,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);
@@ -5650,7 +5650,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);
@@ -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 = ''.$title.'
';
#
# 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|$dc_info|;
- }
- $bodytag .= qq|$left $role
- $realm $dc_info
|;
- return $bodytag;
- }
+ if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
+ if ($dc_info) {
+ $dc_info = qq|$dc_info|;
+ }
+ $bodytag .= qq|$left $role
+ $realm $dc_info
|;
+ return $bodytag;
+ }
- unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
- $bodytag .= qq|$left $role
|;
- }
+ unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
+ $bodytag .= qq|$left $role
|;
+ }
- $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|$realm $dc_info
|;
}
- $bodytag .= qq|$realm $dc_info
|;
#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);
}
}
@@ -12163,7 +12208,7 @@ sub modify_html_refs {
return;
}
}
- if (open(my $fh,"<$container")) {
+ if (open(my $fh,'<',$container)) {
$content = join('', <$fh>);
close($fh);
} else {
@@ -12228,7 +12273,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].',
@@ -13857,7 +13902,7 @@ sub upfile_store {
{
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);
}
@@ -13882,7 +13927,7 @@ sub load_tmp_file {
{
my $studentfile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';
- if ( open(my $fh,"<$studentfile") ) {
+ if ( open(my $fh,'<',$studentfile) ) {
@studentdata=<$fh>;
close($fh);
}
@@ -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,22 @@ sub compare_arrays {
return @difference;
}
+sub lon_status_items {
+ my %defaults = (
+ E => 100,
+ W => 4,
+ N => 1,
+ threshold => 200,
+ sysmail => 2500,
+ );
+ my %names = (
+ E => 'Errors',
+ W => 'Warnings',
+ N => 'Notices',
+ );
+ return (\%defaults,\%names);
+}
+
# -------------------------------------------------------- Initialize user login
sub init_user_environment {
my ($r, $username, $domain, $authhost, $form, $args) = @_;
@@ -16399,18 +16470,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 {
@@ -17728,6 +17799,9 @@ sub create_captcha {
last;
}
}
+ if ($output eq '') {
+ &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
+ }
return $output;
}
@@ -17979,7 +18053,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,