Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/OpenLibrary.pm

   1 # ---------------------------------------------------------------
   2 # Copyright (C) 2009 David Christensen <david.a.christensen@gmail.com>
   3 # Copyright (C) 2009 Dan Scott <dscott@laurentian.ca>
   4 #
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 # ---------------------------------------------------------------
  15
  16 package OpenILS::WWW::AddedContent::OpenLibrary;
  17 use strict; use warnings;
  18 use OpenSRF::Utils::Logger qw/$logger/;
  19 use OpenSRF::Utils::SettingsParser;
  20 use OpenILS::WWW::AddedContent;
  21 use OpenSRF::Utils::JSON;
  22 use OpenSRF::EX qw/:try/;
  23 use Data::Dumper;
  24
  25 # Edit the <added_content> section of /openils/conf/opensrf.xml
  26 # Change <module> to:
  27 #   <module>OpenILS::WWW::AddedContent::OpenLibrary</module>
  28
  29 my $AC = 'OpenILS::WWW::AddedContent';
  30
  31 # These URLs are always the same for OpenLibrary, so there's no advantage to
  32 # pulling from opensrf.xml; we hardcode them here
  33 my $base_url = 'http://openlibrary.org/api/books?details=true&bibkeys=ISBN:';
  34 my $cover_base_url = 'http://covers.openlibrary.org/b/isbn/';
  35
  36 sub new {
  37     my( $class, $args ) = @_;
  38     $class = ref $class || $class;
  39     return bless($args, $class);
  40 }
  41
  42 # --------------------------------------------------------------------------
  43 sub jacket_small {
  44     my( $self, $key ) = @_;
  45     return $self->send_img(
  46         $self->fetch_cover_response('-S.jpg', $key));
  47 }
  48
  49 sub jacket_medium {
  50     my( $self, $key ) = @_;
  51     return $self->send_img(
  52         $self->fetch_cover_response('-M.jpg', $key));
  53
  54 }
  55 sub jacket_large {
  56     my( $self, $key ) = @_;
  57     return $self->send_img(
  58         $self->fetch_cover_response('-L.jpg', $key));
  59 }
  60
  61 # --------------------------------------------------------------------------
  62
  63 =head1
  64
  65 OpenLibrary returns a JSON hash of zero or more book responses matching our
  66 request. Each response may contain a table of contents within the details
  67 section of the response.
  68
  69 For now, we check only the first response in the hash for a table of
  70 contents, and if we find a table of contents, we transform it to a simple
  71 HTML table.
  72
  73 =cut
  74
  75 sub toc_html {
  76     my( $self, $key ) = @_;
  77     my $book_details_json = $self->fetch_response($key)->content();
  78
  79
  80     # Trim the "var _OlBookInfo = " declaration that makes this
  81     # invalid JSON
  82     $book_details_json =~ s/^.+?({.*?});$/$1/s;
  83
  84     $logger->debug("$key: " . $book_details_json);
  85
  86     my $toc_html;
  87
  88     my $book_details = OpenSRF::Utils::JSON->JSON2perl($book_details_json);
  89     my $book_key = (keys %$book_details)[0];
  90
  91     # We didn't find a matching book; short-circuit our response
  92     if (!$book_key) {
  93         $logger->debug("$key: no found book");
  94         return 0;
  95     }
  96
  97     my $toc_json = $book_details->{$book_key}->{details}->{table_of_contents};
  98
  99     # No table of contents is available for this book; short-circuit
 100     if (!$toc_json or !scalar(@$toc_json)) {
 101         $logger->debug("$key: no TOC");
 102         return 0;
 103     }
 104
 105     # Build a basic HTML table containing the section number, section title,
 106     # and page number. Some rows may not contain section numbers, we should
 107     # protect against empty page numbers too.
 108     foreach my $chapter (@$toc_json) {
 109         my $label = $chapter->{label};
 110         if ($label) {
 111             $label .= '. ';
 112         }
 113         my $title = $chapter->{title} || '';
 114         my $page_number = $chapter->{pagenum} || '';
 115
 116         $toc_html .= '<tr>' .
 117             "<td style='text-align: right;'>$label</td>" .
 118             "<td style='text-align: left; padding-right: 2em;'>$title</td>" .
 119             "<td style='text-align: right;'>$page_number</td>" .
 120             "</tr>\n";
 121     }
 122
 123     $logger->debug("$key: $toc_html");
 124     $self->send_html("<table>$toc_html</table>");
 125 }
 126
 127 sub toc_json {
 128     my( $self, $key ) = @_;
 129     my $toc = $self->send_json(
 130         $self->fetch_response($key)
 131     );
 132 }
 133
 134 sub send_img {
 135     my($self, $response) = @_;
 136     return {
 137         content_type => $response->header('Content-type'),
 138         content => $response->content,
 139         binary => 1
 140     };
 141 }
 142
 143 sub send_json {
 144     my( $self, $content ) = @_;
 145     return 0 unless $content;
 146
 147     return { content_type => 'text/plain', content => $content };
 148 }
 149
 150 sub send_html {
 151     my( $self, $content ) = @_;
 152     return 0 unless $content;
 153
 154     # Hide anything that might contain a link since it will be broken
 155     my $HTML = <<"    HTML";
 156         <div>
 157             <style type='text/css'>
 158                 div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden }
 159             </style>
 160             <div class='ac'>
 161                 $content
 162             </div>
 163         </div>
 164     HTML
 165
 166     return { content_type => 'text/html', content => $HTML };
 167 }
 168
 169 # returns the HTTP response object from the URL fetch
 170 sub fetch_response {
 171     my( $self, $key ) = @_;
 172     my $url = $base_url . "$key";
 173     my $response = $AC->get_url($url);
 174     return $response;
 175 }
 176
 177 # returns the HTTP response object from the URL fetch
 178 sub fetch_cover_response {
 179     my( $self, $size, $key ) = @_;
 180     my $url = $cover_base_url . "$key$size";
 181     return $AC->get_url($url);
 182 }
 183
 184
 185 1;