File Coverage

File:C4/External/BakerTaylor.pm
Coverage:28.6%

linestmtbrancondsubtimecode
1package C4::External::BakerTaylor;
2# Copyright (C) 2008 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
2
2
2
2
11141
4
42
use XML::Simple;
21
2
2
2
2
130
3
24
use LWP::Simple;
22# use LWP::UserAgent;
23
2
2
2
2
964
3
172
use HTTP::Request::Common;
24
2
2
2
2
10
3
20
use C4::Context;
25
2
2
2
2
9
3
191
use C4::Debug;
26
27
2
2
2
2
8
4
59
use strict;
28
2
2
2
2
8
4
114
use warnings;
29
30
2
2
2
2
8
3
209
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
31
2
2
2
2
9
3
284
use vars qw($user $pass $agent $image_url $link_url);
32
33BEGIN {
34
2
2
10
        require Exporter;
35
2
3
        $VERSION = 0.01;
36
2
21
        @ISA = qw(Exporter);
37
2
8
        @EXPORT_OK = qw(&availability &content_cafe &image_url &link_url &http_jacket_link);
38
2
2010
        %EXPORT_TAGS = (all=>\@EXPORT_OK);
39}
40INIT {
41        &initialize;
42}
43
44sub initialize {
45
0
0
0
0
        $user = (@_ ? shift : C4::Context->preference('BakerTaylorUsername') ) || ''; # LL17984
46
0
0
0
        $pass = (@_ ? shift : C4::Context->preference('BakerTaylorPassword') ) || ''; # CC82349
47
0
0
        $link_url = (@_ ? shift : C4::Context->preference('BakerTaylorBookstoreURL'));
48
0
        $image_url = "http://contentcafe2.btol.com/ContentCafe/Jacket.aspx?UserID=$user&Password=$pass&Options=Y&Return=T&Type=S&Value=";
49
0
        $agent = "Koha/$VERSION [en] (Linux)";
50                        #"Mozilla/4.76 [en] (Win98; U)", # if for some reason you want to go stealth, you might prefer this
51}
52
53sub image_url (;$) {
54
0
0
0
0
        ($user and $pass) or return undef;
55
0
0
        my $isbn = (@_ ? shift : '');
56
0
        $isbn =~ s/(p|-)//g; # sanitize
57
0
        return $image_url . $isbn;
58}
59sub link_url (;$) {
60
0
0
0
        my $isbn = (@_ ? shift : '');
61
0
        $isbn =~ s/(p|-)//g; # sanitize
62
0
0
        $link_url or return undef;
63
0
        return $link_url . $isbn;
64}
65sub content_cafe_url ($) {
66
0
0
0
0
        ($user and $pass) or return undef;
67
0
0
        my $isbn = (@_ ? shift : '');
68
0
        $isbn =~ s/(p|-)//g; # sanitize
69
0
        return "http://contentcafe2.btol.com/ContentCafeClient/ContentCafe.aspx?UserID=$user&Password=$pass&Options=Y&ItemKey=$isbn";
70}
71sub http_jacket_link ($) {
72
0
0
0
        my $isbn = shift or return undef;
73
0
        $isbn =~ s/(p|-)//g; # sanitize
74
0
        my $image = availability($isbn);
75
0
        my $alt = "Buy this book";
76
0
0
        $image and $image = qq(<img class="btjacket" alt="$alt" src="$image" />);
77
0
        my $link = &link_url($isbn);
78
0
0
0
0
        unless ($link) {return $image || '';}
79
0
0
        return sprintf qq(<a class="btlink" href="%s">%s</a>),$link,($image||$alt);
80}
81
82sub availability ($) {
83
0
0
0
        my $isbn = shift or return undef;
84
0
0
0
        ($user and $pass) or return undef;
85
0
        $isbn =~ s/(p|-)//g; # sanitize
86
0
        my $url = "http://contentcafe2.btol.com/ContentCafe/InventoryAvailability.asmx/CheckInventory?UserID=$user&Password=$pass&Value=$isbn";
87
0
0
        $debug and warn __PACKAGE__ . " request:\n$url\n";
88
0
        my $content = get($url);
89
0
0
        $debug and print STDERR $content, "\n";
90
0
0
        warn "could not retrieve $url" unless $content;
91
0
        my $xmlsimple = XML::Simple->new();
92
0
        my $result = $xmlsimple->XMLin($content);
93
0
0
        if ($result->{Error}) {
94
0
                warn "Error returned to " . __PACKAGE__ . " : " . $result->{Error};
95        }
96
0
        my $avail = $result->{Availability};
97
0
0
0
        return ($avail and $avail !~ /^false$/i) ? &image_url($isbn) : 0;
98}
99
1001;
101