Update ContentCafe Added Content Module
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / WWW / AddedContent.pm
1 package OpenILS::WWW::AddedContent;
2 use strict; use warnings;
3
4 use CGI;
5 use Apache2::Log;
6 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
7 use APR::Const    -compile => qw(:error SUCCESS);
8 use Apache2::RequestRec ();
9 use Apache2::RequestIO ();
10 use Apache2::RequestUtil;
11 use Data::Dumper;
12 use UNIVERSAL::require;
13
14 use OpenSRF::EX qw(:try);
15 use OpenSRF::Utils::Cache;
16 use OpenSRF::System;
17 use OpenSRF::Utils::Logger qw/$logger/;
18 use OpenILS::Utils::CStoreEditor;
19
20 use LWP::UserAgent;
21 use MIME::Base64;
22
23 use Business::ISBN;
24 use Business::ISSN;
25
26 my $AC = __PACKAGE__;
27
28
29 # set the bootstrap config when this module is loaded
30 my $bs_config;
31
32 sub import {
33     my $self = shift;
34     $bs_config = shift;
35 }
36
37
38 my $handler; # added content handler class handle
39 my $cache; # memcache handle
40 my $net_timeout; # max seconds to wait for a response from the added content vendor
41 my $max_errors; # max consecutive lookup failures before added content is temporarily disabled
42 my $error_countdown; # current consecutive errors countdown
43
44 # number of seconds to wait before next lookup 
45 # is attempted after lookups have been disabled
46 my $error_retry_timeout;
47
48
49 sub child_init {
50
51     OpenSRF::System->bootstrap_client( config_file => $bs_config );
52     $cache = OpenSRF::Utils::Cache->new;
53
54     my $sclient = OpenSRF::Utils::SettingsClient->new();
55     my $ac_data = $sclient->config_value("added_content");
56
57     return Apache2::Const::OK unless $ac_data;
58     my $ac_handler = $ac_data->{module};
59     return Apache2::Const::OK unless $ac_handler;
60
61     $net_timeout = $ac_data->{timeout} || 1;
62     $error_countdown = $max_errors = $ac_data->{max_errors} || 10;
63     $error_retry_timeout = $ac_data->{retry_timeout} || 600;
64
65     $logger->debug("Attempting to load Added Content handler: $ac_handler");
66
67     $ac_handler->use;
68
69     if($@) {    
70         $logger->error("Unable to load Added Content handler [$ac_handler]: $@"); 
71         return Apache2::Const::OK; 
72     }
73
74     $handler = $ac_handler->new($ac_data);
75     $logger->debug("added content loaded handler: $handler");
76     return Apache2::Const::OK;
77 }
78
79
80 sub handler {
81
82     my $r   = shift;
83
84     # If the URL requested matches a file on the filesystem, have Apache serve that file
85     # this allows for local content (most typically images) to be used for some requests
86     return Apache2::Const::DECLINED if (-e $r->filename);
87
88     my $cgi = CGI->new;
89     my @path_parts = split( /\//, $r->unparsed_uri );
90
91     # Intended URL formats
92     # /opac/extras/ac/jacket/medium/ISBN_VALUE      -- classic keyed-off-isbn
93     # /opac/extras/ac/-3/-2/-1
94     # /opac/extras/ac/jacket/medium/r/RECORD_ID     -- provide record id (bre.id)
95     # /opac/extras/ac/-4/-3/-2/-1
96     # /opac/extras/ac/jacket/medium/m/RECORD_ID     -- XXX: future use for metarecord id
97
98     my $keytype_in_url = $path_parts[-2];  # if not in one of m, r, this will be the $format
99
100     my $type;
101     my $format;
102     my $keytype;
103     my $keyvalue;
104
105     if ($keytype_in_url =~ m/^(r|m)$/) {
106         $type = $path_parts[-4];
107         $format = $path_parts[-3];
108         $keyvalue = $path_parts[-1]; # a record/metarecord id
109         $keytype = 'record';
110     } else {
111         $type = $path_parts[-3];
112         $format = $path_parts[-2];
113         $keyvalue = $path_parts[-1]; # an isbn
114         $keytype = 'isbn';
115     }
116
117     my $res;
118     my $keyhash;
119     my $cachekey;
120
121     $cachekey = ($keytype eq "isbn") ? $keyvalue : $keytype . '_' . $keyvalue;
122
123     child_init() unless $handler;
124
125     return Apache2::Const::NOT_FOUND unless $handler and $type and $format and $cachekey;
126
127     my $err;
128     my $data;
129     my $method = "${type}_${format}";
130
131     return Apache2::Const::NOT_FOUND unless $handler->can($method);
132     return $res if defined($res = $AC->serve_from_cache($type, $format, $cachekey));
133     return Apache2::Const::NOT_FOUND unless $AC->lookups_enabled;
134
135     if ($keytype eq "isbn") { # if this request uses isbn for the key
136         # craft a hash with the single isbn, because that's all we will have
137         $keyhash = {};
138         $keyhash->{"isbn"} = [$keyvalue];
139     } else {
140         my $key_data = get_rec_keys($keyvalue);
141         my @isbns = grep {$_->{tag} eq '020'} @$key_data;
142         my @issns = grep {$_->{tag} eq '022'} @$key_data;
143         my @upcs  = grep {$_->{tag} eq '024'} @$key_data;
144
145         map {
146             # Attempt to validate the ISBN.
147             # strip out hyphens;
148             $_->{value} =~ s/-//g;
149             #pull out the first chunk that looks like an ISBN:
150             if ($_->{value} =~ /([0-9xX]{10}(?:[0-9xX]{3})?)/) {
151                 $_->{value} = $1;
152                 my $isbn_obj = Business::ISBN->new($_->{value});
153                 my $isbn_str;
154                 $isbn_str = $isbn_obj->as_string([]) if defined($isbn_obj);
155                 $_->{value} = $isbn_str;
156             } else {
157                 undef $_->{value};
158             }
159             undef $_ if !defined($_->{value});
160         } @isbns;
161
162         map {
163             my $issn_obj = Business::ISSN->new($_->{value});
164             my $issn_str;
165             $issn_str = $issn_obj->as_string() if defined($issn_obj && $issn_obj->is_valid);
166             $_->{value} = $issn_str;
167             undef $_ if !defined($_->{value});
168         } @issns;
169
170         $keyhash = {
171             isbn => [map {$_->{value}} @isbns],
172             issn => [map {$_->{value}} @issns],
173             upc  => [map {$_->{value}} @upcs]
174         };
175     }
176
177     return Apache2::Const::NOT_FOUND unless @{$keyhash->{isbn}} || @{$keyhash->{issn}} || @{$keyhash->{upc}};
178
179     try {
180         if ($handler->can('expects_keyhash') && $handler->expects_keyhash() eq 1) {
181             # Handler expects a keyhash
182             $data = $handler->$method($keyhash);
183         } else {
184             # Pass single ISBN as a scalar to the handler
185             $data = $handler->$method($keyhash->{isbn}[0]);
186         }
187     } catch Error with {
188         $err = shift;
189         decr_error_countdown();
190         $logger->debug("added content handler failed: $method($keytype/$keyvalue) => $err"); # XXX: logs unhelpful hashref
191     };
192
193     return Apache2::Const::NOT_FOUND if $err;
194
195     if(!$data) {
196         # if the AC lookup found no corresponding data, cache that information
197         $logger->debug("added content handler returned no results $method($keytype/$keyvalue)") unless $data;
198         $AC->cache_result($type, $format, $cachekey, {nocontent=>1});
199         return Apache2::Const::NOT_FOUND;
200     }
201     
202     $AC->print_content($data);
203     $AC->cache_result($type, $format, $cachekey, $data);
204
205     reset_error_countdown();
206     return Apache2::Const::OK;
207 }
208
209 # returns [{tag => $tag, value => $value}, {tag => $tag2, value => $value2}]
210 sub get_rec_keys {
211     my $id = shift;
212     return OpenILS::Utils::CStoreEditor->new->json_query({
213         select => {mfr => ['tag', 'value']},
214         from => 'mfr',
215         where => {
216             record => $id,
217             '-or' => [
218                 {
219                     '-and' => [
220                         {tag => '020'},
221                         {subfield => 'a'}
222                     ]
223                 }, {
224                     '-and' => [
225                         {tag => '022'},
226                         {subfield => 'a'}
227                     ]
228                 }, {
229                     '-and' => [
230                         {tag => '024'},
231                         {subfield => 'a'},
232                         {ind1 => 1}
233                     ]
234                 }
235             ]
236         },
237         order_by => [
238                 { class => 'mfr', field => 'id' }
239             ]
240     });
241 }
242
243 sub print_content {
244     my($class, $data, $from_cache) = @_;
245     return Apache2::Const::NOT_FOUND if $data->{nocontent};
246
247     my $ct = $data->{content_type};
248     my $content = $data->{content};
249     print "Content-type: $ct\n\n";
250
251     if($data->{binary}) {
252         binmode STDOUT;
253         # if it hasn't been cached yet, it's still in binary form
254         print( ($from_cache) ? decode_base64($content) : $content );
255     } else {
256         print $content;
257     }
258
259
260     return Apache2::Const::OK;
261 }
262
263
264
265
266 # returns an HTPP::Response object
267 sub get_url {
268     my( $self, $url ) = @_;
269
270     $logger->info("added content getting [timeout=$net_timeout, errors_remaining=$error_countdown] URL = $url");
271     my $agent = LWP::UserAgent->new(timeout => $net_timeout);
272
273     my $res = $agent->get($url); 
274     $logger->info("added content request returned with code " . $res->code);
275     die "added content request failed: " . $res->status_line ."\n" unless $res->is_success;
276
277     return $res;
278 }
279
280 # returns an HTPP::Response object
281 sub post_url {
282     my( $self, $url, $content ) = @_;
283
284     $logger->info("added content getting [timeout=$net_timeout, errors_remaining=$error_countdown] URL = $url");
285     my $agent = LWP::UserAgent->new(timeout => $net_timeout);
286
287     my $res = $agent->post($url, Content => $content);
288     $logger->info("added content request returned with code " . $res->code);
289     die "added content request failed: " . $res->status_line ."\n" unless $res->is_success;
290
291     return $res;
292 }
293
294 sub lookups_enabled {
295     if( $cache->get_cache('ac.no_lookup') ) {
296         $logger->info("added content lookup disabled");
297         return undef;
298     }
299     return 1;
300 }
301
302 sub disable_lookups {
303     $cache->put_cache('ac.no_lookup', 1, $error_retry_timeout);
304 }
305
306 sub decr_error_countdown {
307     $error_countdown--;
308     if($error_countdown < 1) {
309         $logger->warn("added content error count exhausted.  Disabling lookups for $error_retry_timeout seconds");
310         $AC->disable_lookups;
311     }
312 }
313
314 sub reset_error_countdown {
315     $error_countdown = $max_errors;
316 }
317
318 sub cache_result {
319     my($class, $type, $format, $key, $data) = @_;
320     $logger->debug("caching $type/$format/$key");
321     $data->{content} = encode_base64($data->{content}) if $data->{binary};
322     return $cache->put_cache("ac.$type.$format.$key", $data);
323 }
324
325 sub serve_from_cache {
326     my($class, $type, $format, $key) = @_;
327     my $data = $cache->get_cache("ac.$type.$format.$key");
328     return undef unless $data;
329     $logger->debug("serving $type/$format/$key from cache");
330     return $class->print_content($data, 1);
331 }
332
333
334
335 1;