--- 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);