Permalink
Browse files

add caching (untested)

The master plan is to use the file cache for running test scripts
  • Loading branch information...
1 parent ee59758 commit 1942fefaefadb2c7f6ed987e5a6c706bb69ce194 @moritz committed Jun 21, 2011
Showing with 73 additions and 8 deletions.
  1. +5 −0 Changes
  2. +23 −3 lib/WebService/Libris.pm
  3. +8 −5 lib/WebService/Libris/Collection.pm
  4. +37 −0 lib/WebService/Libris/FileCache.pm
View
@@ -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
View
@@ -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,
);
}
@@ -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;
@@ -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;

0 comments on commit 1942fef

Please sign in to comment.