File Coverage

blib/lib/Object/eBay.pm

Criterion	Covered	Total	%
statement	52	112	46.4
branch	4	42	9.5
condition	1	14	7.1
subroutine	14	21	66.6
pod	8	9	88.8
total	79	198	39.9

package Object::eBay;
our $VERSION = '0.5.1';

use Class::Std; {
    use warnings;
    use strict;
    use Carp;
    use Scalar::Util qw( blessed );

    my $net_ebay;           # holds a singleton object
    my %details_for :ATTR;
    my %inputs_for  :ATTR( :get );  # inputs to the API call

    sub init {
        my ($pkg, $net_ebay_object) = @_;
        croak "init() requires a valid Net::eBay object"
            if !defined $net_ebay_object;
        $net_ebay = $net_ebay_object;
    }

    sub BUILD {
        my ($self, $ident, $args_ref) = @_;

        my $object_details = delete $args_ref->{object_details};
        my $needs_methods = delete $args_ref->{needs_methods} || [];
        $inputs_for{$ident} = $self->_convert_args($args_ref);

        for my $method_name (@$needs_methods) {
            $self->_add_inputs( $self->$method_name(':meta') );
        }

        $details_for{$ident} = $object_details if $object_details;
    }
    sub _convert_args {
        my ($self, $args) = @_;

        my %new_args;
        for my $method_name (keys %$args) {
            my $ebay_name = $self->method_name_to_ebay_name($method_name);
            $new_args{$ebay_name} = $args->{$method_name};
        }

        return \%new_args;
    }
    sub _add_inputs {
        my ($self, $meta) = @_;
        my $ident = ident $self;

        # handle each extra input
        for my $input ( grep { /\A[A-Z]/ } keys %$meta ) {
            my $new_value = $meta->{$input};

            # handle conflicts
            # TODO allow conflict resolution to be specified by subclasses
            if ( exists $inputs_for{$ident}{$input} ) {
                my $old_value = $inputs_for{$ident}{$input};
                croak "Conflicting $input: '$old_value' and '$new_value'"
                    if $input ne 'DetailLevel';
                $new_value = 'ReturnAll';
            }

            $inputs_for{$ident}{$input} = $new_value;
        }
    }
    sub _make_datetime {
        my ($self, $iso) = @_;
        require DateTime;
        my ($y, $m, $d, $h, $min, $s) = split /[-T:.]/, $iso;
        return DateTime->new(
            year      => $y,
            month     => $m,
            day       => $d,
            hour      => $h,
            minute    => $min,
            second    => $s,
            time_zone => 'UTC',
        );
    }

    ##########################################################################
    # Usage     : $method_name = Object::eBay->ebay_name_to_method_name($name)
    # Purpose   : Convert eBay names into method names
    # Returns   : a method name equivalent to the given eBay name
    # Arguments : $name - an eBay name such as (Title or SellingStatus)
    # Throws    : no exceptions
    # Comments  : none
    # See Also  : n/a
    sub ebay_name_to_method_name {
        my ($pkg, $ebay_name) = @_;
        return $ebay_name if !$ebay_name;
        $ebay_name =~ s{
            ([[:lower:]])   # lower case letter
            ([[:upper:]])   # followed by an upper case letter
        }{$1_\l$2}xmsg;
        return lc $ebay_name;
    }


    #########################################################################
    # Usage     : $ebay_name = Object::eBay->method_name_to_ebay_name($name)
    # Purpose   : Convert a method name into an eBay name
    # Returns   : an ebay name equivalent to the given method name
    # Arguments : $name - a method name such as (title or selling_status)
    # Throws    : no exceptions
    # Comments  : none
    # See Also  : n/a
    sub method_name_to_ebay_name {
        my ($pkg, $method_name) = @_;

        my $ebay_name = join('',
            map  { $_ eq 'id' ? uc : ucfirst }
            split(/_/, $method_name)
        );
        return $ebay_name;
    }

    ##########################################################################
    # Usage     : $result = Object::eBay->ask_ebay(
    #               'GetItem',
    #               { ItemID => 123455678 }
    #             );
    # Purpose   : dispatch an API call to eBay
    # Returns   : a hashref with eBay's response
    # Arguments : $api_call - the name of the eBay API call to make
    #             $inputs   - a hashref giving input fields for the API call
    # Throws    : "Unable to process the command ..."
    #             "eBay error (...): ..."
    # Comments  : throws an error if the API call couldn't be completed or
    #             if eBay returns an error value
    # See Also  : n/a
    sub ask_ebay {
        my ( $class, $command, $arguments ) = @_;

        my $result = $net_ebay->submitRequest( $command, $arguments );
        croak "Unable to process the command $command"
            if !$result;

        if ( exists $result->{Errors} ) {
            my $errors   = $result->{Errors};
            my $severity = $errors->{SeverityCode};
            if ( $severity ne 'Warning' ) {
                my $code     = $errors->{ErrorCode};
                my $message  = $errors->{LongMessage};
                croak "eBay error ($code): $message";
            }
        }

        return $result;
    }

    #########################################################################
    # Usage     : $details = $self->get_details()
    # Purpose   : Retrieves the details for this object from eBay and caches
    #             the results for later use.
    # Returns   : A hash reference representing the details (this is very
    #             similar to the result returned by Net::eBay::submitRequest
    # Arguments : none
    # Throws    : no exceptions
    # Comments  : none
    # See Also  : n/a
    sub get_details {
        my ($self) = @_;
        my $ident = ident $self;

        # look for a cached copy
        my $details = $details_for{$ident};
        return $details if $details;

        # otherwise, ask eBay for the details
        my $response = $self->ask_ebay(
            $self->api_call(),
            $self->api_inputs(),
        );

        # and cache the response
        return $details_for{$ident} = $response->{ $self->response_field() };
    }

    #############################################################################
    # Usage     : __PACKAGE__->simple_attributes('Title', 'Quantity')
    # Purpose   : Define simple attributes for an Object::eBay subclass
    # Returns   : none
    # Arguments : a list of method names to implement
    # Throws    : no exceptions
    # Comments  : none
    # See Also  : n/a
    sub simple_attributes {
        my ($pkg, @ebay_names) = @_;

        # install a method for each eBay name
        for my $ebay_name (@ebay_names) {
            no strict 'refs';
            my $method_name = $pkg->ebay_name_to_method_name($ebay_name);
            *{ $pkg . "::$method_name" } = sub {
                my ($self) = @_;
                my $value = eval { $self->get_details->{$ebay_name} };
                croak $@ if $@ && $@ =~ /\A eBay/xms;
                croak "Can't find '$ebay_name' via ${pkg}::$method_name()"
                    if !defined $value;
                return $value;
            };
        }
    }

    sub complex_attributes {
        my ($pkg, $args) = @_;

        while ( my ($ebay_name, $meta) = each %$args ) {
            no strict 'refs';
            my $method_name = $pkg->ebay_name_to_method_name($ebay_name);
            *{ $pkg . "::$method_name" } = sub {
                my ($self, $args) = @_;

                # return meta info if requested
                return $meta if $args && $args eq ':meta';

                my $value = eval { $self->get_details->{$ebay_name} };
                croak $@ if $@ && $@ =~ /\A eBay/xms;
                croak "Can't find '$ebay_name' via ${pkg}::$method_name()"
                    if !defined($value) and !$meta->{undefined_value_ok};

                return $value if blessed $value;  # already inflated the value

                # inflate value into an object
                if ( my $class_stub = $meta->{class} ) {
                    my $class = "Object::eBay::$class_stub";
                    $value = eval {
                        eval "require $class";
                        $class->new({ object_details => $value })
                    };
                    croak "Error inflating '$ebay_name': $@\n" if $@;
                    croak "Can't inflate '$ebay_name' via ${pkg}::$method_name()"
                        if !defined $value;
                    $self->get_details->{$ebay_name} = $value;
                    return $value;
                }
                elsif ( my $converter = $meta->{convert_value} ) {
                    croak "The value of 'convert_value' should be\n"
                        . "a code reference.\n" if ref($converter) ne 'CODE';
                    return $converter->($value);
                }

                return $value;
            };
        }
    }

    sub api_inputs { $_[0]->get_api_inputs() }
}

1;

__END__