Make Evergreen Perl modules installable via Module::Build to match OpenSRF
[working/Evergreen.git] / 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;