--- loncom/interface/lonmenu.pm 2013/08/06 16:02:31 1.418
+++ 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.418 2013/08/06 16:02:31 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,40 @@ 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
+ the menu (e.g. [["link", "title", "condition"]] for a single-item menu).
+ create_submenu() supports also the creation of XHTML for nested dropdown
+ menus represented by unordered lists. This is done by replacing the
+ scalar used for the link with an arrayreference containing the menuitems
+ for the nested menu. This can be done recursively so that the next menu
+ may also contain nested submenus.
+
+ Example:
+ [ # begin of datastructure
+ ["/home/", "Home", "condition1"], # 1st item of the 1st layer menu
+ [ # 2nd item of the 1st layer menu
+ [ # anon. array for nested menu
+ ["/path1", "Path1", undef], # 1st item of the 2nd layer menu
+ ["/path2", "Path2", undef], # 2nd item of the 2nd layer menu
+ [ # 3rd item of the 2nd layer menu
+ [[...], [...], ..., [...]], # containing another menu layer
+ "Sub-Sub-Menu", # title for this container
+ undef
+ ]
+ ], # end of array/nested menu
+ "Sub-Menu", # title for the container item
+ undef
+ ] # end of 2nd item of the 1st layer menu
+]
=item innerregister()
@@ -183,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', $listclass, $linkattr);
+ $menu .= '
';
+
+ return $menu;
+}
+
+# helper routine for 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, $listclass, $linkattr) = @_;
+ unless (@{$submenu}) {
+ return '';
+ }
+
+ my $menu = '';
my $count = 0;
my $numsub = scalar(@{$submenu});
foreach my $item (@{$submenu}) {
$count ++;
if (ref($item) eq 'ARRAY') {
my $href = $item->[0];
- if ($href =~ /(aboutme|rss\.html)$/) {
- next unless (($env{'user.name'} ne '') && ($env{'user.domain'} ne ''));
- $href =~ s/\[domain\]/$env{'user.domain'}/g;
- $href =~ s/\[user\]/$env{'user.name'}/g;
- }
+ my $bordertop;
my $borderbot;
+ my $title;
+
+ if ($translate) {
+ $title = &mt($item->[1]);
+ } else {
+ $title = $item->[1];
+ }
+
+ if ($count == 1 && !$first_level) {
+ $bordertop = 'border-top: 1px solid black;';
+ }
if ($count == $numsub) {
- $borderbot = 'border-bottom:1px solid black;';
+ $borderbot = 'border-bottom: 1px solid black;';
+ }
+
+ # href is a reference to another submenu
+ if (ref($href) eq 'ARRAY') {
+ $menu .= '
';
}
} else {
@@ -1122,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 '';
@@ -1154,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})) {
@@ -1177,9 +2054,9 @@ sub inlinemenu {
$output.='';
}
}
- $output.="";
+ $output.="";
}
- $output.="
";
+ $output .= '
'."\n";
return $output;
}
@@ -1210,7 +2087,10 @@ sub rawconfig {
my $pub=($env{'request.state'} eq 'published');
my $con=($env{'request.state'} eq 'construct');
my $rol=$env{'request.role'};
- my $requested_domain = $env{'request.role.domain'};
+ my $requested_domain;
+ if ($rol) {
+ $requested_domain = $env{'request.role.domain'};
+ }
foreach my $line (@desklines) {
my ($row,$col,$pro,$prt,$img,$top,$bot,$act,$desc,$cat)=split(/\:/,$line);
$prt=~s/\$uname/$uname/g;
@@ -1224,7 +2104,13 @@ sub rawconfig {
next if ($crstype ne 'Community');
$prt=~s/\$cmty/$crs/g;
}
- $prt=~s/\$requested_domain/$requested_domain/g;
+ if ($prt =~ m/\$requested_domain/) {
+ if ((!$requested_domain) && ($pro eq 'pbre') && ($env{'user.adv'})) {
+ $prt=~s/\$requested_domain/$env{'user.domain'}/g;
+ } else {
+ $prt=~s/\$requested_domain/$requested_domain/g;
+ }
+ }
if ($category_names{$cat}!~/\w/) { $cat='oth'; }
if ($pro eq 'clear') {
$output.=&clear($row,$col);
@@ -1259,9 +2145,12 @@ sub rawconfig {
} else {
next;
}
+ } elsif ($priv eq 'cca') {
+ next if ($rol eq 'cm');
}
- if (&Apache::lonnet::allowed($priv,$prt)) {
- $output.=&switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc,$cat);
+ if ((($priv eq 'bre') && (&Apache::lonnet::allowed($priv,$prt) eq 'F')) ||
+ (($priv ne 'bre') && (&Apache::lonnet::allowed($priv,$prt)))) {
+ $output.=&switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc,$cat);
}
} elsif ($pro eq 'course') {
if (($env{'request.course.fn'}) && ($crstype ne 'Community')) {
@@ -1339,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)) {
@@ -1371,7 +2278,7 @@ sub rawconfig {
sub check_for_rcrs {
my $showreqcrs = 0;
- my @reqtypes = ('official','unofficial','community');
+ my @reqtypes = ('official','unofficial','community','textbook','placement');
foreach my $type (@reqtypes) {
if (&Apache::lonnet::usertools_access($env{'user.name'},
$env{'user.domain'},
@@ -1383,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;
+ }
}
}
}
@@ -1437,15 +2353,354 @@ function toggleCountdown() {
END
}
+# This creates a "done button" for timed events. The confirmation box is a jQuery
+# dialog widget. If the interval parameter requires a proctor key for the timed
+# event to be marked done, there will also be a textbox where that can be entered.
+# Clicking OK will set the value of LC_interval_done to 'true', and, if needed will
+# set the value of LC_interval_done_proctorpass to the text entered in that box,
+# and submit the corresponding form.
+#
+# The &zero_time() routine in lonhomework.pm is called when a page is rendered if
+# LC_interval_done is true.
+#
+sub done_button_js {
+ my ($type,$width,$height,$proctor,$donebuttontext) = @_;
+ return unless (($type eq 'map') || ($type eq 'resource'));
+ my %lt = &Apache::lonlocal::texthash(
+ title => 'WARNING!',
+ 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).',
+ okdone => 'Click "OK" if you are completely finished.',
+ cancel => 'Click "Cancel" to continue working.',
+ proctor => 'Ask a proctor to enter the key, then click "OK" if you are completely finished.',
+ ok => 'OK',
+ exit => 'Cancel',
+ key => 'Key:',
+ nokey => 'A proctor key is required',
+ );
+ 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() });
+ }
+ } else {
+ my $res = $navmap->getBySymb($env{'request.symb'});
+ if (ref($res)) {
+ if ($res->is_problem()) {
+ push(@resources,$res);
+ }
+ }
+ }
+ foreach my $res (@resources) {
+ if (ref($res->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.').'