add ETag caching support

GitLab/API.pm

@@ -7,8 +7,8 @@ use vars qw($VERSION);
 
 use Carp            qw();
 use Data::Dumper;
-use GitLab::API::Iterator;
 use HTTP::Headers;
+use HTTP::Status    qw(:constants);
 use JSON;
 use LWP::UserAgent;
 use Log::Any        qw($log);
@@ -17,6 +17,9 @@ use URI;
 use URI::Escape;
 use URI::QueryParam;
 
+use GitLab::API::Cache;
+use GitLab::API::Iterator;
+
 use parent "Exporter";
 
 our $VERSION = 8.12.1;
@@ -87,6 +90,18 @@ sub new {
 
     $log->debug("setup complete, logged in as '$user->{username}' ($user->{name}), GitLab version is $vn");
 
+    # setup ETag cache
+    if ($args{Cache}) {
+        $version = $version // { version => "0.0.0" };
+        my ($v_major, $v_minor, $v_release) =
+            ($version->{version} =~ m/^(\d+)\.(\d+)\.(\d+)/);
+
+        $log->warn("ETag caching might not work on GitLab prior 9.0.0")
+            if $v_major < 9;
+
+        $self->{cache} = GitLab::API::Cache->new;
+    }
+
     return $self;
 }
 
@@ -105,6 +120,7 @@ sub sudo {
 
 sub http     { return shift->{http};     }
 sub json     { return shift->{json};     }
+sub cache    { return shift->{cache};    }
 sub response { return shift->{response}; }
 
 sub die_on_error {
@@ -263,7 +279,22 @@ sub exec_request {
             return $rtargs->{-iterator} ? $iterator : $iterator->all;
         }
 
-        ($response, $data) = $self->clean_data($self->http->get($uri));
+        my %headers;
+        my ($tag, $cached);
+
+        # try using cache if defined
+        if (defined $self->cache) {
+            ($tag, $cached) = $self->cache->get($uri);
+            $headers{"If-None-Match"} = $tag if (defined $tag);
+        }
+
+        my $httpraw = $self->http->get($uri, %headers);
+        if (defined $self->cache && $httpraw->code == HTTP_NOT_MODIFIED) {
+            ($response, $data) = ($httpraw, $cached);
+        } else {
+            $self->cache->flush($uri) if defined $self->cache;
+            ($response, $data) = $self->clean_data($httpraw);
+        }
     } elsif ($tmpl->{method} eq "POST") {
         ($response, $data) = $self->clean_data($self->http->post($uri, \@postdata));
     } elsif ($tmpl->{method} eq "PUT") {
@@ -282,12 +313,20 @@ sub exec_request {
     }
 
     $log->debug("status: " . $response->status_line);
-    $data = undef if !$response->is_success;
+    $data = undef if !$response->is_success && $response->code != HTTP_NOT_MODIFIED;
     $self->{response} = $response;
 
+    if (defined $self->cache && $tmpl->{method} eq "GET") {
+        my $tag = $response->header("ETag");
+        $self->cache->set($uri, $tag, $data)
+            if defined $tag;
+    }
+
     # is it OK to die?
     croak "$tmpl->{name} failed: " . $response->status_line
-        if $self->die_on_error && !$response->is_success && !$rtargs->{-immortal};
+        if $self->die_on_error
+            && !$rtargs->{-immortal}
+            && !($response->is_success || $response->code == HTTP_NOT_MODIFIED);
 
     return $rtargs->{-response} ? ($data, $response) : $data;
 }
@@ -381,7 +420,10 @@ See L<GitLab API|http://doc.gitlab.com/ce/api/> for details.
     use GitLab::Groups;
     use GitLab::Projects;
 
-    my $gitlab = GitLab::API->new(AuthToken => $token);
+    my $gitlab = GitLab::API->new(
+        AuthToken   => $token,
+        URL         => $url,
+    );
 
     # simple result
     my $groups = $gitlab->groups(search => "awesome-group");
@@ -416,6 +458,7 @@ Creates a new instance of L<GitLab::API>. Takes a hash of arguments:
     AuthToken   authentication token
     URL         url to connect to, usually https://gitlab.domain/api/v3
     DieOnError  see die_on_error() method
+    Cache       enable caching
 
 C<URL> is always required.
 The method also requires I<either> C<AuthToken> I<or> ((C<Login> or C<Email>) and C<Password>).
@@ -425,6 +468,9 @@ That is, the only meaningful combinations are
     GitLab::API->new(URL => $URL, Login => $LOGIN, Password => $PASSWD);
     GitLab::API->new(URL => $URL, Email => $EMAIL, Password => $PASSWD);
 
+Caching is available since version L<9.0.0> and allows to cache responses
+based on C<ETag> headers. See L<GitLab::API::Cache> for more details.
+
 =item sudo()
 
     $gitlab->sudo($username);

GitLab/API/Cache.pm

+package GitLab::API::Cache;
+
+use utf8;
+use strict;
+use warnings;
+
+use Log::Any    qw($log);
+
+sub new {
+    my ($class) = @_;
+
+    $log->info("caching is enabled");
+    return bless {}, $class;
+};
+
+sub get {
+    my ($self, $uri) = @_;
+
+    my $p = $self->{data}->{$uri};
+
+    if ($p) {
+        $log->trace("cache hit '$uri'");
+        $log->trace("etag '$p->[0]'");
+        return @$p;
+    }
+
+    $log->trace("cache miss '$uri'");
+    return;
+};
+
+sub set {
+    my ($self, $uri, $tag, $data) = @_;
+    $self->{data}->{$uri} = [ $tag, $data ];
+
+    $log->trace("cache store '$uri'");
+    $log->trace("etag '$tag'");
+    # don't leak data
+    return;
+};
+
+sub flush {
+    my ($self, @uris) = @_;
+    $log->trace("cache flush '", join(",", @uris), "'");
+
+    if (!@uris) {
+        $self->{data} = {};
+    } else {
+        delete $self->{data}->{@uris};
+    }
+
+    # don't leak old keys
+    return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+GitLab::API::Cache - ETag caching module
+
+=head1 SYNOPSIS
+
+    use GitLab;
+
+    my $gitlab = GitLab::API->new(
+        AuthToken   => $token,
+        URL         => $url,
+        # enable caching
+        Cache       => 1,
+    );
+
+    # first request
+    my $user = $gitlab->user;
+    # result gets cached with ETag
+
+    # ...
+
+    # second request, if nothing changes, will use the cached ETag
+    my $user2 = $gitlab->user;
+
+=head1 DESCRIPTION
+
+=head2 Overview
+
+This module allows L<GitLab::API> to use ETag cache. It works like this:
+
+=over
+
+=item 1
+
+A request is made, say, to L<https://HOST/api/v4/user>:
+
+    GET https://${HOST}/api/v4/user
+    User-Agent: libwww-perl/6.26
+    PRIVATE-TOKEN: ${TOKEN}
+
+=item 2
+
+If everything goes OK, a HTTP response is returned, which may look like this:
+
+    HTTP/1.1 200 OK
+    Connection: keep-alive
+    ...
+    ETag: W/"c4281fa772bea4c193fffe77cfebf2f1"
+    Content-Type: application/json
+    ...
+
+    ... data ...
+
+=item 3
+
+The API stores the C<ETag> value along with the data in this cache, for
+given URL.
+
+=item 4
+
+Another request to get user data is made. This time, since the C<ETag>
+is stored in the cache, it will be included in the request:
+
+    GET http://172.17.0.2/api/v4/user
+    If-None-Match: W/"c4281fa772bea4c193fffe77cfebf2f1"
+    User-Agent: libwww-perl/6.26
+    PRIVATE-TOKEN: ${TOKEN}
+
+=item 5
+
+If everything was OK, a response will be returned. Now it depends on whether
+the entity was modified or not.
+
+=over
+
+=item
+
+If the entity was not modified, the response will be much shorter:
+
+    HTTP/1.1 304 Not Modified
+    Connection: keep-alive
+    ...
+    ETag: W/"c4281fa772bea4c193fffe77cfebf2f1"
+    ...
+
+    <no Content-Type nor data>
+
+=item
+
+Otherwise the response will contain new data along with new C<ETag>
+
+    HTTP/1.1 200 OK
+    Connection: keep-alive
+    ...
+    ETag: W/"69f439c650df980276b0f01186acf43a"
+    Content-Type: application/json
+    ...
+
+    ... new data ...
+
+in which case the new data is cached, replacing the old entity.
+
+=back
+
+=back
+
+=head2 Methods
+
+=over
+
+=item new()
+
+    my $cache = GitLab::API::Cache->new();
+
+Creates a new instance of the cache. Takes no arguments.
+
+=item get()
+
+    my ($tag, $data) = $cache->get($uri);
+
+For a given C<$uri> returns cached ETag C<$tag> and parsed data C<$data>.
+Returns C<undef> if there is no data for this uri.
+
+=item set()
+
+    $cache->set($uri, $tag, $data);
+
+Stores a pair of C<$tag> and C<$data> for the given C<$uri>.
+Replaces old value if exists.
+
+=item flush()
+
+    $cache->flush();
+    $cache->flush($uri1, ...);
+
+If no parameters are provided, deletes all stored entries. Otherwise deletes
+only those entries specified as parameters.
+
+=back
+
+=head1 AUTHOR
+
+Roman Lacko <L<xlacko1@fi.muni.cz>>
+
+=head1 SEE ALSO
+
+=over
+
+=item L<GitLab>
+
+Wrapper around L<GitLab::API> that loads all GitLab modules.
+
+=back

GitLab/API/Iterator.pm

@@ -4,8 +4,9 @@ use utf8;
 use strict;
 use warnings;
 
-use Carp        qw();
-use Log::Any    qw($log);
+use Carp            qw();
+use HTTP::Status    qw(:constants);
+use Log::Any        qw($log);
 
 our $VERSION = 8.12.1;
 
@@ -111,6 +112,7 @@ sub all {
 
 sub next_block {
     my ($self) = @_;
+    my $api = $self->api;
 
     if (!$self->{good}) {
         carp "Called next_block on an invalid iterator for " . $self->name;
@@ -129,8 +131,24 @@ sub next_block {
     $xurl->query_param(page     => $self->{pages_read} + 1);
     $xurl->query_param(per_page => $self->{per_page});
 
+    my %headers;
+    my ($tag, $cached);
+    my ($response, $data);
+
+    # try using cache if defined
+    if (defined $api->cache) {
+        ($tag, $cached) = $api->cache->get($xurl);
+        $headers{"If-None-Match"} = $tag if (defined $tag);
+    }
+
     $self->idebug("GET " . $xurl);
-    my ($response, $data) = $self->api->clean_data($self->api->http->get($xurl));
+    my $httpraw = $api->http->get($xurl, %headers);
+    if (defined $api->cache && $httpraw->code == HTTP_NOT_MODIFIED) {
+        ($response, $data) = ($httpraw, $cached);
+    } else {
+        $api->cache->flush($xurl) if defined $api->cache;
+        ($response, $data) = $api->clean_data($httpraw);
+    }
 
     if ($log->is_trace) {
         $log->trace("----  HTTP REQUEST  ".("-" x 25)."\n".$response->request->as_string);
@@ -140,7 +158,7 @@ sub next_block {
 
     $self->idebug("status: " . $response->status_line);
 
-    if (!$response->is_success) {
+    if (!$response->is_success && $response->code != HTTP_NOT_MODIFIED) {
         $self->{good} = 0;
 
         croak "Cannot obtain next block for '" . $self->name . "': " . $response->status_line
@@ -148,6 +166,12 @@ sub next_block {
         return 0;
     }
 
+    if (defined $api->cache) {
+        my $tag = $response->header("ETag");
+        $api->cache->set($xurl, $tag, $data)
+            if defined $tag;
+    }
+
     croak "Response for " . $self->name . " did not contain an array"
         unless ref $data eq "ARRAY";