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 # Cache Types/Formats for clearing purposes
  49 my %cachetypes = (
  50     jacket => ['small','medium','large'],
  51     toc => ['html','json','xml'],
  52     anotes => ['html','json','xml'],
  53     excerpt => ['html','json','xml'],
  54     reviews => ['html','json','xml'],
  55     summary => ['html','json','xml'],
  56 );
  57
  58 sub child_init {
  59
  60     OpenSRF::System->bootstrap_client( config_file => $bs_config );
  61     $cache = OpenSRF::Utils::Cache->new;
  62
  63     my $sclient = OpenSRF::Utils::SettingsClient->new();
  64     my $ac_data = $sclient->config_value("added_content");
  65
  66     return Apache2::Const::OK unless $ac_data;
  67     my $ac_handler = $ac_data->{module};
  68     return Apache2::Const::OK unless $ac_handler;
  69
  70     $net_timeout = $ac_data->{timeout} || 1;
  71     $error_countdown = $max_errors = $ac_data->{max_errors} || 10;
  72     $error_retry_timeout = $ac_data->{retry_timeout} || 600;
  73
  74     $logger->debug("Attempting to load Added Content handler: $ac_handler");
  75
  76     $ac_handler->use;
  77
  78     if($@) {
  79         $logger->error("Unable to load Added Content handler [$ac_handler]: $@");
  80         return Apache2::Const::OK;
  81     }
  82
  83     $handler = $ac_handler->new($ac_data);
  84     $logger->debug("added content loaded handler: $handler");
  85     return Apache2::Const::OK;
  86 }
  87
  88
  89 sub handler {
  90
  91     my $r   = shift;
  92
  93     # If the URL requested matches a file on the filesystem, have Apache serve that file
  94     # this allows for local content (most typically images) to be used for some requests
  95     return Apache2::Const::DECLINED if (-e $r->filename);
  96
  97     my $cgi = CGI->new;
  98     my @path_parts = split( /\//, $r->unparsed_uri );
  99
 100     # Intended URL formats
 101     # /opac/extras/ac/jacket/medium/ISBN_VALUE      -- classic keyed-off-isbn
 102     # /opac/extras/ac/-3/-2/-1
 103     # /opac/extras/ac/jacket/medium/r/RECORD_ID     -- provide record id (bre.id)
 104     # /opac/extras/ac/-4/-3/-2/-1
 105     # /opac/extras/ac/jacket/medium/m/RECORD_ID     -- XXX: future use for metarecord id
 106
 107     my $keytype_in_url = $path_parts[-2];  # if not in one of m, r, this will be the $format
 108
 109     my $type;
 110     my $format;
 111     my $keytype;
 112     my $keyvalue;
 113
 114     if ($keytype_in_url =~ m/^(r|m)$/) {
 115         $type = $path_parts[-4];
 116         $format = $path_parts[-3];
 117         $keyvalue = $path_parts[-1]; # a record/metarecord id
 118         $keytype = 'record';
 119     } else {
 120         $type = $path_parts[-3];
 121         $format = $path_parts[-2];
 122         $keyvalue = $path_parts[-1]; # an isbn
 123         $keytype = 'isbn';
 124     }
 125
 126     my $res;
 127     my $keyhash;
 128     my $cachekey;
 129
 130     $cachekey = ($keytype eq "isbn") ? $keyvalue : $keytype . '_' . $keyvalue;
 131
 132     child_init() unless $handler;
 133
 134     return Apache2::Const::NOT_FOUND unless $handler and $type and $format and $cachekey;
 135
 136     if ($type eq "clearcache") {
 137         $r->no_cache(1); # Don't cache the clear cache info
 138         return $AC->clear_cache($format, $cachekey);
 139     }
 140
 141     my $err;
 142     my $data;
 143     my $method = "${type}_${format}";
 144
 145     return Apache2::Const::NOT_FOUND unless $handler->can($method);
 146     return $res if defined($res = $AC->serve_from_cache($type, $format, $cachekey));
 147     return Apache2::Const::NOT_FOUND unless $AC->lookups_enabled;
 148
 149     if ($keytype eq "isbn") { # if this request uses isbn for the key
 150         # craft a hash with the single isbn, because that's all we will have
 151         $keyhash = {};
 152         $keyhash->{"isbn"} = [$keyvalue];
 153     } else {
 154         my $key_data = get_rec_keys($keyvalue);
 155         my @isbns = grep {$_->{tag} eq '020'} @$key_data;
 156         my @issns = grep {$_->{tag} eq '022'} @$key_data;
 157         my @upcs  = grep {$_->{tag} eq '024'} @$key_data;
 158
 159         map {
 160             # Attempt to validate the ISBN.
 161             # strip out hyphens;
 162             $_->{value} =~ s/-//g;
 163             #pull out the first chunk that looks like an ISBN:
 164             if ($_->{value} =~ /([0-9xX]{10}(?:[0-9xX]{3})?)/) {
 165                 $_->{value} = $1;
 166                 my $isbn_obj = Business::ISBN->new($_->{value});
 167                 my $isbn_str;
 168                 $isbn_str = $isbn_obj->as_string([]) if defined($isbn_obj);
 169                 $_->{value} = $isbn_str;
 170             } else {
 171                 undef $_->{value};
 172             }
 173             undef $_ if !defined($_->{value});
 174         } @isbns;
 175
 176         map {
 177             my $issn_obj = Business::ISSN->new($_->{value});
 178             my $issn_str;
 179             $issn_str = $issn_obj->as_string() if defined($issn_obj && $issn_obj->is_valid);
 180             $_->{value} = $issn_str;
 181             undef $_ if !defined($_->{value});
 182         } @issns;
 183
 184         #Remove undef values from @isbns and @issns.
 185         #Prevents empty requests to providers
 186         @isbns = grep {defined} @isbns;
 187         @issns = grep {defined} @issns;
 188
 189         $keyhash = {
 190             isbn => [map {$_->{value}} @isbns],
 191             issn => [map {$_->{value}} @issns],
 192             upc  => [map {$_->{value}} @upcs]
 193         };
 194     }
 195
 196     return Apache2::Const::NOT_FOUND unless @{$keyhash->{isbn}} || @{$keyhash->{issn}} || @{$keyhash->{upc}};
 197
 198     try {
 199         if ($handler->can('expects_keyhash') && $handler->expects_keyhash() eq 1) {
 200             # Handler expects a keyhash
 201             $data = $handler->$method($keyhash);
 202         } else {
 203             # Pass single ISBN as a scalar to the handler
 204             $data = $handler->$method($keyhash->{isbn}[0]);
 205         }
 206     } catch Error with {
 207         $err = shift;
 208         decr_error_countdown();
 209         $logger->debug("added content handler failed: $method($keytype/$keyvalue) => $err"); # XXX: logs unhelpful hashref
 210     };
 211
 212     return Apache2::Const::NOT_FOUND if $err;
 213
 214     if(!$data) {
 215         # if the AC lookup found no corresponding data, cache that information
 216         $logger->debug("added content handler returned no results $method($keytype/$keyvalue)") unless $data;
 217         $AC->cache_result($type, $format, $cachekey, {nocontent=>1});
 218         return Apache2::Const::NOT_FOUND;
 219     }
 220
 221     $AC->print_content($data);
 222     $AC->cache_result($type, $format, $cachekey, $data);
 223
 224     reset_error_countdown();
 225     return Apache2::Const::OK;
 226 }
 227
 228 # returns [{tag => $tag, value => $value}, {tag => $tag2, value => $value2}]
 229 sub get_rec_keys {
 230     my $id = shift;
 231     return OpenILS::Utils::CStoreEditor->new->json_query({
 232         select => {mfr => ['tag', 'value']},
 233         from => 'mfr',
 234         where => {
 235             record => $id,
 236             '-or' => [
 237                 {
 238                     '-and' => [
 239                         {tag => '020'},
 240                         {subfield => 'a'}
 241                     ]
 242                 }, {
 243                     '-and' => [
 244                         {tag => '022'},
 245                         {subfield => 'a'}
 246                     ]
 247                 }, {
 248                     '-and' => [
 249                         {tag => '024'},
 250                         {subfield => 'a'},
 251                         {ind1 => 1}
 252                     ]
 253                 }
 254             ]
 255         },
 256         order_by => [
 257                 { class => 'mfr', field => 'id' }
 258             ]
 259     });
 260 }
 261
 262 sub print_content {
 263     my($class, $data, $from_cache) = @_;
 264     return Apache2::Const::NOT_FOUND if $data->{nocontent};
 265
 266     my $ct = $data->{content_type};
 267     my $content = $data->{content};
 268     print "Content-type: $ct\n\n";
 269
 270     if($data->{binary}) {
 271         binmode STDOUT;
 272         # if it hasn't been cached yet, it's still in binary form
 273         print( ($from_cache) ? decode_base64($content) : $content );
 274     } else {
 275         print $content;
 276     }
 277
 278
 279     return Apache2::Const::OK;
 280 }
 281
 282
 283
 284
 285 # returns an HTTP::Response object
 286 sub get_url {
 287     my( $self, $url ) = @_;
 288
 289     $logger->info("added content getting [timeout=$net_timeout, errors_remaining=$error_countdown] URL = $url");
 290     my $agent = LWP::UserAgent->new(timeout => $net_timeout);
 291
 292     my $res = $agent->get($url);
 293     $logger->info("added content request returned with code " . $res->code);
 294     die "added content request failed: " . $res->status_line ."\n" unless $res->is_success;
 295
 296     return $res;
 297 }
 298
 299 # returns an HTTP::Response object
 300 sub post_url {
 301     my( $self, $url, $content ) = @_;
 302
 303     $logger->info("added content getting [timeout=$net_timeout, errors_remaining=$error_countdown] URL = $url");
 304     my $agent = LWP::UserAgent->new(timeout => $net_timeout);
 305
 306     my $res = $agent->post($url, Content => $content);
 307     $logger->info("added content request returned with code " . $res->code);
 308     die "added content request failed: " . $res->status_line ."\n" unless $res->is_success;
 309
 310     return $res;
 311 }
 312
 313 sub lookups_enabled {
 314     if( $cache->get_cache('ac.no_lookup') ) {
 315         $logger->info("added content lookup disabled");
 316         return undef;
 317     }
 318     return 1;
 319 }
 320
 321 sub disable_lookups {
 322     $cache->put_cache('ac.no_lookup', 1, $error_retry_timeout);
 323 }
 324
 325 sub decr_error_countdown {
 326     $error_countdown--;
 327     if($error_countdown < 1) {
 328         $logger->warn("added content error count exhausted.  Disabling lookups for $error_retry_timeout seconds");
 329         $AC->disable_lookups;
 330     }
 331 }
 332
 333 sub reset_error_countdown {
 334     $error_countdown = $max_errors;
 335 }
 336
 337 sub cache_result {
 338     my($class, $type, $format, $key, $data) = @_;
 339     $logger->debug("caching $type/$format/$key");
 340     $data->{content} = encode_base64($data->{content}) if $data->{binary};
 341     return $cache->put_cache("ac.$type.$format.$key", $data);
 342 }
 343
 344 sub serve_from_cache {
 345     my($class, $type, $format, $key) = @_;
 346     my $data = $cache->get_cache("ac.$type.$format.$key");
 347     return undef unless $data;
 348     $logger->debug("serving $type/$format/$key from cache");
 349     return $class->print_content($data, 1);
 350 }
 351
 352 sub delete_from_cache {
 353     my($class, $type, $format, $key) = @_;
 354     my $data = $cache->get_cache("ac.$type.$format.$key");
 355     if ($data) {
 356         $logger->debug("deleting $type/$format/$key from cache");
 357         $cache->delete_cache("ac.$type.$format.$key");
 358         return 1;
 359     }
 360     return 0;
 361 }
 362
 363 sub clear_cache {
 364     my($class, $category, $key) = @_;
 365     my $data = {
 366         content_type => 'text/plain',
 367         content => "Checking/Clearing Cache Entries for $key\n"
 368     };
 369     my @cleartypes = ($category);
 370     if ($category eq 'all') {
 371         @cleartypes = keys(%cachetypes);
 372     }
 373     for my $type (@cleartypes) {
 374         for my $format (@{$cachetypes{$type}}) {
 375             if ($class->delete_from_cache($type, $format, $key)) {
 376                 $data->{content} .= "Cleared $type/$format\n";
 377             }
 378         }
 379     }
 380     $data->{content} .= "Done Checking $key\n";
 381     return $class->print_content($data, 0);
 382 }
 383
 384 1;