--- loncom/lonnet/perl/lonnet.pm 2016/03/02 14:14:14 1.1301 +++ loncom/lonnet/perl/lonnet.pm 2016/03/04 21:43:33 1.1303 @@ -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.1303 2016/03/04 21:43:33 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); @@ -13064,10 +13084,17 @@ BEGIN { my $name = $token->[2]{'name'}; my $value = $token->[2]{'value'}; my $valuematch = $token->[2]{'valuematch'}; - if ($item ne '' && $name ne '' && ($value ne '' || $valuematch ne '')) { + my $namematch = $token->[2]{'namematch'}; + if ($item eq 'parameter') { + if (($namematch ne '') || (($name ne '') && ($value ne '' || $valuematch ne ''))) { + my $release = $parser->get_text(); + $release =~ s/(^\s*|\s*$ )//gx; + $needsrelease{$item.':'.$name.':'.$value.':'.$valuematch.':'.$namematch} = $release; + } + } elsif ($item ne '' && $name ne '') { my $release = $parser->get_text(); $release =~ s/(^\s*|\s*$ )//gx; - $needsrelease{$item.':'.$name.':'.$value.':'.$valuematch} = $release; + $needsrelease{$item.':'.$name.':'.$value} = $release; } } }