--- loncom/lonnet/perl/lonnet.pm 2016/03/02 14:14:14 1.1301 +++ loncom/lonnet/perl/lonnet.pm 2016/03/02 18:23:17 1.1302 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1301 2016/03/02 14:14:14 raeburn Exp $ +# $Id: lonnet.pm,v 1.1302 2016/03/02 18:23:17 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -10341,7 +10341,7 @@ sub resdata { if ($item->[1] eq 'course') { if ((ref($recurseup) eq 'ARRAY') && (ref($recursed) eq 'SCALAR')) { unless ($$recursed) { - @{$recurseup} = &get_map_hierarchy($mapp); + @{$recurseup} = &get_map_hierarchy($mapp,$courseid); $$recursed = 1; } foreach my $item (@${recurseup}) { @@ -10402,6 +10402,16 @@ sub get_numsuppfiles { # EXT resource caching routines # +{ +# Cache (5 seconds) of map hierarchy for speedup of navmaps display +# +# The course for which we cache +my $cachedmapkey=''; +# The cached recursive maps for this course +my %cachedmaps=(); +# When this was last done +my $cachedmaptime=''; + sub clear_EXT_cache_status { &delenv('cache.EXT.'); } @@ -10592,7 +10602,6 @@ sub EXT { # ----------------------------------------------------- Cascading lookup scheme my $symbp=$symbparm; $mapp=&deversion((&decode_symb($symbp))[0]); - @recurseup=(); my $symbparm=$symbp.'.'.$spacequalifierrest; my $recurseparm=$mapp.'___(rec).'.$spacequalifierrest; my $mapparm=$mapp.'___(all).'.$spacequalifierrest; @@ -10764,18 +10773,29 @@ sub check_group_parms { } sub get_map_hierarchy { - my ($mapname) = @_; - my @recurseup = (); + my ($mapname,$courseid) = @_; + my @recurseup = (); if ($mapname) { + if (($cachedmapkey eq $courseid) && + (abs($cachedmaptime-time)<5)) { + if (ref($cachedmaps{$mapname}) eq 'ARRAY') { + return @{$cachedmaps{$mapname}}; + } + } my $navmap = Apache::lonnavmaps::navmap->new(); if (ref($navmap)) { @recurseup = $navmap->recurseup_maps($mapname); undef($navmap); + $cachedmaps{$mapname} = \@recurseup; + $cachedmaptime=time; + $cachedmapkey=$courseid; } } return @recurseup; } +} + sub sort_course_groups { # Sort groups based on defined rankings. Default is sort(). my ($courseid,@groups) = @_; @groups = sort(@groups);