bug 8215: (followup) make sure C4::CourseReserves doesn't export anything
[koha.git] / C4 / External / Syndetics.pm
1 package C4::External::Syndetics;
2 # Copyright (C) 2006 LibLime
3 # <jmf at liblime dot com>
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use XML::Simple;
21 use XML::LibXML;
22 use LWP::Simple;
23 use LWP::UserAgent;
24 use HTTP::Request::Common;
25
26 use strict;
27 use warnings;
28
29 use vars qw($VERSION @ISA @EXPORT);
30
31 BEGIN {
32     require Exporter;
33     $VERSION = 3.07.00.049;
34     @ISA = qw(Exporter);
35     @EXPORT = qw(
36         &get_syndetics_index
37         &get_syndetics_summary
38         &get_syndetics_toc
39         &get_syndetics_editions
40         &get_syndetics_excerpt
41         &get_syndetics_reviews
42         &get_syndetics_anotes
43     );
44 }
45
46 # package-level variable
47 my $parser = XML::LibXML->new();
48
49 =head1 NAME
50
51 C4::External::Syndetics - Functions for retrieving Syndetics content in Koha
52
53 =head1 FUNCTIONS
54
55 This module provides facilities for retrieving Syndetics.com content in Koha
56
57 =head2 get_syndetics_summary
58
59   my $syndetics_summary= &get_syndetics_summary( $isbn );
60
61 Get Summary data from Syndetics
62
63 =cut
64
65 sub get_syndetics_index {
66     my ( $isbn,$upc,$oclc ) = @_;
67
68     my $response = _fetch_syndetics_content('INDEX.XML', $isbn, $upc, $oclc);
69
70     my $content = $response->content;
71     my $xmlsimple = XML::Simple->new();
72     $response = $xmlsimple->XMLin(
73         $content,
74     ) unless !$content;
75
76     my $syndetics_elements;
77     for my $available_type ('SUMMARY','TOC','FICTION','AWARDS1','SERIES1','SPSUMMARY','SPREVIEW', 'AVPROFILE', 'AVSUMMARY','DBCHAPTER','LJREVIEW','PWREVIEW','SLJREVIEW','CHREVIEW','BLREVIEW','HBREVIEW','KIREVIEW','CRITICASREVIEW','ANOTES') {
78         if (exists $response->{$available_type} && $response->{$available_type} =~ /$available_type/) {
79             $syndetics_elements->{$available_type} = $available_type;
80             #warn "RESPONSE: $available_type : $response->{$available_type}";
81         }
82     }
83     return $syndetics_elements if $syndetics_elements;
84 }
85
86 sub get_syndetics_summary {
87     my ( $isbn, $upc, $oclc, $syndetics_elements ) = @_;
88
89     my $summary_type = exists($syndetics_elements->{'AVSUMMARY'}) ? 'AVSUMMARY.XML' : 'SUMMARY.XML';
90     my $response = _fetch_syndetics_content($summary_type, $isbn, $upc, $oclc);
91     unless ($response->content_type =~ /xml/) {
92         return;
93     }  
94
95     my $content = $response->content;
96
97     my $summary;
98     eval { 
99         my $doc = $parser->parse_string($content);
100         $summary = $doc->findvalue('//Fld520');
101     };
102     if ($@) {
103         warn "Error parsing Syndetics $summary_type";
104     }
105     return $summary if $summary;
106 }
107
108 sub get_syndetics_toc {
109     my ( $isbn,$upc,$oclc ) = @_;
110
111     my $response = _fetch_syndetics_content('TOC.XML', $isbn, $upc, $oclc);
112     unless ($response->content_type =~ /xml/) {
113         return;
114     }  
115
116     my $content = $response->content;
117     my $xmlsimple = XML::Simple->new();
118     $response = $xmlsimple->XMLin(
119         $content,
120         forcearray => [ qw(Fld970) ],
121     ) unless !$content;
122     # manipulate response USMARC VarFlds VarDFlds Notes Fld520 a
123     my $toc;
124     $toc = \@{$response->{VarFlds}->{VarDFlds}->{SSIFlds}->{Fld970}} if $response;
125     return $toc if $toc;
126 }
127
128 sub get_syndetics_excerpt {
129     my ( $isbn,$upc,$oclc ) = @_;
130
131     my $response = _fetch_syndetics_content('DBCHAPTER.XML', $isbn, $upc, $oclc);
132     unless ($response->content_type =~ /xml/) {
133         return;
134     }  
135         
136     my $content = $response->content;
137     my $xmlsimple = XML::Simple->new();
138     $response = $xmlsimple->XMLin(
139         $content,
140         forcearray => [ qw(Fld520) ],
141     ) unless !$content;
142     # manipulate response USMARC VarFlds VarDFlds Notes Fld520 a
143     my $excerpt;
144     $excerpt = \@{$response->{VarFlds}->{VarDFlds}->{Notes}->{Fld520}} if $response;
145     return XMLout($excerpt, NoEscape => 1) if $excerpt;
146 }
147
148 sub get_syndetics_reviews {
149     my ( $isbn,$upc,$oclc,$syndetics_elements ) = @_;
150
151     my @reviews;
152     my $review_sources = [
153     {title => 'Library Journal Review', file => 'LJREVIEW.XML', element => 'LJREVIEW'},
154     {title => 'Publishers Weekly Review', file => 'PWREVIEW.XML', element => 'PWREVIEW'},
155     {title => 'School Library Journal Review', file => 'SLJREVIEW.XML', element => 'SLJREVIEW'},
156     {title => 'CHOICE Review', file => 'CHREVIEW.XML', element => 'CHREVIEW'},
157     {title => 'Booklist Review', file => 'BLREVIEW.XML', element => 'BLREVIEW'},
158     {title => 'Horn Book Review', file => 'HBREVIEW.XML', element => 'HBREVIEW'},
159     {title => 'Kirkus Book Review', file => 'KIREVIEW.XML', element => 'KIREVIEW'},
160     {title => 'Criticas Review', file => 'CRITICASREVIEW.XML', element => 'CRITICASREVIEW'},
161     {title => 'Spanish Review', file => 'SPREVIEW.XML', element => 'SPREVIEW'},
162     ];
163
164     for my $source (@$review_sources) {
165         if ($syndetics_elements->{$source->{element}} and $source->{element} =~ $syndetics_elements->{$source->{element}}) {
166
167         } else {
168             #warn "Skipping $source->{element} doesn't match $syndetics_elements->{$source->{element}} \n";
169             next;
170         }
171         my $response = _fetch_syndetics_content($source->{file}, $isbn, $upc, $oclc);
172         unless ($response->content_type =~ /xml/) {
173             next;
174         }
175
176         my $content = $response->content;
177        
178         eval { 
179             my $doc = $parser->parse_string($content);
180
181             # note that using findvalue strips any HTML elements embedded
182             # in that review.  That helps us handle slight differences
183             # in the output provided by Syndetics 'old' and 'new' versions
184             # of their service and cleans any questionable HTML that
185             # may be present in the reviews, but does mean that any
186             # <B> and <I> tags used to format the review are also gone.
187             my $result = $doc->findvalue('//Fld520');
188             push @reviews, {title => $source->{title}, reviews => [ { content => $result } ]} if $result;
189         };
190         if ($@) {
191             warn "Error parsing Syndetics $source->{title} review";
192         }
193     }
194     return \@reviews;
195 }
196
197 sub get_syndetics_editions {
198     my ( $isbn,$upc,$oclc ) = @_;
199
200     my $response = _fetch_syndetics_content('FICTION.XML', $isbn, $upc, $oclc);
201     unless ($response->content_type =~ /xml/) {
202         return;
203     }  
204
205     my $content = $response->content;
206
207     my $xmlsimple = XML::Simple->new();
208     $response = $xmlsimple->XMLin(
209         $content,
210         forcearray => [ qw(Fld020) ],
211     ) unless !$content;
212     # manipulate response USMARC VarFlds VarDFlds Notes Fld520 a
213     my $similar_items;
214     $similar_items = \@{$response->{VarFlds}->{VarDFlds}->{NumbCode}->{Fld020}} if $response;
215     return $similar_items if $similar_items;
216 }
217
218 sub get_syndetics_anotes {
219     my ( $isbn,$upc,$oclc) = @_;
220
221     my $response = _fetch_syndetics_content('ANOTES.XML', $isbn, $upc, $oclc);
222     unless ($response->content_type =~ /xml/) {
223         return;
224     }
225
226     my $content = $response->content;
227
228     my $xmlsimple = XML::Simple->new();
229     $response = $xmlsimple->XMLin(
230         $content,
231         forcearray => [ qw(Fld980) ],
232         ForceContent => 1,
233     ) unless !$content;
234     my @anotes;
235     for my $fld980 (@{$response->{VarFlds}->{VarDFlds}->{SSIFlds}->{Fld980}}) {
236         # this is absurd, but sometimes this data serializes differently
237         if(ref($fld980->{a}->{content}) eq 'ARRAY') {
238             for my $content (@{$fld980->{a}->{content}}) {
239                 push @anotes, {content => $content};
240                 
241             }
242         }
243         else {
244             push @anotes, {content => $fld980->{a}->{content}};
245         }
246     }
247     return \@anotes;
248 }
249
250 sub _fetch_syndetics_content {
251     my ( $element, $isbn, $upc, $oclc ) = @_;
252
253     $isbn = '' unless defined $isbn;
254     $upc  = '' unless defined $upc;
255     $oclc = '' unless defined $oclc;
256
257     my $syndetics_client_code = C4::Context->preference('SyndeticsClientCode');
258
259     my $url = "http://www.syndetics.com/index.aspx?isbn=$isbn/$element&client=$syndetics_client_code&type=xw10&upc=$upc&oclc=$oclc";
260     my $ua = LWP::UserAgent->new;
261     $ua->timeout(10);
262     $ua->env_proxy;
263     my $response = $ua->get($url);
264
265     warn "could not retrieve $url" unless $response->content;
266     return $response;
267
268 }
269 1;
270 __END__
271
272 =head1 NOTES
273
274 =cut
275
276 =head1 AUTHOR
277
278 Joshua Ferraro <jmf@liblime.com>
279
280 =cut