--- loncom/lonnet/perl/lonnet.pm 2016/01/31 21:25:57 1.1300
+++ loncom/lonnet/perl/lonnet.pm 2016/03/02 14:14:14 1.1301
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1300 2016/01/31 21:25:57 raeburn Exp $
+# $Id: lonnet.pm,v 1.1301 2016/03/02 14:14:14 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -10312,6 +10312,13 @@ sub get_userresdata {
# $name - Course/user name.
# $domain - Name of the domain the user/course is registered on.
# $type - Type of thing $name is (must be 'course' or 'user'
+# $mapp - decluttered URL of enclosing map
+# $recursed - Ref to scalar -- set to 1, if nested maps have been recursed.
+# $recurseup - Ref to array of map URLs, starting with map containing
+# $mapp up through hierarchy of nested maps to top level map.
+# $courseid - CourseID (first part of param identifier).
+# $modifier - Middle part of param identifier.
+# $what - Last part of param identifier.
# @which - Array of names of resources desired.
# Returns:
# The value of the first reasource in @which that is found in the
@@ -10321,7 +10328,8 @@ sub get_userresdata {
# 'user', an undefined reference is returned.
# If none of the resources are found, an undef is returned
sub resdata {
- my ($name,$domain,$type,@which)=@_;
+ my ($name,$domain,$type,$mapp,$recursed,$recurseup,$courseid,
+ $modifier,$what,@which)=@_;
my $result;
if ($type eq 'course') {
$result=&get_courseresdata($name,$domain);
@@ -10330,7 +10338,21 @@ sub resdata {
}
if (!ref($result)) { return $result; }
foreach my $item (@which) {
- if (defined($result->{$item->[0]})) {
+ if ($item->[1] eq 'course') {
+ if ((ref($recurseup) eq 'ARRAY') && (ref($recursed) eq 'SCALAR')) {
+ unless ($$recursed) {
+ @{$recurseup} = &get_map_hierarchy($mapp);
+ $$recursed = 1;
+ }
+ foreach my $item (@${recurseup}) {
+ my $norecursechk=$courseid.$modifier.$item.'___(all).'.$what;
+ last if (defined($result->{$norecursechk}));
+ my $recursechk=$courseid.$modifier.$item.'___(rec).'.$what;
+ if (defined($result->{$recursechk})) { return [$result->{$recursechk},'map']; }
+ }
+ }
+ }
+ if (defined($result->{$item->[0]})) {
return [$result->{$item->[0]},$item->[1]];
}
}
@@ -10557,8 +10579,8 @@ sub EXT {
}
}
- my ($section, $group, @groups);
- my ($courselevelm,$courselevel);
+ my ($section, $group, @groups, @recurseup, $recursed);
+ my ($courselevelm,$courseleveli,$courselevel,$mapp);
if (($courseid eq '') && ($cid)) {
$courseid = $cid;
}
@@ -10569,11 +10591,11 @@ sub EXT {
# ----------------------------------------------------- Cascading lookup scheme
my $symbp=$symbparm;
- my $mapp=&deversion((&decode_symb($symbp))[0]);
-
+ $mapp=&deversion((&decode_symb($symbp))[0]);
+ @recurseup=();
my $symbparm=$symbp.'.'.$spacequalifierrest;
+ my $recurseparm=$mapp.'___(rec).'.$spacequalifierrest;
my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
-
if (($env{'user.name'} eq $uname) &&
($env{'user.domain'} eq $udom)) {
$section=$env{'request.course.sec'};
@@ -10590,17 +10612,21 @@ sub EXT {
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
+ my $secleveli=$courseid.'.['.$section.'].'.$recurseparm;
my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
$courselevel=$courseid.'.'.$spacequalifierrest;
my $courselevelr=$courseid.'.'.$symbparm;
+ $courseleveli=$courseid.'.'.$recurseparm;
$courselevelm=$courseid.'.'.$mapparm;
# ----------------------------------------------------------- first, check user
- my $userreply=&resdata($uname,$udom,'user',
+ my $userreply=&resdata($uname,$udom,'user',$mapp,\$recursed,
+ \@recurseup,$courseid,'.',$spacequalifierrest,
([$courselevelr,'resource'],
[$courselevelm,'map' ],
+ [$courseleveli,'map' ],
[$courselevel, 'course' ]));
if (defined($userreply)) { return &get_reply($userreply); }
@@ -10608,15 +10634,18 @@ sub EXT {
my $coursereply;
if (@groups > 0) {
$coursereply = &check_group_parms($courseid,\@groups,$symbparm,
- $mapparm,$spacequalifierrest);
- if (defined($coursereply)) { return &get_reply($coursereply); }
+ $recurseparm,$mapparm,$spacequalifierrest,
+ $mapp,\$recursed,\@recurseup);
+ if (defined($coursereply)) { return &get_reply($coursereply); }
}
$coursereply=&resdata($env{'course.'.$courseid.'.num'},
$env{'course.'.$courseid.'.domain'},
- 'course',
+ 'course',$mapp,\$recursed,\@recurseup,
+ $courseid,'.['.$section.'].',$spacequalifierrest,
([$seclevelr, 'resource'],
[$seclevelm, 'map' ],
+ [$secleveli, 'map' ],
[$seclevel, 'course' ],
[$courselevelr,'resource']));
if (defined($coursereply)) { return &get_reply($coursereply); }
@@ -10633,8 +10662,9 @@ sub EXT {
if ($thisparm) { return &get_reply([$thisparm,'resource']); }
}
# ------------------------------------------ fourth, look in resource metadata
-
- $spacequalifierrest=~s/\./\_/;
+
+ my $what = $spacequalifierrest;
+ $what=~s/\./\_/;
my $filename;
if (!$symbparm) { $symbparm=&symbread(); }
if ($symbparm) {
@@ -10642,18 +10672,20 @@ sub EXT {
} else {
$filename=$env{'request.filename'};
}
- my $metadata=&metadata($filename,$spacequalifierrest);
+ my $metadata=&metadata($filename,$what);
if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
- $metadata=&metadata($filename,'parameter_'.$spacequalifierrest);
+ $metadata=&metadata($filename,'parameter_'.$what);
if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
-# ---------------------------------------------- fourth, look in rest of course
+# ----------------------------------------------- fifth, look in rest of course
if ($symbparm && defined($courseid) &&
$courseid eq $env{'request.course.id'}) {
my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
$env{'course.'.$courseid.'.domain'},
- 'course',
+ 'course',$mapp,\$recursed,\@recurseup,
+ $courseid,'.',$spacequalifierrest,
([$courselevelm,'map' ],
+ [$courseleveli,'map' ],
[$courselevel, 'course']));
if (defined($coursereply)) { return &get_reply($coursereply); }
}
@@ -10710,22 +10742,40 @@ sub get_reply {
}
sub check_group_parms {
- my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;
- my @groupitems = ();
- my $resultitem;
- my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$what,'course']);
+ my ($courseid,$groups,$symbparm,$recurseparm,$mapparm,$what,$mapp,
+ $recursed,$recurseupref) = @_;
+ my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$recurseparm,'map'],
+ [$what,'course']);
+ my $coursereply;
foreach my $group (@{$groups}) {
+ my @groupitems = ();
foreach my $level (@levels) {
my $item = $courseid.'.['.$group.'].'.$level->[0];
push(@groupitems,[$item,$level->[1]]);
}
+ my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+ $env{'course.'.$courseid.'.domain'},
+ 'course',$mapp,$recursed,$recurseupref,
+ $courseid,'.['.$group.'].',$what,
+ @groupitems);
+ last if (defined($coursereply));
}
- my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
- $env{'course.'.$courseid.'.domain'},
- 'course',@groupitems);
return $coursereply;
}
+sub get_map_hierarchy {
+ my ($mapname) = @_;
+ my @recurseup = ();
+ if ($mapname) {
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (ref($navmap)) {
+ @recurseup = $navmap->recurseup_maps($mapname);
+ undef($navmap);
+ }
+ }
+ return @recurseup;
+}
+
sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
my ($courseid,@groups) = @_;
@groups = sort(@groups);