WebService::ISBNDB::API::Books - Data class for book information

    use WebService::ISBNDB::API::Books;

    my $book = WebService::ISBNDB::API->new({ api_key => $key,
                                              isbn => '0596002068' });

    $perlbooks = WebService::ISBNDB::API::Books->
                     search({ title => "perl" });

    $poebooks = WebService::ISBNDB::API::Books->
                    search({ author => 'edgar allan poe' });

    $pwswp = WebService::ISBNDB::API::Books->find('0596002068');

###############################################################################
#
# This file copyright (c) 2006-2008 by Randy J. Ray, all rights reserved
#
# See "LICENSE" in the documentation for licensing and redistribution terms.
#
###############################################################################
#
#   $Id: Books.pm 48 2008-04-06 10:38:11Z  $
#
#   Description:    Specialization of the API class for book data.
#
#   Functions:      BUILD
#                   copy
#                   find
#                   get_authors
#                   set_authors
#                   get_subjects
#                   set_subjects
#                   new
#                   set_id
#                   set_isbn
#                   get_publisher
#                   normalize_args
#                   set_change_time
#                   set_change_time_sec
#                   set_price_time
#                   set_price_time_sec
#                   set_prices
#                   set_marc
#
#   Libraries:      Class::Std
#                   Error
#                   Business::ISBN
#                   WebService::ISBNDB::API
#
#   Global Consts:  $VERSION
#
###############################################################################

package WebService::ISBNDB::API::Books;

use 5.006;
use strict;
use warnings;
no warnings 'redefine';
use vars qw($VERSION $CAN_PARSE_DATES);
use base 'WebService::ISBNDB::API';

use Class::Std;
use Error;
use Business::ISBN;

$VERSION = "0.33";

BEGIN
{
    eval "use Date::Parse";
    $CAN_PARSE_DATES = ($@) ? 0 : 1;
}

# Attributes for the Books class
my %id             : ATTR(:get<id>   :init_arg<id>             :default<>);
my %isbn           : ATTR(:get<isbn> :init_arg<isbn>           :default<>);
my %title          : ATTR(:name<title>                         :default<>);
my %longtitle      : ATTR(:name<longtitle>                     :default<>);
my %authors_text   : ATTR(:name<authors_text>                  :default<>);
my %authors        : ATTR(:init_arg<authors>                   :default<>);
my %publisher_text : ATTR(:name<publisher_text>                :default<>);
my %publisher      : ATTR(:init_arg<publisher> :set<publisher> :default<>);
my %subjects       : ATTR(:init_arg<subjects>                  :default<>);
my %dewey_decimal  : ATTR(:name<dewey_decimal>                 :default<>);
my %dewey_decimal_normalized : ATTR(:name<dewey_decimal_normalized> :default<>);
my %lcc_number     : ATTR(:name<lcc_number>                    :default<>);
my %language       : ATTR(:name<language>                      :default<>);
my %physical_description_text : ATTR(:name<physical_description_text> :default<>);
my %edition_info   : ATTR(:name<edition_info>                  :default<>);
my %change_time    : ATTR(:init_arg<change_time> :get<change_time> :default<>);
my %change_time_sec : ATTR(:init_arg<change_time_sec> :get<change_time_sec> :default<>);
my %price_time     : ATTR(:init_arg<price_time> :get<price_time> :default<>);
my %price_time_sec : ATTR(:init_arg<price_time_sec> :get<price_time_sec> :default<>);
my %summary        : ATTR(:name<summary>                       :default<>);
my %notes          : ATTR(:name<notes>                         :default<>);
my %urlstext       : ATTR(:name<urlstext>                      :default<>);
my %awardstext     : ATTR(:name<awardstext>                    :default<>);
my %prices         : ATTR(:init_arg<prices> :get<prices>       :default<>);
my %marc           : ATTR(:init_arg<marc>   :get<marc>         :default<>);

###############################################################################
#
#   Sub Name:       new
#
#   Description:    Pass off to the super-class constructor, which handles
#                   the special cases for arguments.
#
###############################################################################
sub new
{
    shift->SUPER::new(@_);
}

###############################################################################
#
#   Sub Name:       BUILD
#
#   Description:    Builder for this class. See Class::Std.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $id       in      scalar    This object's unique ID
#                   $args     in      hashref   The set of arguments currently
#                                                 being considered for the
#                                                 constructor.
#
#   Returns:        Success:    void
#                   Failure:    throws Error::Simple
#
###############################################################################
sub BUILD
{
    my ($self, $id, $args) = @_;

    $self->set_type('Books');

    if ($CAN_PARSE_DATES)
    {
        $args->{change_time_sec} = str2time($args->{change_time})
            if ($args->{change_time} and ! $args->{change_time_sec});
        $args->{price_time_sec} = str2time($args->{price_time})
            if ($args->{price_time} and ! $args->{price_time_sec});
    }

    return;
}

###############################################################################
#
#   Sub Name:       find
#
#   Description:    Find a single record using the passed-in search criteria.
#                   Most of the work is done by the super-class: this method
#                   turns a single-argument call into a proper hashref, and/or
#                   turns user-supplied arguments into those recognized by the
#                   API.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $args     in      variable  See text
#
#   Returns:        Success:    result from SUPER::find
#                   Failure:    throws Error::Simple
#
###############################################################################
sub find
{
    my ($self, $args) = @_;

    # First, see if we were passed a single scalar for an argument. If so, it
    # needs to become either an ISBN or title argument.
    if (! ref($args))
    {
        my $obj;
        if (ref($obj = Business::ISBN->new($args)) and
            $obj->is_valid_checksum() eq Business::ISBN::GOOD_ISBN)
        {
            $args = { isbn => $args };
        }
        else
        {
            $args = { book_id => $args };
        }
    }

    $self->SUPER::find($args);
}

###############################################################################
#
#   Sub Name:       normalize_args
#
#   Description:    Normalize the contents of the $args hash reference, turning
#                   the user-visible (and user-friendlier) arguments into the
#                   arguments that the API expects.
#
#                   Also adds some "results" values, to tailor the returned
#                   content.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $class    in      scalar    Object ref or class name
#                   $args     in      hashref   Reference to the arguments hash
#
#   Returns:        Success:    $args (changed)
#                   Failure:    throws Error::Simple
#
###############################################################################
sub normalize_args
{
    my ($class, $args) = @_;

    my ($key, $value, @keys, $count, $results, %seen);

    # Turn the collection of arguments into a set that the isbndb.com API can
    # use. Each key/value pair has to become a pair of the form "indexX" and
    # "valueX". Some keys, like author and publisher, have to be handled with
    # more attention.
    @keys = keys %$args;
    $count = 0; # Used to gradually increment the "indexX" and "valueX" keys
    foreach $key (@keys)
    {
        # If we see "api_key", it means that WebService::ISBNDB::API::search
        # curried it into the arglist due to the type-level search being
        # called as a static method.
        next if $key eq 'api_key';
        $value = $args->{$key};
        delete $args->{$key};
        $count++;

        # If the key is 'author', it may be a name or an Authors object. If it
        # is not an object, it has to become a "full" key, which is very non-
        # specific.
        if ($key eq 'author')
        {
            if (ref $value)
            {
                if ($value->isa('WebService::ISBNDB::API::Authors'))
                {
                    $args->{"index$count"} = 'person_id';
                    $args->{"value$count"} = $value->get_id;
                }
                else
                {
                    throw Error::Simple("Value for argument '$key' must be " .
                                        'string or ' .
                                        'WebService::ISBNDB::API::Authors' .
                                        ' derivative');
                }
            }
            else
            {
                $args->{"index$count"} = 'combined';
                $args->{"value$count"} = $value;
            }

            next;
        }

        # If the key is 'publisher', treat the same as with author
        if ($key eq 'publisher')
        {
            if (ref $value)
            {
                if ($value->isa('WebService::ISBNDB::API::Publishers'))
                {
                    $args->{"index$count"} = 'publisher_id';
                    $args->{"value$count"} = $value->get_id;
                }
                else
                {
                    throw Error::Simple("Value for argument '$key' must be " .
                                        'string or ' .
                                        'WebService::ISBNDB::API::Publishers' .
                                        ' derivative');
                }
            }
            else
            {
                $args->{"index$count"} = 'combined';
                $args->{"value$count"} = $value;
            }

            next;
        }

        # A subject can be an object or an ID.
        if ($key eq 'subject')
        {
            if (ref $value)
            {
                if ($value->isa('WebService::ISBNDB::API::Subjects'))
                {
                    $args->{"index$count"} = 'subject_id';
                    $args->{"value$count"} = $value->get_id;
                }
                else
                {
                    throw Error::Simple("Value for argument '$key' must be " .
                                        'string or ' .
                                        'WebService::ISBNDB::API::Subjects ' .
                                        'derivative');
                }
            }
            else
            {
                $args->{"index$count"} = 'subject_id';
                $args->{"value$count"} = $value;
            }

            next;
        }

        # These are the only other allowed search-keys
        if ($key =~
            /^(:?dewey_decimal|lcc_number|full|combined|title|isbn|book_id)$/)
        {
            $args->{"index$count"} = $key;
            $args->{"value$count"} = $value;

            next;
        }

        throw Error::Simple("'$key' is not a valid search-key for books");
    }

    # Add the "results" values that we want
    $args->{results} = [ qw(details prices marc texts subjects authors) ];

    $args;
}

###############################################################################
#
#   Sub Name:       set_id
#
#   Description:    Set the ID attribute on the object. Done manually so that
#                   we can restrict it to this package.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $id       in      scalar    ID, taken from isbndb.com data
#
#   Globals:        %id
#
#   Returns:        $self
#
###############################################################################
sub set_id : RESTRICTED
{
    my ($self, $id) = @_;

    $id{ident $self} = $id;
    $self;
}

###############################################################################
#
#   Sub Name:       set_isbn
#
#   Description:    Set the ISBN for this object. Tests the new value before
#                   assigning it.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $isbn     in      scalar    New ISBN value
#
#   Globals:        %isbn
#
#   Returns:        Success:    $self
#                   Failure:    throws Error::Simple
#
###############################################################################
sub set_isbn
{
    my ($self, $isbn) = @_;

    throw Error::Simple("The value '$isbn' is not a valid ISBN")
        unless (Business::ISBN->new($isbn)->is_valid_checksum eq
                Business::ISBN::GOOD_ISBN);
    $isbn{ident $self} = $isbn;

    $self;
}

###############################################################################
#
#   Sub Name:       get_publisher
#
#   Description:    Retrieve the "publisher" attribute for this object. If the
#                   value is a string rather than a reference, assume that it
#                   is an ID, and fetch the actual Publisher object before
#                   returning the value.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#
#   Globals:        %publisher
#
#   Returns:        Success:    Publisher object
#                   Failure:    throws Error::Simple
#
###############################################################################
sub get_publisher
{
    my $self = shift;

    my $id = ident $self;

    my $publisher = $publisher{$id};
    unless (ref $publisher)
    {
        my $class = $self->class_for_type('Publishers');
        # Make sure it's loaded
        eval "require $class;";
        $publisher = $class->find({ publisher_id => $publisher });
        $publisher{$id} = $publisher;
    }

    $publisher;
}

###############################################################################
#
#   Sub Name:       set_authors
#
#   Description:    Set the list of Authors objects for this instance. The list
#                   will initially be a list of IDs, taken from the attributes
#                   of the XML. Only upon read-access (via get_authors) will
#                   the list be turned into real objects.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $list     in      ref       List-reference of author data
#
#   Globals:        %authors
#
#   Returns:        Success:    $self
#                   Failure:    throws Error::Simple
#
###############################################################################
sub set_authors
{
    my ($self, $list) = @_;

    throw Error::Simple("Argument to 'set_authors' must be a list reference")
        unless (ref($list) eq 'ARRAY');

    # Make a copy of the list
    $authors{ident $self} = [ @$list ];

    $self;
}

###############################################################################
#
#   Sub Name:       get_authors
#
#   Description:    Return a list-reference of the authors of the book. If this
#                   is the first such request, then the author values are going
#                   to be scalars, not objects, and must be converted to
#                   objects before being returned.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#
#   Globals:        %authors
#
#   Returns:        Success:    list-reference of data
#                   Failure:    throws Error::Simple
#
###############################################################################
sub get_authors
{
    my $self = shift;

    my $authors = $authors{ident $self};

    # If the first element is not a reference, we need to transform the list
    if (grep(! ref($_), @$authors))
    {
        my $class = $self->class_for_type('Authors');
        # Make sure it's loaded
        eval "require $class;";
        my $auth_id;

        for (0 .. $#$authors)
        {
            unless (ref($auth_id = $authors->[$_]))
            {
                throw Error::Simple("No author found for ID '$auth_id'")
                    unless ref($authors->[$_] = $class->find({ id =>
                                                               $auth_id }));
            }
        }
    }

    # Make a copy, so the real reference doesn't get altered
    [ @$authors ];
}

###############################################################################
#
#   Sub Name:       set_subjects
#
#   Description:    Set the list of Subjects objects for this instance. The
#                   list will initially be a list of IDs, taken from the
#                   attributes of the XML. Only upon read-access (via
#                   get_subjects) will the list be turned into real objects.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $list     in      ref       List-reference of category data
#
#   Globals:        %subjects
#
#   Returns:        Success:    $self
#                   Failure:    throws Error::Simple
#
###############################################################################
sub set_subjects
{
    my ($self, $list) = @_;

    throw Error::Simple("Argument to 'set_subjects' must be a list reference")
        unless (ref($list) eq 'ARRAY');

    # Make a copy of the list
    $subjects{ident $self} = [ @$list ];

    $self;
}

###############################################################################
#
#   Sub Name:       get_subjects
#
#   Description:    Return a list-reference of the book subjects. If this is
#                   the first such request, then the subject values are going
#                   to be scalars, not objects, and must be converted to
#                   objects before being returned.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#
#   Globals:        %subjects
#
#   Returns:        Success:    list-reference of data
#                   Failure:    throws Error::Simple
#
###############################################################################
sub get_subjects
{
    my $self = shift;

    my $subjects = $subjects{ident $self};

    # If any element is not a reference, we need to transform the list
    if (grep(! ref($_), @$subjects))
    {
        my $class = $self->class_for_type('Subjects');
        # Make sure it's loaded
        eval "require $class;";
        my $subj_id;

        for (0 .. $#$subjects)
        {
            unless (ref($subj_id = $subjects->[$_]))
            {
                throw Error::Simple("No subject found for ID '$subj_id'")
                    unless ref($subjects->[$_] = $class->find({ id =>
                                                                $subj_id }));
            }
        }
    }

    # Make a copy, so the real reference doesn't get altered
    [ @$subjects ];
}

###############################################################################
#
#   Sub Name:       set_change_time
#
#   Description:    Set the change_time value; also update change_time_sec if
#                   $CAN_PARSE_DATES is true.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $time     in      scalar    Time-string
#
#   Globals:        $CAN_PARSE_DATES
#                   %change_time
#                   %change_time_sec
#
#   Returns:        $self
#
###############################################################################
sub set_change_time
{
    my ($self, $time) = @_;
    my $id = ident $self;

    $change_time{$id} = $time;
    $change_time_sec{$id} = str2time($time) if $CAN_PARSE_DATES;

    $self;
}

###############################################################################
#
#   Sub Name:       set_change_time_sec
#
#   Description:    Set the change_time_sec value; also updates change_time.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $time     in      scalar    Time, in seconds
#
#   Globals:        %change_time
#                   %change_time_sec
#
#   Returns:        $self
#
###############################################################################
sub set_change_time_sec
{
    my ($self, $time) = @_;
    my $id = ident $self;

    $change_time_sec{$id} = $time;
    my @parts = localtime $time;
    $change_time{$id} = sprintf("%4d-%02d-%02dT%02d:%02d:%02dZ",
                                $parts[5] + 1900, # year
                                $parts[4] + 1,    # month
                                $parts[3],        # day
                                @parts[2,1,0]);   # hours, mins, secs

    $self;
}

###############################################################################
#
#   Sub Name:       set_price_time
#
#   Description:    Set the price_time value; also update price_time_sec if
#                   $CAN_PARSE_DATES is true.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $time     in      scalar    Time-string
#
#   Globals:        $CAN_PARSE_DATES
#                   %price_time
#                   %price_time_sec
#
#   Returns:        $self
#
###############################################################################
sub set_price_time
{
    my ($self, $time) = @_;
    my $id = ident $self;

    $price_time{$id} = $time;
    $price_time_sec{$id} = str2time($time) if $CAN_PARSE_DATES;

    $self;
}

###############################################################################
#
#   Sub Name:       set_price_time_sec
#
#   Description:    Set the price_time_sec value; also updates price_time.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $time     in      scalar    Time, in seconds
#
#   Globals:        %price_time
#                   %price_time_sec
#
#   Returns:        $self
#
###############################################################################
sub set_price_time_sec
{
    my ($self, $time) = @_;
    my $id = ident $self;

    $price_time_sec{$id} = $time;
    my @parts = localtime $time;
    $price_time{$id} = sprintf("%4d-%02d-%02dT%02d:%02d:%02dZ",
                               $parts[5] + 1900, # year
                               $parts[4] + 1,    # month
                               $parts[3],        # day
                               @parts[2,1,0]);   # hours, mins, secs

    $self;
}

###############################################################################
#
#   Sub Name:       set_prices
#
#   Description:    Set new data for the price information. Checks that the
#                   passed-in value is a list-ref, and that all elements are
#                   hash refs.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $prices   in      listref   New price data
#
#   Globals:        %prices
#
#   Returns:        Success:    $self
#                   Failure:    throws Error::Simple
#
###############################################################################
sub set_prices
{
    my ($self, $prices) = @_;

    throw Error::Simple('Argument to "set_prices" must be an array reference')
        unless (ref($prices) eq 'ARRAY');
    throw Error::Simple('All elements of the array ref to "set_prices" must ' .
                        'be hash references')
        if (grep(ref($_) ne 'HASH', @$prices));
    $prices{ident $self} = _copy_aoh($prices);

    $self;
}

###############################################################################
#
#   Sub Name:       set_marc
#
#   Description:    Set new data for the MARC information. Checks that the
#                   passed-in value is a list-ref, and that all elements are
#                   hash refs.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $marc     in      listref   New MARC data
#
#   Globals:        %marc
#
#   Returns:        Success:    $self
#                   Failure:    throws Error::Simple
#
###############################################################################
sub set_marc
{
    my ($self, $marc) = @_;

    throw Error::Simple('Argument to "set_marc" must be an array reference')
        unless (ref($marc) eq 'ARRAY');
    throw Error::Simple('All elements of the array ref to "set_marc" must ' .
                        'be hash references')
        if (grep(ref($_) ne 'HASH', @$marc));
    $marc{ident $self} = _copy_aoh($marc);

    $self;
}

###############################################################################
#
#   Sub Name:       copy
#
#   Description:    Copy the Books-specific attributes over from target object
#                   to caller.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object
#                   $target   in      ref       Object of the same class
#
#   Globals:        %id
#                   %isbn
#                   %title
#                   %longtitle
#                   %authors
#                   %authors_text
#                   %publisher
#                   %publisher_text
#                   %subjects
#                   %dewey_decimal
#                   %dewey_decimal_normalized
#                   %lcc_number
#                   %language
#                   %physical_description_text
#                   %edition_info
#                   %change_time
#                   %change_time_sec
#                   %price_time
#                   %price_time_sec
#                   %summary
#                   %notes
#                   %urlstext
#                   %awardstext
#                   %prices
#                   %marc
#
#   Returns:        Success:    void
#                   Failure:    throws Error::Simple
#
###############################################################################
sub copy : CUMULATIVE
{
    my ($self, $target) = @_;

    throw Error::Simple("Argument to 'copy' must be the same class as caller")
        unless (ref($self) eq ref($target));

    my $id1 = ident $self;
    my $id2 = ident $target;

    # Do the simple (scalar) attributes first
    $id{$id1}                        = $id{$id2};
    $isbn{$id1}                      = $isbn{$id2};
    $title{$id1}                     = $title{$id2};
    $longtitle{$id1}                 = $longtitle{$id2};
    $authors_text{$id1}              = $authors_text{$id2};
    $publisher_text{$id1}            = $publisher_text{$id2};
    $publisher{$id1}                 = $publisher{$id2};
    $dewey_decimal{$id1}             = $dewey_decimal{$id2};
    $dewey_decimal_normalized{$id1}  = $dewey_decimal_normalized{$id2};
    $lcc_number{$id1}                = $lcc_number{$id2};
    $language{$id1}                  = $language{$id2};
    $physical_description_text{$id1} = $physical_description_text{$id2};
    $edition_info{$id1}              = $edition_info{$id2};
    $change_time{$id1}               = $change_time{$id2};
    $change_time_sec{$id1}           = $change_time_sec{$id2};
    $price_time{$id1}                = $price_time{$id2};
    $price_time_sec{$id1}            = $price_time_sec{$id2};
    $summary{$id1}                   = $summary{$id2};
    $notes{$id1}                     = $notes{$id2};
    $urlstext{$id1}                  = $urlstext{$id2};
    $awardstext{$id1}                = $awardstext{$id2};

    # Each of these must be tested, and references copied by value
    $authors{$id1}  = [ @{$authors{$id2}}  ]   if ref($authors{$id2});
    $subjects{$id1} = [ @{$subjects{$id2}} ]   if ref($subjects{$id2});
    $prices{$id1}   = _copy_aoh($prices{$id2}) if ref($prices{$id2});
    $marc{$id1}     = _copy_aoh($marc{$id2})   if ref($marc{$id2});

    return;
}

# Copy the array-of-hashrefs and return the new
sub _copy_aoh
{
    my $list = shift;

    my $new = [];
    for (@$list)
    {
        push(@$new, { %$_ });
    }

    $new;
}

1;