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