--- loncom/interface/lonmenu.pm 2016/03/15 14:25:26 1.440
+++ loncom/interface/lonmenu.pm 2025/02/21 04:29:26 1.561
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines to control the menu
#
-# $Id: lonmenu.pm,v 1.440 2016/03/15 14:25:26 raeburn Exp $
+# $Id: lonmenu.pm,v 1.561 2025/02/21 04:29:26 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -99,7 +99,7 @@ It gets filled in the BEGIN block of thi
=over
-=item prep_menuitems(\@menuitem)
+=item prep_menuitems(\@menuitem,$target,$listclass,$linkattr)
This routine wraps a menuitem in proper HTML. It is used by primary_menu() and
secondary_menu().
@@ -124,9 +124,13 @@ dropdown list when mouse hovers over top
(no hover psuedo class) via LC_hoverable class for
tag for top-
level item, which employs jQuery to handle behavior on mouseover.
-Inputs: 4 - (a) link and (b) target for anchor href in top level item,
- (c) title for text wrapped by anchor tag in top level item.
- (d) reference to array of arrays of sub-menu items.
+Inputs: 6 - (a) link and (b) target for anchor href in top level item,
+ (c) title for text wrapped by anchor tag in top level item,
+ (d) reference to array of arrays of sub-menu items,
+ (e) boolean to indicate whether to call &mt() to translate
+ name of menu item,
+ (f) optional class for
element in primary menu, for which
+ sub menu is being generated.
The underlying datastructure used in (d) contains data from mydesk.tab.
It consists of an array which has an array for each item appearing in
@@ -210,14 +214,14 @@ use HTML::Entities();
use Apache::lonwishlist();
use vars qw(@desklines %category_names %category_members %category_positions
- $readdesk @primary_menu %primary_submenu @secondary_menu);
+ $readdesk @primary_menu %primary_submenu @secondary_menu %secondary_submenu);
my @inlineremote;
sub prep_menuitem {
- my ($menuitem) = @_;
+ my ($menuitem,$target,$listclass,$linkattr) = @_;
return '' unless(ref($menuitem) eq 'ARRAY');
- my $link;
+ my ($link,$targetattr);
if ($$menuitem[1]) { # graphical Link
$link = "':'
';
# $link and $title are only used in the initial string written in $menu
# as seen above, not needed for nested submenus
- $menu .= &build_submenu($target, $submenu, $translate, '1');
+ $menu .= &build_submenu($target, $submenu, $translate, '1', $listclass, $linkattr);
$menu .= '
';
return $menu;
@@ -540,8 +833,8 @@ sub create_submenu {
# build the dropdown (and nested submenus) recursively
# see perldoc create_submenu documentation for further information
sub build_submenu {
- my ($target, $submenu, $translate, $first_level) = @_;
- if (!defined(@{$submenu})) {
+ my ($target, $submenu, $translate, $first_level, $listclass, $linkattr) = @_;
+ unless (@{$submenu}) {
return '';
}
@@ -584,13 +877,32 @@ sub build_submenu {
next unless (($env{'user.name'} ne '') && ($env{'user.domain'} ne ''));
$href =~ s/\[domain\]/$env{'user.domain'}/g;
$href =~ s/\[user\]/$env{'user.name'}/g;
+ } elsif (($href =~ m{^/adm/preferences\?}) && ($href =~ /\[returnurl\]/)) {
+ my $returnurl = $ENV{'REQUEST_URI'};
+ if ($ENV{'REQUEST_URI'} =~ m{/adm/preferences\?action=(?:changedomcoord|authorsettings)\&returnurl=([^\&]+)$}) {
+ $returnurl = $1;
+ }
+ if (($returnurl =~ m{^/adm/createuser($|\?action=)}) ||
+ ($returnurl =~ m{^/priv/$match_domain/$match_username}) ||
+ ($returnurl =~ m{^/res(/?$|/$match_domain/$match_username)})) {
+ $returnurl =~ s{\?.*$}{};
+ $returnurl = '&returnurl='.&HTML::Entities::encode($returnurl,'"<>&\'');
+ } else {
+ undef($returnurl);
+ }
+ $href =~ s/\[returnurl\]/$returnurl/;
}
+ my $targetattr;
unless (($href eq '') || ($href =~ /^\#/)) {
- $target = ' target="_top"';
+ if ($target ne '') {
+ $targetattr = ' target="'.$target.'"';
+ }
}
- $menu .= '
';
}
} else {
@@ -1242,14 +1997,16 @@ sub switch {
unless ($env{'request.state'} eq 'construct') {
push(@tools,63);
}
- if (($env{'environment.icons'} eq 'iconsonly') &&
+ if ((($env{'environment.icons'} eq 'iconsonly') ||
+ ($env{'environment.icons'} eq '') && ($env{'request.lti.login'})) &&
(grep(/^$idx$/,@tools))) {
$inlineremote[$idx] =
''.$pic.'';
} else {
+ my $linktext = &mt($top);
$inlineremote[$idx] =
''.$pic.
- ''.$top.' ';
+ ''.$linktext.' '.$form;
}
}
return '';
@@ -1274,15 +2031,15 @@ sub inlinemenu {
undef(%category_members);
# calling rawconfig with "1" will evaluate mydesk.tab, even if there is no active remote control
&rawconfig(1);
- my $output='
';
+ my $output='
'."\n";
for (my $col=1; $col<=2; $col++) {
- $output.='
';
+ $output .= '
'."\n";
for (my $row=1; $row<=8; $row++) {
foreach my $cat (keys(%category_members)) {
if ($category_positions{$cat} ne "$col,$row") { next; }
#$output.='
'.&mt($category_names{$cat}).'
';
$output.='
';
- $output.='
'.&mt($category_names{$cat}).'
';
+ $output.='
'.&mt($category_names{$cat}).'
';
$output.='
';
my %active=();
foreach my $menu_item (split(/\:/,$category_members{$cat})) {
@@ -1297,9 +2054,9 @@ sub inlinemenu {
$output.='';
}
}
- $output.="";
+ $output.="";
}
- $output.="
";
+ $output .= '
'."\n";
return $output;
}
@@ -1388,6 +2145,8 @@ sub rawconfig {
} else {
next;
}
+ } elsif ($priv eq 'cca') {
+ next if ($rol eq 'cm');
}
if ((($priv eq 'bre') && (&Apache::lonnet::allowed($priv,$prt) eq 'F')) ||
(($priv ne 'bre') && (&Apache::lonnet::allowed($priv,$prt)))) {
@@ -1469,6 +2228,24 @@ sub rawconfig {
}
}
}
+ } elsif ($pro eq 'coauthor') {
+ if ($env{'request.role'}=~ m{^(ca|aa)\./($match_domain)/($match_username)$}) {
+ my ($role,$audom,$auname) = ($1,$2,$3);
+ if ((($prt eq 'raa') && ($role eq 'aa')) ||
+ (($prt eq 'rca') && ($role eq 'ca') &&
+ (!$env{"environment.internal.manager./$audom/$auname"}))) {
+ $output.=&switch($auname,$audom,
+ $row,$col,$img,$top,$bot,$act,$desc,$cat);
+ }
+ }
+ } elsif ($pro eq 'coauthorenv_manager') {
+ if ($env{'request.role'}=~ m{^ca\./($match_domain)/($match_username)$}) {
+ my ($audom,$auname) = ($1,$2);
+ if ($env{"environment.internal.manager./$audom/$auname"}) {
+ $output.=&switch($auname,$audom,
+ $row,$col,$img,$top,$bot,$act,$desc,$cat);
+ }
+ }
} elsif ($pro eq 'tools') {
my @tools = ('aboutme','blog','portfolio');
if (grep(/^\Q$prt\E$/,@tools)) {
@@ -1501,7 +2278,7 @@ sub rawconfig {
sub check_for_rcrs {
my $showreqcrs = 0;
- my @reqtypes = ('official','unofficial','community','textbook');
+ my @reqtypes = ('official','unofficial','community','textbook','placement');
foreach my $type (@reqtypes) {
if (&Apache::lonnet::usertools_access($env{'user.name'},
$env{'user.domain'},
@@ -1513,8 +2290,17 @@ sub check_for_rcrs {
if (!$showreqcrs) {
foreach my $type (@reqtypes) {
if ($env{'environment.reqcrsotherdom.'.$type} ne '') {
- $showreqcrs = 1;
- last;
+ my @domains = split(',',$env{'environment.reqcrsotherdom.'.$type});
+ foreach my $entry (@domains) {
+ my ($extdom,$extopt) = split(':',$entry);
+ if (&Apache::lonnet::will_trust('reqcrs',$env{'user.domain'},$extdom)) {
+ $showreqcrs = 1;
+ last;
+ }
+ }
+ if ($showreqcrs) {
+ last;
+ }
}
}
}
@@ -1578,10 +2364,10 @@ END
# LC_interval_done is true.
#
sub done_button_js {
- my ($type,$width,$height,$proctor) = @_;
+ my ($type,$width,$height,$proctor,$donebuttontext) = @_;
+ return unless (($type eq 'map') || ($type eq 'resource'));
my %lt = &Apache::lonlocal::texthash(
title => 'WARNING!',
- button => 'Done',
preamble => 'You are trying to end this timed event early.',
map => 'Confirming that you are done will cause the time to expire and prevent you from changing any answers in the current folder.',
resource => 'Confirming that you are done will cause the time to expire for this question, and prevent you from changing your answer(s).',
@@ -1593,27 +2379,78 @@ sub done_button_js {
key => 'Key:',
nokey => 'A proctor key is required',
);
- my $confirm;
- if (($type eq 'map') || ($type eq 'resource')) {
- if ($proctor) {
- $confirm = $lt{'preamble'}.' '.$lt{$type};
- if ($height !~ /^\d+$/) {
- $height = 400;
+ my $shownsymb = &HTML::Entities::encode(&Apache::lonenc::check_encrypt($env{'request.symb'}));
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my ($missing,$tried) = (0,0);
+ if (ref($navmap)) {
+ my @resources=();
+ if ($type eq 'map') {
+ my ($mapurl,$rid,$resurl)=&Apache::lonnet::decode_symb($env{'request.symb'});
+ if ($env{'request.symb'} =~ /\.page$/) {
+ @resources=$navmap->retrieveResources($resurl,sub { $_[0]->is_problem() });
+ } else {
+ @resources=$navmap->retrieveResources($mapurl,sub { $_[0]->is_problem() });
}
- if ($width !~ /^\d+$/) {
- $width = 400;
+ } else {
+ my $res = $navmap->getBySymb($env{'request.symb'});
+ if (ref($res)) {
+ if ($res->is_problem()) {
+ push(@resources,$res);
+ }
}
- return <parts()) eq 'ARRAY') {
+ foreach my $part (@{$res->parts()}) {
+ if (!$res->tries($part)) {
+ $missing++;
+ } else {
+ $tried++;
+ }
+ }
+ }
+ }
+ }
+ if ($missing) {
+ $lt{'miss'} .= '
';
+ if ($type eq 'map') {
+ $lt{'miss'} .= &mt('Submissions are missing for [quant,_1,question part,question parts] in this folder.',$missing);
+ } else {
+ $lt{'miss'} .= &mt('Submissions are missing for [quant,_1,part] in this question.',$missing);
+ }
+ if ($missing > 1) {
+ $lt{'miss'} .= ' '.&mt('If you confirm you are done you will be unable to submit answers for them.').'';
+ } else {
+ $lt{'miss'} .= ' '.&mt('If you confirm you are done you will be unable to submit an answer for it.').'