The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package VendorAPI::2Checkout::Client::NoMoose;

use 5.006;
use strict;
use warnings;

use LWP::UserAgent;
use Params::Validate qw(:all);
use Carp qw(confess);
use URI;
use URI::QueryParam;

=head1 NAME

VendorAPI::2Checkout::Client::NoMoose - an non-Moose OO interface to the 2Checkout.com Vendor API

=head1 VERSION

Version 0.1502

=cut

use vars qw( $VERSION @ISA );

@ISA = ( 'VendorAPI::2Checkout::Client' );
$VERSION = '0.1502';

=head1 SYNOPSIS

    use VendorAPI::2Checkout::Client;

    my $tco = VendorAPI::2Checkout::Client->new($username, $password, $format);
    $response = $tco->list_sales();

    $response = $tco->detail_sale(sale_id => 1234554323);

    $response = $tco->list_coupons();

    $response = $tco->detail_coupon(coupon_code => 'COUPON42');

    $response = $tco->list_payments();

    $response = $tco->list_products();

    $response = $tco->list_options();

    ...

=head1 DESCRIPTION

This module is an OO interface to the 2Checkout.com Vendor API.

This modules uses Params::Validate which likes to die() when the parameters do not pass validation, so
wrap your code in evals, etc.

Presently implements list_sales(), detail_sale(), list_coupons(), and detail_coupon(), list_payments(),
list_options(), list_products().

Return data is in XML or JSON.

Please refer to L<2Checkout's Back Office Admin API Documentation|http://www.2checkout.com/documentation/api>
for input parameters and expexted return values.

=head1 CONSTRUCTORS AND METHODS

=over 4

=item $c = VendorAPI::2Checkout::Client->new($username, $password, $format)

Contructs a new C<VendorAPI::2Checkout::Client> object to comminuncate with the 2Checkout Back Office Admin API.
You must pass your Vendor API username and password or the constructor will return undef;

=cut

sub new {
   my $class    = shift;
   my $username = shift;
   my $password = shift;
   my $accept   = shift;

   unless ( $username && $password) {
      return undef;
   }

   unless ( defined $accept && $accept =~ qr/^(?:XML|JSON)$/) {
      $accept = 'XML';
   }

   my $self = bless {}, $class;
   my $ua = LWP::UserAgent->new( agent => "VendorAPI::2Checkout::Client/${VERSION}" );
   $ua->credentials($self->SUPER::_netloc(), $self->SUPER::_realm(), $username, $password);

   $self->{ua}     = $ua;
   $self->{accept} =  $self->mime_type($accept);
   return $self;
}

=item $response = $c->list_sales();

Retrieves the list of sales for the vendor

=cut

my $sort_col_re = qr/^(sale_id|date_placed|customer_name|recurring|recurring_declined|usd_total)$/;
my $sort_dir_re = qr/^(ASC|DESC)$/;

my %v = (
             sale_id             => { type => SCALAR, regex => qw/^\d+$/ , untaint => 1, optional => 1, },
             invoice_id          => { type => SCALAR, regex => qw/^\d+$/ , untaint => 1, optional => 1, },
             pagesize            => { type => SCALAR, regex => qw/^\d+$/ , untaint => 1, optional => 1, },
             cur_page            => { type => SCALAR, regex => qw/^\d+$/ , untaint => 1, optional => 1, },
             customer_name       => { type => SCALAR, regex => qw/^[-A-Za-z.]+$/ , untaint => 1, optional => 1, },
             customer_email      => { type => SCALAR, regex => qw/^[-\w.+@]+$/ , untaint => 1, optional => 1,   },
             customer_phone      => { type => SCALAR, regex => qw/^[\d()-]+$/ , untaint => 1, optional => 1,    },
             vendor_product_id   => { type => SCALAR, regex => qw/^.+$/ , untaint => 1, optional => 1,    },
             ccard_first6        => { type => SCALAR, regex => qw/^\d{6}$/ , untaint => 1, optional => 1, },
             ccard_last2         => { type => SCALAR, regex => qw/^\d\d$/ , untaint => 1, optional => 1,  },
             date_sale_end       => { type => SCALAR, regex => qw/^\d{4}-\d\d-\d\d$/ , untaint => 1, optional => 1, },
             date_sale_begin     => { type => SCALAR, regex => qw/^\d{4}-\d\d-\d\d$/ , untaint => 1, optional => 1, },
             sort_col            => { type => SCALAR, regex => $sort_col_re  , untaint => 1, optional => 1, },
             sort_dir            => { type => SCALAR, regex => $sort_dir_re , untaint => 1, optional => 1,  },
             active_recurrings   => { type => SCALAR, regex => qr/^[01]$/, untaint => 1, optional => 1, },
             declined_recurrings => { type => SCALAR, regex => qr/^[01]$/, untaint => 1, optional => 1, },
             refunded            => { type => SCALAR, regex => qr/^[01]$/, untaint => 1, optional => 1, },
        );

my $_profile = { map { $_ => $v{$_} } keys %v };

sub list_sales {
   my $self = shift;
   my $uri = URI->new($self->SUPER::_base_uri . '/sales/list_sales');
   my %headers = ( Accept => $self->_accept() );

   my %input_params = validate(@_, $_profile);

   foreach my $param_name ( keys %input_params ) {
      $uri->query_param($param_name => $input_params{$param_name});
   }

   $self->_ua->get($uri, %headers);
}

=item $response = $c->list_coupons();

Retrieves the list of coupons for the vendor

=cut

sub list_coupons {
   my $self = shift;
   $self->call_2co_api('/products/list_coupons');
}

=item  $response = $c->detail_sale(sale_id => $sale_id);

Retrieves the details for the named sale.

=cut

sub detail_sale {
   my $self = shift;
   my $_detail_profile = { map { $_ => $v{$_} } qw/sale_id invoice_id/ };
   my %p = validate(@_, $_detail_profile);

   unless ($p{sale_id} || $p{invoice_id}) {
      confess("detail_sale requires sale_id or invoice_id and received neither");
   }

   my $uri = URI->new($self->SUPER::_base_uri . '/sales/detail_sale');
   my %headers = ( Accept => $self->_accept() );

   if ($p{invoice_id} ) {
      $uri->query_param(invoice_id => $p{invoice_id});
   }
   else {
      $uri->query_param(sale_id => $p{sale_id});
   }

   $self->_ua->get($uri, %headers);
}

=item  $response = $c->detail_coupon(coupon_code => $coupon_code);

Retrieves the details for the named coupon.

=cut

sub detail_coupon {
   my $self = shift;
   my $_detail_profile = { coupon_code => { type => SCALAR, regex => qr/^\w+$/, untaint => 1, optional => 0, }, };
   my %p = validate(@_, $_detail_profile);

   unless ( $p{coupon_code} ) {
      confess("detail_coupon requires coupon_code");
   }

   my $uri = URI->new($self->SUPER::_base_uri . '/products/detail_coupon');
   my %headers = ( Accept => $self->_accept() );

   $uri->query_param(coupon_code => $p{coupon_code});

   $self->_ua->get($uri, %headers);
}

=item $response = $c->list_payments();

Retrieves the list of payments for the vendor

=cut

sub list_payments {
   my $self = shift;
   $self->call_2co_api('/acct/list_payments');
}

=item $response = $c->list_products();

Retrieves the list of products for the vendor

=cut

sub list_products {
   my $self = shift;
   $self->call_2co_api('/products/list_products');
}

=item $response = $c->list_options();

Retrieves the list of options for the vendor

=cut

sub list_options {
   my $self = shift;
   $self->call_2co_api('/products/list_options');
}


=item $response = $c->call_2co_api();

Talks to 2CO on behalf of the API methods

=cut

sub call_2co_api {
   my $self = shift;
   my $api_path = shift;
   return undef unless $api_path;
   my $uri = URI->new($self->SUPER::_base_uri . $api_path);
   my %headers = ( Accept => $self->_accept() );
   $self->_ua->get($uri, %headers);
}


#####################################################

sub _accept {
   $_[0]->{accept};
};

sub _ua {
   $_[0]->{ua};
};

=back

=head1 AUTHOR

Len Jaffe, C<< <lenjaffe at jaffesystems.com> >>

=head1 GITHUB

The source code is available at
L<Github|https://github.com/vampirechicken/VendorAPI--2Checkout--Client>

=head1 BUGS

Please report any bugs or feature requests to C<bug-vendorapi-2checkout-client at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=VendorAPI-2Checkout-Client>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc VendorAPI::2Checkout::Client

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=VendorAPI-2Checkout-Client>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/VendorAPI-2Checkout-Client>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/VendorAPI-2Checkout-Client>

=item * Search CPAN

L<http://search.cpan.org/dist/VendorAPI-2Checkout-Client/>

=back

=head1 ACKNOWLEDGEMENTS

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Len Jaffe.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1; # End of VendorAPI::2Checkout::Client