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
1
1
1
1
249
2
12
use XML::Simple;
21
1
1
1
1
15
0
0
use LWP::Simple;
22# use LWP::UserAgent;
23
1
1
1
1
403
6
64
use HTTP::Request::Common;
24
1
1
1
1
9
5
15
use C4::Context;
25
1
1
1
1
8
5
101
use C4::Debug;
26
27
1
1
1
1
9
5
25
use strict;
28
1
1
1
1
8
5
46
use warnings;
29
30
1
1
1
1
9
6
162
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
31
1
1
1
1
8
5
108
use vars qw($user $pass $agent $image_url $link_url);
32
33BEGIN {
34
1
1
9
        require Exporter;
35
1
5
        $VERSION = 0.01;
36
1
43
        @ISA = qw(Exporter);
37
1
5
        @EXPORT_OK = qw(&availability &content_cafe &image_url &link_url &http_jacket_link);
38
1
1015
        %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