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