add caching (untested)

The master plan is to use the file cache for running test scripts

Changes

@@ -1,5 +1,10 @@
 Revision history for WebService-Libris
 
+0.03    
+        Documentation for ::Author class
+        Accessor for books that an author wrote
+        Caching
+
 0.02    2011-06-19
         Improved documentation
         Accessors are a bit more robust

lib/WebService/Libris.pm

@@ -19,6 +19,7 @@ my %default_typemap = (
 has 'id';
 has 'type';
 has '_dom';
+has 'cache';
 
 has 'type_map';
 
@@ -251,11 +252,28 @@ sub rdf_url {
 sub dom {
     my $self = shift;
 
-    # TODO: add caching options
-    $self->_dom(Mojo::UserAgent->new()->get($self->rdf_url)->res->dom) unless $self->_dom;
+    unless ($self->_dom) {
+        if ($self->cache) {
+            my $key  = join '/', $self->fragments;
+            if (my $r = $self->cache->get($key)) {
+                $self->_dom($r);
+            } else {
+               my $dom = $self->_request_dom;
+               $self->cache->set($key, $dom);
+               $self->_dom($dom);
+            }
+        } else {
+            $self->_dom($self->_request_dom);
+        }
+    }
     $self->_dom;
 }
 
+sub _request_dom {
+    my $self = shift;
+    Mojo::UserAgent->new()->get($self->rdf_url)->res->dom;
+}
+
 sub direct_search {
     my ($self, %opts) = @_;
     my $terms = $opts{term} // die "Search term missing";
@@ -281,6 +299,7 @@ sub search {
     WebService::Libris::Collection->new(
         type    => 'bib',
         ids     => \@ids,
+        cache   => $self->cache,
     );
 }
 
@@ -291,7 +310,7 @@ sub search_for_isbn {
     my $url = $res->res->headers->location;
     return unless $url;
     my ($type, $libris_id) = (split '/', $url)[-2, -1];
-    $self->new(type => $type, id => $libris_id);
+    $self->new(type => $type, id => $libris_id, cache => $self->cache);
 }
 
 sub fragments {
@@ -322,6 +341,7 @@ sub collection_from_dom {
     WebService::Libris::Collection->new(
         type    => $key,
         ids     => \@ids,
+        cache   => $self->cache,
     );
 }
 

lib/WebService/Libris/Collection.pm

@@ -5,6 +5,7 @@ require WebService::Libris;
 
 has 'type';
 has 'ids';
+has 'cache';
 
 sub new {
     my ($class, %attrs) = @_;
@@ -13,25 +14,27 @@ sub new {
 
 sub all {
     my $self = shift;
-    map WebService::Libris->new(type => $self->type, id => $_),
+    map WebService::Libris->new(type => $self->type, id => $_, cache => $self->cache),
         @{ $self->ids };
 }
 
 sub first {
     my $self = shift;
     return unless @{ $self->ids };
     WebService::Libris->new(
-        type => $self->type,
-        id   => $self->ids->[0],
+        type    => $self->type,
+        id      => $self->ids->[0],
+        cache   => $self->cache,
     );
 }
 
 sub next {
     my $self = shift;
     if (@{ $self->ids }) {
         return WebService::Libris->new(
-            type => $self->type,
-            id => shift @{ $self->ids },
+            type    => $self->type,
+            id      => shift @{ $self->ids },
+            cache   => $self->cache,
         )
     } else {
         return;

lib/WebService/Libris/FileCache.pm

@@ -0,0 +1,37 @@
+use 5.010;
+package WebService::Libris::FileCache;
+use Mojo::Base -base;
+use Mojo::DOM;
+
+has 'directory';
+
+sub new {
+    my $class = shift;
+    bless {@_}, $class;
+}
+
+sub _filename {
+    my ($self, $key) = @_;
+    $key =~ s{/}{_}g;
+    $self->directory . $key . '.xml'
+}
+
+sub get {
+    my ($self, $key) = @_;
+    my $filename = $self->_filename($key);
+    open my $h, '<', $filename;
+    return unless $h;
+    Mojo::DOM->new(xml => 1, charset => 'UTF-8')->parse(do { local $/; <$h> });
+}
+
+sub set {
+    my ($self, $key, $value) = @_;
+    my $filename = $self->_filename($key);
+    open my $h, '>', $filename or die "Can't open file '$filename' for writing: $!";
+    print { $h } $value->to_xml;
+    close $h;
+    $value;
+}
+
+
+1;