koha-dev.rot13.org Git - koha_fer/blob - 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 with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 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 = 0.03;
  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 =over 4
  60
  61 my $syndetics_summary= &get_syndetics_summary( $isbn );
  62
  63 =back
  64
  65 Get Summary data from Syndetics
  66
  67 =cut
  68
  69 sub get_syndetics_index {
  70     my ( $isbn,$upc,$oclc ) = @_;
  71
  72     # grab the AWSAccessKeyId: mine is '0V5RRRRJZ3HR2RQFNHR2'
  73     my $syndetics_client_code = C4::Context->preference('SyndeticsClientCode');
  74
  75     my $url = "http://www.syndetics.com/index.aspx?isbn=$isbn/INDEX.XML&client=$syndetics_client_code&type=xw10&upc=$upc&oclc=$oclc";
  76
  77     my $ua = LWP::UserAgent->new;
  78     $ua->timeout(10);
  79     $ua->env_proxy;
  80     my $response = $ua->get($url);
  81     unless ($response->content_type =~ /xml/) {
  82         return;
  83     }
  84
  85     my $content = $response->content;
  86     warn "could not retrieve $url" unless $content;
  87     my $xmlsimple = XML::Simple->new();
  88     $response = $xmlsimple->XMLin(
  89         $content,
  90     ) unless !$content;
  91
  92     my $syndetics_elements;
  93     for my $available_type ('SUMMARY','TOC','FICTION','AWARDS1','SERIES1','SPSUMMARY','SPREVIEW', 'AVPROFILE', 'AVSUMMARY','DBCHAPTER','LJREVIEW','PWREVIEW','SLJREVIEW','CHREVIEW','BLREVIEW','HBREVIEW','KIREVIEW','CRITICASREVIEW','ANOTES') {
  94         if (exists $response->{$available_type} && $response->{$available_type} =~ /$available_type/) {
  95             $syndetics_elements->{$available_type} = $available_type;
  96             #warn "RESPONSE: $available_type : $response->{$available_type}";
  97         }
  98     }
  99     return $syndetics_elements if $syndetics_elements;
 100 }
 101
 102 sub get_syndetics_summary {
 103     my ( $isbn, $upc, $oclc, $syndetics_elements ) = @_;
 104
 105     # grab the AWSAccessKeyId: mine is '0V5RRRRJZ3HR2RQFNHR2'
 106     my $syndetics_client_code = C4::Context->preference('SyndeticsClientCode');
 107
 108     my $summary_type = exists($syndetics_elements->{'AVSUMMARY'}) ? 'AVSUMMARY' : 'SUMMARY';
 109     my $url = "http://www.syndetics.com/index.aspx?isbn=$isbn/$summary_type.XML&client=$syndetics_client_code&type=xw10&upc=$upc&oclc=$oclc";
 110     my $ua = LWP::UserAgent->new;
 111     $ua->timeout(10);
 112     $ua->env_proxy;
 113     my $response = $ua->get($url);
 114     unless ($response->content_type =~ /xml/) {
 115         return;
 116     }
 117
 118     my $content = $response->content;
 119
 120     warn "could not retrieve $url" unless $content;
 121     my $summary;
 122     eval {
 123         my $doc = $parser->parse_string($content);
 124         $summary = $doc->findvalue('//Fld520');
 125     };
 126     if ($@) {
 127         warn "Error parsing response from $url";
 128     }
 129     return $summary if $summary;
 130 }
 131
 132 sub get_syndetics_toc {
 133     my ( $isbn,$upc,$oclc ) = @_;
 134
 135     # grab the AWSAccessKeyId: mine is '0V5RRRRJZ3HR2RQFNHR2'
 136     my $syndetics_client_code = C4::Context->preference('SyndeticsClientCode');
 137
 138     my $url = "http://www.syndetics.com/index.aspx?isbn=$isbn/TOC.XML&client=$syndetics_client_code&type=xw10&upc=$upc&oclc=$oclc";
 139     my $ua = LWP::UserAgent->new;
 140     $ua->timeout(10);
 141     $ua->env_proxy;
 142
 143     my $response = $ua->get($url);
 144     unless ($response->content_type =~ /xml/) {
 145         return;
 146     }
 147
 148     my $content = $response->content;
 149     warn "could not retrieve $url" unless $content;
 150     my $xmlsimple = XML::Simple->new();
 151     $response = $xmlsimple->XMLin(
 152         $content,
 153         forcearray => [ qw(Fld970) ],
 154     ) unless !$content;
 155     # manipulate response USMARC VarFlds VarDFlds Notes Fld520 a
 156     my $toc;
 157     $toc = \@{$response->{VarFlds}->{VarDFlds}->{SSIFlds}->{Fld970}} if $response;
 158     return $toc if $toc;
 159 }
 160
 161 sub get_syndetics_excerpt {
 162     my ( $isbn,$upc,$oclc ) = @_;
 163
 164     # grab the AWSAccessKeyId: mine is '0V5RRRRJZ3HR2RQFNHR2'
 165     my $syndetics_client_code = C4::Context->preference('SyndeticsClientCode');
 166
 167     my $url = "http://www.syndetics.com/index.aspx?isbn=$isbn/DBCHAPTER.XML&client=$syndetics_client_code&type=xw10&upc=$upc&oclc=$oclc";
 168     my $ua = LWP::UserAgent->new;
 169     $ua->timeout(10);
 170     $ua->env_proxy;
 171     my $response = $ua->get($url);
 172     unless ($response->content_type =~ /xml/) {
 173         return;
 174     }
 175
 176     my $content = $response->content;
 177     warn "could not retrieve $url" unless $content;
 178     my $xmlsimple = XML::Simple->new();
 179     $response = $xmlsimple->XMLin(
 180         $content,
 181         forcearray => [ qw(Fld520) ],
 182     ) unless !$content;
 183     # manipulate response USMARC VarFlds VarDFlds Notes Fld520 a
 184     my $excerpt;
 185     $excerpt = \@{$response->{VarFlds}->{VarDFlds}->{Notes}->{Fld520}} if $response;
 186     return XMLout($excerpt, NoEscape => 1) if $excerpt;
 187 }
 188
 189 sub get_syndetics_reviews {
 190     my ( $isbn,$upc,$oclc,$syndetics_elements ) = @_;
 191
 192     # grab the AWSAccessKeyId: mine is '0V5RRRRJZ3HR2RQFNHR2'
 193     my $syndetics_client_code = C4::Context->preference('SyndeticsClientCode');
 194     my @reviews;
 195     my $review_sources = [
 196     {title => 'Library Journal Review', file => 'LJREVIEW.XML', element => 'LJREVIEW'},
 197     {title => 'Publishers Weekly Review', file => 'PWREVIEW.XML', element => 'PWREVIEW'},
 198     {title => 'School Library Journal Review', file => 'SLJREVIEW.XML', element => 'SLJREVIEW'},
 199     {title => 'CHOICE Review', file => 'CHREVIEW.XML', element => 'CHREVIEW'},
 200     {title => 'Booklist Review', file => 'BLREVIEW.XML', element => 'BLREVIEW'},
 201     {title => 'Horn Book Review', file => 'HBREVIEW.XML', element => 'HBREVIEW'},
 202     {title => 'Kirkus Book Review', file => 'KIREVIEW.XML', element => 'KIREVIEW'},
 203     {title => 'Criticas Review', file => 'CRITICASREVIEW.XML', element => 'CRITICASREVIEW'},
 204     {title => 'Spanish Review', file => 'SPREVIEW.XML', element => 'SPREVIEW'},
 205     ];
 206
 207     for my $source (@$review_sources) {
 208         if ($syndetics_elements->{$source->{element}} and $source->{element} =~ $syndetics_elements->{$source->{element}}) {
 209
 210         } else {
 211             #warn "Skipping $source->{element} doesn't match $syndetics_elements->{$source->{element}} \n";
 212             next;
 213         }
 214         my $url = "http://www.syndetics.com/index.aspx?isbn=$isbn/$source->{file}&client=$syndetics_client_code&type=xw10&upc=$upc&oclc=$oclc";
 215
 216         my $ua = LWP::UserAgent->new;
 217         $ua->timeout(10);
 218         $ua->env_proxy;
 219
 220         my $response = $ua->get($url);
 221         unless ($response->content_type =~ /xml/) {
 222             next;
 223         }
 224
 225         my $content = $response->content;
 226         warn "could not retrieve $url" unless $content;
 227
 228         eval {
 229             my $doc = $parser->parse_string($content);
 230
 231             # note that using findvalue strips any HTML elements embedded
 232             # in that review.  That helps us handle slight differences
 233             # in the output provided by Syndetics 'old' and 'new' versions
 234             # of their service and cleans any questionable HTML that
 235             # may be present in the reviews, but does mean that any
 236             # <B> and <I> tags used to format the review are also gone.
 237             my $result = $doc->findvalue('//Fld520');
 238             push @reviews, {title => $source->{title}, reviews => [ { content => $result } ]} if $result;
 239         };
 240         if ($@) {
 241             warn "Error parsing response from $url";
 242         }
 243     }
 244     return \@reviews;
 245 }
 246
 247 sub get_syndetics_editions {
 248     my ( $isbn,$upc,$oclc ) = @_;
 249
 250     # grab the AWSAccessKeyId: mine is '0V5RRRRJZ3HR2RQFNHR2'
 251     my $syndetics_client_code = C4::Context->preference('SyndeticsClientCode');
 252
 253     my $url = "http://www.syndetics.com/index.aspx?isbn=$isbn/FICTION.XML&client=$syndetics_client_code&type=xw10&upc=$upc&oclc=$oclc";
 254     my $ua = LWP::UserAgent->new;
 255     $ua->timeout(10);
 256     $ua->env_proxy;
 257
 258     my $response = $ua->get($url);
 259     unless ($response->content_type =~ /xml/) {
 260         return;
 261     }
 262
 263     my $content = $response->content;
 264
 265     warn "could not retrieve $url" unless $content;
 266     my $xmlsimple = XML::Simple->new();
 267     $response = $xmlsimple->XMLin(
 268         $content,
 269         forcearray => [ qw(Fld020) ],
 270     ) unless !$content;
 271     # manipulate response USMARC VarFlds VarDFlds Notes Fld520 a
 272     my $similar_items;
 273     $similar_items = \@{$response->{VarFlds}->{VarDFlds}->{NumbCode}->{Fld020}} if $response;
 274     return $similar_items if $similar_items;
 275 }
 276
 277 sub get_syndetics_anotes {
 278     my ( $isbn,$upc,$oclc) = @_;
 279
 280     # grab the AWSAccessKeyId: mine is '0V5RRRRJZ3HR2RQFNHR2'
 281     my $syndetics_client_code = C4::Context->preference('SyndeticsClientCode');
 282
 283     my $url = "http://www.syndetics.com/index.aspx?isbn=$isbn/ANOTES.XML&client=$syndetics_client_code&type=xw10&upc=$upc&oclc=$oclc";
 284     my $ua = LWP::UserAgent->new;
 285     $ua->timeout(10);
 286     $ua->env_proxy;
 287
 288     my $response = $ua->get($url);
 289     unless ($response->content_type =~ /xml/) {
 290         return;
 291     }
 292
 293     my $content = $response->content;
 294
 295     warn "could not retrieve $url" unless $content;
 296     my $xmlsimple = XML::Simple->new();
 297     $response = $xmlsimple->XMLin(
 298         $content,
 299         forcearray => [ qw(Fld980) ],
 300         ForceContent => 1,
 301     ) unless !$content;
 302     my @anotes;
 303     for my $fld980 (@{$response->{VarFlds}->{VarDFlds}->{SSIFlds}->{Fld980}}) {
 304         # this is absurd, but sometimes this data serializes differently
 305         if(ref($fld980->{a}->{content}) eq 'ARRAY') {
 306             for my $content (@{$fld980->{a}->{content}}) {
 307                 push @anotes, {content => $content};
 308
 309             }
 310         }
 311         else {
 312             push @anotes, {content => $fld980->{a}->{content}};
 313         }
 314     }
 315     return \@anotes;
 316 }
 317
 318 1;
 319 __END__
 320
 321 =head1 NOTES
 322
 323 =head1 AUTHOR
 324
 325 Joshua Ferraro <jmf@liblime.com>
 326
 327 =cut