[Rt-commit] rt branch, 4.4/queue-summary-cache, created. rt-4.4.3-139-g339640533b

? sunnavy sunnavy at bestpractical.com
Thu Dec 20 09:34:11 EST 2018


The branch, 4.4/queue-summary-cache has been created
        at  339640533b06390f547a4b2b7a9cb5366adbcdeb (commit)

- Log -----------------------------------------------------------------
commit 060d884b594d2e656f6d240688dd3e58e41da878
Author: Jim Brandt <jbrandt at bestpractical.com>
Date:   Thu Mar 16 11:55:37 2017 -0400

    Add test for contents of user session

diff --git a/t/web/session.t b/t/web/session.t
new file mode 100644
index 0000000000..ad21ebd245
--- /dev/null
+++ b/t/web/session.t
@@ -0,0 +1,61 @@
+
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+my ($baseurl, $agent) = RT::Test->started_ok;
+my $url = $agent->rt_base_url;
+
+diag "Test server running at $baseurl";
+
+# get the top page
+{
+    $agent->get($url);
+    is ($agent->status, 200, "Loaded a page");
+}
+
+# test a login
+{
+    $agent->login('root' => 'password');
+    # the field isn't named, so we have to click link 0
+    is( $agent->status, 200, "Fetched the page ok");
+    $agent->content_contains("Logout", "Found a logout link");
+}
+
+my $ids_ref = RT::Interface::Web::Session->Ids();
+
+# Should only have one session id at this point.
+TODO: {
+    local $TODO = 'SQLite has shared file sessions' if RT->Config->Get('DatabaseType') eq 'SQLite';
+    is( scalar @$ids_ref, 1, 'Got just one session id');
+}
+
+diag 'Load session for root user';
+my %session;
+tie %session, 'RT::Interface::Web::Session', $ids_ref->[0];
+is ( $session{'_session_id'}, $ids_ref->[0], 'Got session id ' . $ids_ref->[0] );
+is ( $session{'CurrentUser'}->Name, 'root', 'Session is for root user' );
+
+diag 'Test queues cache';
+my $user_id = $session{'CurrentUser'}->Id;
+ok ( $session{'SelectObject---RT::Queue---' . $user_id . '---CreateTicket---0'}, 'Queues cached for create ticket');
+is ( $session{'SelectObject---RT::Queue---' . $user_id . '---CreateTicket---0'}{'objects'}->[0]{'Name'},
+    'General', 'General queue is in cached list' );
+
+my $last_updated = $session{'SelectObject---RT::Queue---' . $user_id . '---CreateTicket---0'}{'lastupdated'};
+ok( $last_updated, "Got a lastupdated timestamp of $last_updated");
+
+untie(%session);
+# Wait for 1 sec so we can confirm lastupdated doesn't change
+sleep 1;
+$agent->get($url);
+is ($agent->status, 200, "Loaded a page");
+
+tie %session, 'RT::Interface::Web::Session', $ids_ref->[0];
+is ( $session{'_session_id'}, $ids_ref->[0], 'Got session id ' . $ids_ref->[0] );
+is ( $session{'CurrentUser'}->Name, 'root', 'Session is for root user' );
+is ($last_updated, $session{'SelectObject---RT::Queue---' . $user_id . '---CreateTicket---0'}{'lastupdated'},
+    "lastupdated is still $last_updated");
+
+done_testing;

commit 5fb98f492033525d034eb68e8fefe6376a73c4f9
Author: Jim Brandt <jbrandt at bestpractical.com>
Date:   Thu Mar 16 12:51:53 2017 -0400

    Move session cache code to a function for easier access

diff --git a/lib/RT/Interface/Web.pm b/lib/RT/Interface/Web.pm
index 66fe3135c0..f70e910a07 100644
--- a/lib/RT/Interface/Web.pm
+++ b/lib/RT/Interface/Web.pm
@@ -4344,6 +4344,96 @@ sub ProcessAssetsSearchArguments {
     );
 }
 
+=head3 SetObjectSessionCache
+
+Convenience method to stash per-user query results in the user session. This is used
+for rights-intensive queries that change infrequently, such as generating the list of
+queues a user has access to.
+
+The method handles populating the session cache and clearing it based on CacheNeedsUpdate.
+It returns the cache key so callers can use $session directly after it has been created
+or updated.
+
+Parameters:
+
+=over
+
+=item * ObjectType, required, the object for which to fetch values
+
+=item * CheckRight, the right to check for the current user in the query
+
+=item * ShowAll, boolean, ignores the rights check
+
+=item * Default, for dropdowns, a default selected value
+
+=item * CacheNeedsUpdate, date indicating when an update happened requiring a cache clear
+
+=cut
+
+sub SetObjectSessionCache {
+    my %args = (
+        CheckRight => undef,
+        ShowAll => 1,
+        Default => 0,
+        CacheNeedsUpdate => undef,
+        @_ );
+
+    my $ObjectType = $args{'ObjectType'};
+    $ObjectType = "RT::$ObjectType" unless $ObjectType =~ /::/;
+    my $CheckRight = $args{'CheckRight'};
+    my $ShowAll = $args{'ShowAll'};
+    my $CacheNeedsUpdate = $args{'CacheNeedsUpdate'};
+
+    my $cache_key = join "---", "SelectObject", $ObjectType,
+        $session{'CurrentUser'}->Id, $CheckRight || "", $ShowAll;
+
+    if ( defined $session{$cache_key} && !$session{$cache_key}{id} ) {
+        delete $session{$cache_key};
+    }
+
+    if ( defined $session{$cache_key}
+         && ref $session{$cache_key} eq 'ARRAY') {
+        delete $session{$cache_key};
+    }
+    if ( defined $session{$cache_key} && defined $CacheNeedsUpdate &&
+        $session{$cache_key}{lastupdated} <= $CacheNeedsUpdate ) {
+        delete $session{$cache_key};
+    }
+
+    if ( not defined $session{$cache_key} ) {
+        my $collection = "${ObjectType}s"->new($session{'CurrentUser'});
+        $collection->UnLimit;
+
+        $HTML::Mason::Commands::m->callback( CallbackName => 'ModifyCollection',
+            CallbackPage => '/Elements/Quicksearch',
+            ARGSRef => \%args, Collection => $collection, ObjectType => $ObjectType );
+
+        # This is included for continuity in the 4.2 series. It will be removed in 4.6.
+        $HTML::Mason::Commands::m->callback( CallbackName => 'SQLFilter',
+            CallbackPage => '/Elements/QueueSummaryByLifecycle', Queues => $collection )
+            if $ObjectType eq "RT::Queue";
+
+        $session{$cache_key}{id} = {};
+
+        while (my $object = $collection->Next) {
+            if ($ShowAll
+                or not $CheckRight
+                or $session{CurrentUser}->HasRight( Object => $object, Right => $CheckRight ))
+            {
+                push @{$session{$cache_key}{objects}}, {
+                    Id          => $object->Id,
+                    Name        => $object->Name,
+                    Description => $object->_Accessible("Description" => "read") ? $object->Description : undef,
+                };
+                $session{$cache_key}{id}{ $object->id } = 1;
+            }
+        }
+        $session{$cache_key}{lastupdated} = time();
+    }
+
+    return $cache_key;
+}
+
 =head2 _load_container_object ( $type, $id );
 
 Instantiate container object for saving searches.
diff --git a/share/html/Elements/SelectObject b/share/html/Elements/SelectObject
index 89f5f01640..f50348bb77 100644
--- a/share/html/Elements/SelectObject
+++ b/share/html/Elements/SelectObject
@@ -89,42 +89,15 @@ $CacheNeedsUpdate => undef
 $ObjectType = "RT::$ObjectType" unless $ObjectType =~ /::/;
 $Class    ||= "select-" . CSSClass("\L$1") if $ObjectType =~ /RT::(.+)$/;
 
-my $cache_key = join "---", "SelectObject", $ObjectType,
-    $session{'CurrentUser'}->Id, $CheckRight || "", $ShowAll;
-
-if ( defined $session{$cache_key} && ref $session{$cache_key} eq 'ARRAY') {
-    delete $session{$cache_key};
-}
-if ( defined $session{$cache_key} && defined $CacheNeedsUpdate &&
-     $session{$cache_key}{lastupdated} <= $CacheNeedsUpdate ) {
-    delete $session{$cache_key};
-}
-if ( defined $session{$cache_key} && !$session{$cache_key}{id} ) {
-    delete $session{$cache_key};
-}
-
-if ( not defined $session{$cache_key} and not $Lite ) {
-    my $collection = "${ObjectType}s"->new($session{'CurrentUser'});
-    $collection->UnLimit;
-
-    $m->callback( CallbackName => 'ModifyCollection', ARGSRef => \%ARGS,
-                  Collection => $collection, ObjectType => $ObjectType );
-
-    $session{$cache_key}{id} = {};
-    while (my $object = $collection->Next) {
-        if ($ShowAll
-            or not $CheckRight
-            or $session{CurrentUser}->HasRight( Object => $object, Right => $CheckRight ))
-        {
-            push @{$session{$cache_key}{objects}}, {
-                Id          => $object->Id,
-                Name        => $object->Name,
-                Description => $object->_Accessible("Description" => "read") ? $object->Description : undef,
-            };
-            $session{$cache_key}{id}{ $object->id } = 1;
-        }
-    }
-    $session{$cache_key}{lastupdated} = time();
+my $cache_key;
+if ( not $Lite ) {
+    $cache_key = SetObjectSessionCache(
+        ObjectType => $ObjectType,
+        CheckRight => $CheckRight,
+        ShowAll => $ShowAll,
+        Default => $Default,
+        CacheNeedsUpdate => $CacheNeedsUpdate,
+    );
 }
 
 my $default_entry;

commit 5794ddb93693f5d1906c3881867389971a1dc62f
Author: Jim Brandt <jbrandt at bestpractical.com>
Date:   Fri Sep 28 13:33:28 2018 -0400

    Add caching to the queue list portlet
    
    On larger RTs with many queues, and users attached to many
    tickets over time, the rights check to generate the appropriate
    queue list for a user as been observed to take a significant
    amount of time (20+ seconds on one system). Cache this list
    much like the queue list in the "Create ticket" dropdown since
    it changes infrequently from page load to page load.

diff --git a/lib/RT/Interface/Web.pm b/lib/RT/Interface/Web.pm
index f70e910a07..a096d96db1 100644
--- a/lib/RT/Interface/Web.pm
+++ b/lib/RT/Interface/Web.pm
@@ -4368,6 +4368,10 @@ Parameters:
 
 =item * CacheNeedsUpdate, date indicating when an update happened requiring a cache clear
 
+=item * Exclude, hashref ({ Name => 1 }) of object Names to exclude from the cache
+
+=back
+
 =cut
 
 sub SetObjectSessionCache {
@@ -4376,6 +4380,7 @@ sub SetObjectSessionCache {
         ShowAll => 1,
         Default => 0,
         CacheNeedsUpdate => undef,
+        Exclude => undef,
         @_ );
 
     my $ObjectType = $args{'ObjectType'};
@@ -4420,10 +4425,12 @@ sub SetObjectSessionCache {
                 or not $CheckRight
                 or $session{CurrentUser}->HasRight( Object => $object, Right => $CheckRight ))
             {
+                next if $args{'Exclude'} and exists $args{'Exclude'}->{$object->Name};
                 push @{$session{$cache_key}{objects}}, {
                     Id          => $object->Id,
                     Name        => $object->Name,
                     Description => $object->_Accessible("Description" => "read") ? $object->Description : undef,
+                    Lifecycle   => $object->_Accessible("Lifecycle" => "read") ? $object->Lifecycle : undef,
                 };
                 $session{$cache_key}{id}{ $object->id } = 1;
             }
diff --git a/share/html/Elements/QueueList b/share/html/Elements/QueueList
index a207fdd951..ce1481477f 100644
--- a/share/html/Elements/QueueList
+++ b/share/html/Elements/QueueList
@@ -53,13 +53,21 @@
     titleright_href => RT->Config->Get('WebPath').'/Prefs/QueueList.html',
 &>
 <& $comp,
-   queue_filter => sub { $_->CurrentUserHasRight('ShowTicket') && !exists $unwanted->{$_->Name} },
+   queues => $session{$cache_key}{objects},
 &>
 </&>
 </div>
 <%INIT>
 my $unwanted = $session{'CurrentUser'}->UserObj->Preferences('QueueList', {});
 my $comp = $SplitByLifecycle? '/Elements/QueueSummaryByLifecycle' : '/Elements/QueueSummaryByStatus';
+my $cache_key = SetObjectSessionCache(
+    ObjectType => 'RT::Queue',
+    CheckRight => 'ShowTicket',
+    ShowAll => 0,
+    CacheNeedsUpdate => RT->System->QueueCacheNeedsUpdate,
+    Exclude => $unwanted,
+);
+
 </%INIT>
 <%ARGS>
 $SplitByLifecycle => 1
diff --git a/share/html/Elements/QueueSummaryByLifecycle b/share/html/Elements/QueueSummaryByLifecycle
index 74d7fa85b4..d589b6a532 100644
--- a/share/html/Elements/QueueSummaryByLifecycle
+++ b/share/html/Elements/QueueSummaryByLifecycle
@@ -62,7 +62,7 @@
 
 <%PERL>
 my $i = 0;
-for my $queue (@queues) {
+for my $queue (@$queues) {
     next if lc($queue->{Lifecycle} || '') ne lc $lifecycle->Name;
 
     $i++;
@@ -75,7 +75,7 @@ for my $queue (@queues) {
 
 %   for my $status (@cur_statuses) {
 <td align="right">
-    <a href="<% $link_status->($queue, $status) %>"><% $data->{$queue->{id}}->{lc $status} || '-' %></a>
+    <a href="<% $link_status->($queue, $status) %>"><% $data->{$queue->{Id}}->{lc $status} || '-' %></a>
 </td>
 %   }
 </tr>
@@ -110,25 +110,12 @@ $m->callback(
     link_status         => \$link_status,
 );
 
-my $Queues = RT::Queues->new( $session{'CurrentUser'} );
-$Queues->UnLimit();
-$m->callback( CallbackName => 'SQLFilter', Queues => $Queues );
-
-my @queues = grep $queue_filter->($_), @{ $Queues->ItemsArrayRef };
-$m->callback( CallbackName => 'Filter', Queues => \@queues );
-
- at queues = map {
-    {  id          => $_->Id,
-       Name        => $_->Name,
-       Description => $_->Description || '',
-       Lifecycle   => $_->Lifecycle,
-    }
-} grep $_, @queues;
-
 my %lifecycle;
 
-for my $queue (@queues) {
+for my $queue (@$queues) {
     my $cycle = RT::Lifecycle->Load( Name => $queue->{'Lifecycle'} );
+    RT::Logger->error('Unable to load lifecycle for ' . $queue->{'Lifecycle'})
+        unless $cycle;
     $lifecycle{ lc $cycle->Name } = $cycle;
 }
 
@@ -147,17 +134,17 @@ use RT::Report::Tickets;
 my $report = RT::Report::Tickets->new( RT->SystemUser );
 my $query =
     "(Status = '__Active__') AND (".
-    join(' OR ', map "Queue = ".$_->{id}, @queues)
+    join(' OR ', map "Queue = ".$_->{Id}, @$queues)
     .")";
-$query = 'id < 0' unless @queues;
+$query = 'id < 0' unless @$queues;
 $report->SetupGroupings( Query => $query, GroupBy => [qw(Status Queue)] );
 
 while ( my $entry = $report->Next ) {
     $data->{ $entry->__Value("Queue") }->{ $entry->__Value("Status") }
-        = $entry->__Value('id');
+        = $entry->__Value('Id');
     $statuses->{ $entry->__Value("Status") } = 1;
 }
 </%INIT>
 <%ARGS>
-$queue_filter => undef
+$queues => undef  # Arrayref of hashes with cached queue info
 </%ARGS>
diff --git a/share/html/Elements/QueueSummaryByStatus b/share/html/Elements/QueueSummaryByStatus
index 6388c17523..ce8a45e55b 100644
--- a/share/html/Elements/QueueSummaryByStatus
+++ b/share/html/Elements/QueueSummaryByStatus
@@ -56,7 +56,7 @@
 
 <%PERL>
 my $i = 0;
-for my $queue (@queues) {
+for my $queue (@$queues) {
     $i++;
     my $lifecycle = $lifecycle{ lc $queue->{'Lifecycle'} };
 </%PERL>
@@ -71,7 +71,7 @@ for my $queue (@queues) {
    if ( $lifecycle->IsValid( $status ) ) {
 </%perl>
 <td align="right">
-    <a href="<% $link_status->($queue, $status) %>"><% $data->{$queue->{id}}->{lc $status} || '-' %></a>
+    <a href="<% $link_status->($queue, $status) %>"><% $data->{$queue->{Id}}->{lc $status} || '-' %></a>
 </td>
 %   } else {
 <td align="right">-</td>
@@ -108,25 +108,12 @@ $m->callback(
     link_status         => \$link_status,
 );
 
-my $Queues = RT::Queues->new( $session{'CurrentUser'} );
-$Queues->UnLimit();
-$m->callback( CallbackName => 'SQLFilter', Queues => $Queues );
-
-my @queues = grep $queue_filter->($_), @{ $Queues->ItemsArrayRef };
-$m->callback( CallbackName => 'Filter', Queues => \@queues );
-
- at queues = map {
-    {  id          => $_->Id,
-       Name        => $_->Name,
-       Description => $_->Description || '',
-       Lifecycle   => $_->Lifecycle,
-    }
-} grep $_, @queues;
-
 my %lifecycle;
 
-for my $queue (@queues) {
+for my $queue (@$queues) {
     my $cycle = RT::Lifecycle->Load( Name => $queue->{'Lifecycle'} );
+    RT::Logger->error('Unable to load lifecycle for ' . $queue->{'Lifecycle'})
+        unless $cycle;
     $lifecycle{ lc $cycle->Name } = $cycle;
 }
 
@@ -145,9 +132,9 @@ use RT::Report::Tickets;
 my $report = RT::Report::Tickets->new( RT->SystemUser );
 my $query =
     "(Status = '__Active__') AND (".
-    join(' OR ', map "Queue = ".$_->{id}, @queues)
+    join(' OR ', map "Queue = ".$_->{Id}, @$queues)
     .")";
-$query = 'id < 0' unless @queues;
+$query = 'id < 0' unless @$queues;
 $report->SetupGroupings( Query => $query, GroupBy => [qw(Status Queue)] );
 
 while ( my $entry = $report->Next ) {
@@ -157,5 +144,5 @@ while ( my $entry = $report->Next ) {
 }
 </%INIT>
 <%ARGS>
-$queue_filter => undef
+$queues => undef
 </%ARGS>

commit fa84bef0e28f79b8ef1044bce0d2286c9ec80b93
Author: Jim Brandt <jbrandt at bestpractical.com>
Date:   Mon Apr 10 16:21:54 2017 -0400

    Update other portlets using SummaryByStatus

diff --git a/lib/RT/Queue.pm b/lib/RT/Queue.pm
index 52b9f10330..85cd6ba8fe 100644
--- a/lib/RT/Queue.pm
+++ b/lib/RT/Queue.pm
@@ -90,7 +90,7 @@ RT::ACE->RegisterCacheHandler(sub {
     );
 
     return unless $args{Action}    =~ /^(Grant|Revoke)$/i
-              and $args{RightName} =~ /^(SeeQueue|CreateTicket)$/;
+              and $args{RightName} =~ /^(SeeQueue|CreateTicket|AdminQueue)$/;
 
     RT->System->QueueCacheNeedsUpdate(1);
 });
diff --git a/share/html/Elements/MyAdminQueues b/share/html/Elements/MyAdminQueues
index 3f96924530..c270485266 100644
--- a/share/html/Elements/MyAdminQueues
+++ b/share/html/Elements/MyAdminQueues
@@ -47,6 +47,14 @@
 %# END BPS TAGGED BLOCK }}}
 <&|/Widgets/TitleBox, title => loc("Queues I administer"), bodyclass => "" &>
 <& /Elements/QueueSummaryByStatus,
-   queue_filter => sub { $_->CurrentUserHasRight('AdminQueue') },
+   queues => $session{$cache_key}{objects},
 &>
 </&>
+<%INIT>
+my $cache_key = SetObjectSessionCache(
+    ObjectType => 'RT::Queue',
+    CheckRight => 'AdminQueue',
+    ShowAll => 0,
+    CacheNeedsUpdate => RT->System->QueueCacheNeedsUpdate,
+);
+</%INIT>
diff --git a/share/html/Elements/MySupportQueues b/share/html/Elements/MySupportQueues
index ed8e6f05c5..1b4e375d42 100644
--- a/share/html/Elements/MySupportQueues
+++ b/share/html/Elements/MySupportQueues
@@ -47,6 +47,26 @@
 %# END BPS TAGGED BLOCK }}}
 <&|/Widgets/TitleBox, title => loc("Queues I'm an AdminCc for"), bodyclass => "" &>
 <& /Elements/QueueSummaryByStatus,
-   queue_filter => sub { $_->IsAdminCc($session{'CurrentUser'}->Id) },
+    queues => \@queues,
 &>
 </&>
+<%INIT>
+my $Queues = RT::Queues->new( $session{'CurrentUser'} );
+$Queues->UnLimit();
+$m->callback( CallbackName => 'SQLFilter', Queues => $Queues );
+
+my @queues;
+foreach my $queue ( @{ $Queues->ItemsArrayRef } ){
+    next unless $queue->IsAdminCc($session{'CurrentUser'}->Id);
+
+    if ( $queue->Id ) {
+        push @queues, {
+            Id          => $queue->Id,
+            Name        => $queue->Name,
+            Description => $queue->_Accessible("Description" => "read") ? $queue->Description : undef,
+            Lifecycle   => $queue->_Accessible("Lifecycle" => "read") ? $queue->Lifecycle : undef,
+        };
+    }
+}
+
+</%INIT>

commit 339640533b06390f547a4b2b7a9cb5366adbcdeb
Author: Jim Brandt <jbrandt at bestpractical.com>
Date:   Fri Oct 26 10:06:01 2018 -0400

    Clear queue list caches after pref change

diff --git a/lib/RT/Interface/Web.pm b/lib/RT/Interface/Web.pm
index a096d96db1..e80c0fb060 100644
--- a/lib/RT/Interface/Web.pm
+++ b/lib/RT/Interface/Web.pm
@@ -4389,8 +4389,8 @@ sub SetObjectSessionCache {
     my $ShowAll = $args{'ShowAll'};
     my $CacheNeedsUpdate = $args{'CacheNeedsUpdate'};
 
-    my $cache_key = join "---", "SelectObject", $ObjectType,
-        $session{'CurrentUser'}->Id, $CheckRight || "", $ShowAll;
+    my $cache_key = GetObjectSessionCacheKey( ObjectType => $ObjectType,
+        CheckRight => $CheckRight, ShowAll => $ShowAll );
 
     if ( defined $session{$cache_key} && !$session{$cache_key}{id} ) {
         delete $session{$cache_key};
@@ -4441,6 +4441,23 @@ sub SetObjectSessionCache {
     return $cache_key;
 }
 
+sub GetObjectSessionCacheKey {
+    my %args = (
+        CurrentUser => undef,
+        ObjectType => '',
+        CheckRight => '',
+        ShowAll => 1,
+        @_ );
+
+    my $cache_key = join "---", "SelectObject",
+        $args{'ObjectType'},
+        $session{'CurrentUser'}->Id,
+        $args{'CheckRight'},
+        $args{'ShowAll'};
+
+    return $cache_key;
+}
+
 =head2 _load_container_object ( $type, $id );
 
 Instantiate container object for saving searches.
diff --git a/share/html/Prefs/QueueList.html b/share/html/Prefs/QueueList.html
index d9d4268ab0..100e4b1398 100644
--- a/share/html/Prefs/QueueList.html
+++ b/share/html/Prefs/QueueList.html
@@ -104,6 +104,19 @@ if ($ARGS{'Save'}) {
 
     my ($ok, $msg) = $user->SetPreferences('QueueList', $unwanted);
     push @actions, $ok ? loc('Preferences saved.') : $msg;
+
+    # Clear queue caches
+    if ( $ok ){
+        # Clear for 'CreateTicket'
+        my $cache_key = GetObjectSessionCacheKey( ObjectType => 'RT::Queue',
+            CheckRight => 'CreateTicket', ShowAll => 0 );
+        delete $session{$cache_key};
+
+        # Clear for 'ShowTicket'
+        $cache_key = GetObjectSessionCacheKey( ObjectType => 'RT::Queue',
+            CheckRight => 'ShowTicket', ShowAll => 0 );
+        delete $session{$cache_key};
+    }
 }
 
 </%INIT>

-----------------------------------------------------------------------


More information about the rt-commit mailing list