[LON-CAPA-cvs] cvs: loncom /interface lonmenu.pm /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Wed, 06 May 2009 12:13:26 -0000
raeburn Wed May 6 12:13:26 2009 EDT
Modified files:
/loncom/interface lonmenu.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Bug 5946
- Course roles and section counts cached for 10 minutes
(used for inline roles selector for CC)
- Cache expired when a role change occurs for a non-student role or a sectioned-role.
- Code which gathers information about all roles and all sections moved to:
&get_all_courseroles
Index: loncom/interface/lonmenu.pm
diff -u loncom/interface/lonmenu.pm:1.261 loncom/interface/lonmenu.pm:1.262
--- loncom/interface/lonmenu.pm:1.261 Wed Apr 29 16:57:29 2009
+++ loncom/interface/lonmenu.pm Wed May 6 12:13:18 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines to control the menu
#
-# $Id: lonmenu.pm,v 1.261 2009/04/29 16:57:29 bisitz Exp $
+# $Id: lonmenu.pm,v 1.262 2009/05/06 12:13:18 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1629,7 +1629,7 @@
sub roles_selector {
my ($cdom,$cnum) = @_;
my $now = time;
- my (%courseroles,%seccount,%gotnosection);
+ my (%courseroles,%seccount);
my $is_cc;
my $role_selector;
if ($env{'user.role.cc./'.$cdom.'/'.$cnum}) {
@@ -1644,35 +1644,9 @@
}
}
if ($is_cc) {
- my %adv_roles =
- &Apache::lonnet::get_course_adv_roles($env{'request.course.id'},1);
- foreach my $role (keys(%adv_roles)) {
- my ($urole,$usec) = split(/:/,$role);
- if (!$gotnosection{$urole}) {
- $seccount{$urole} ++;
- $gotnosection{$urole} = 1;
- }
- if (ref($courseroles{$urole}) eq 'ARRAY') {
- if ($usec ne '') {
- if (!grep(/^Q$usec\E$/,@{$courseroles{$urole}})) {
- push(@{$courseroles{$urole}},$usec);
- $seccount{$urole} ++;
- }
- }
- } else {
- @{$courseroles{$urole}} = ();
- if ($usec ne '') {
- $seccount{$urole} ++;
- push(@{$courseroles{$urole}},$usec);
- }
- }
- }
- my %sections_count = &Apache::loncommon::get_sections($cdom,$cnum);
- @{$courseroles{'st'}} = ();
- if (keys(%sections_count) > 0) {
- push(@{$courseroles{'st'}},keys(%sections_count));
- }
+ &get_all_courseroles($cdom,$cnum,\%courseroles,\%seccount);
} else {
+ my %gotnosection;
foreach my $item (keys(%env)) {
if ($item =~ m-^user\.role\.([^.]+)\./\Q$cdom\E/\Q$cnum\E/?(\w*)$-) {
my $role = $1;
@@ -1730,6 +1704,61 @@
return $role_selector;
}
+sub get_all_courseroles {
+ my ($cdom,$cnum,$courseroles,$seccount) = @_;
+ unless ((ref($courseroles) eq 'HASH') && (ref($seccount) eq 'HASH')) {
+ return;
+ }
+ my ($result,$cached) =
+ &Apache::lonnet::is_cached_new('getcourseroles',$cdom.'_'.$cnum);
+ if (defined($cached)) {
+ if (ref($result) eq 'HASH') {
+ if ((ref($result->{'roles'}) eq 'HASH') &&
+ (ref($result->{'seccount'}) eq 'HASH')) {
+ %{$courseroles} = %{$result->{'roles'}};
+ %{$seccount} = %{$result->{'seccount'}};
+ return;
+ }
+ }
+ }
+ my %gotnosection;
+ my %adv_roles =
+ &Apache::lonnet::get_course_adv_roles($env{'request.course.id'},1);
+ foreach my $role (keys(%adv_roles)) {
+ my ($urole,$usec) = split(/:/,$role);
+ if (!$gotnosection{$urole}) {
+ $seccount->{$urole} ++;
+ $gotnosection{$urole} = 1;
+ }
+ if (ref($courseroles->{$urole}) eq 'ARRAY') {
+ if ($usec ne '') {
+ if (!grep(/^Q$usec\E$/,@{$courseroles->{$urole}})) {
+ push(@{$courseroles->{$urole}},$usec);
+ $seccount->{$urole} ++;
+ }
+ }
+ } else {
+ @{$courseroles->{$urole}} = ();
+ if ($usec ne '') {
+ $seccount->{$urole} ++;
+ push(@{$courseroles->{$urole}},$usec);
+ }
+ }
+ }
+ my %sections_count = &Apache::loncommon::get_sections($cdom,$cnum,['st']);
+ @{$courseroles->{'st'}} = ();
+ if (keys(%sections_count) > 0) {
+ push(@{$courseroles->{'st'}},keys(%sections_count));
+ $seccount->{'st'} = scalar(keys(%sections_count));
+ }
+ my $rolehash = {
+ 'roles' => $courseroles,
+ 'seccount' => $seccount,
+ };
+ &Apache::lonnet::do_cache_new('getcourseroles',$cdom.'_'.$cnum,$rolehash);
+ return;
+}
+
sub jump_to_role {
my ($cdom,$cnum,$seccount,$courseroles) = @_;
my %lt = &Apache::lonlocal::texthash(
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.995 loncom/lonnet/perl/lonnet.pm:1.996
--- loncom/lonnet/perl/lonnet.pm:1.995 Tue May 5 00:42:35 2009
+++ loncom/lonnet/perl/lonnet.pm Wed May 6 12:13:26 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.995 2009/05/05 00:42:35 raeburn Exp $
+# $Id: lonnet.pm,v 1.996 2009/05/06 12:13:26 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2709,6 +2709,9 @@
$storehash{'section'} = $sec;
}
&instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
+ if (($trole ne 'st') || ($sec ne '')) {
+ &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
+ }
}
}
return;