Amazon-MWS

 view release on metacpan or  search on metacpan

lib/Amazon/MWS/Uploader.pm  view on Meta::CPAN

package Amazon::MWS::Uploader;

use utf8;
use strict;
use warnings;

use DBI;
use Amazon::MWS::XML::Feed;
use Amazon::MWS::XML::Order;
use Amazon::MWS::Client;
use Amazon::MWS::XML::Response::FeedSubmissionResult;
use Amazon::MWS::XML::Response::OrderReport;
use Data::Dumper;
use File::Spec;
use DateTime;
use SQL::Abstract;
use Try::Tiny;
use Path::Tiny;
use Scalar::Util qw/blessed/;
use XML::Compile::Schema;

use Moo;
use MooX::Types::MooseLike::Base qw(:all);
use namespace::clean;

our $VERSION = '0.18';

use constant {
    AMW_ORDER_WILDCARD_ERROR => 999999,
    DEBUG => $ENV{AMZ_UPLOADER_DEBUG},
};

=head1 NAME

Amazon::MWS::Uploader -- high level agent to upload products to AMWS

=head1 DESCRIPTION

This module provide an high level interface to the upload process. It
has to keep track of the state to resume the uploading, which could
get stuck on the Amazon's side processing, so database credentials
have to be provided (or the database handle itself).

The table structure needed is defined and commented in sql/amazon.sql

=head1 SYNOPSIS

  my $agent = Amazon::MWS::Uploader->new(
                                         db_dsn => 'DBI:mysql:database=XXX',
                                         db_username => 'xxx',
                                         db_password => 'xxx',
                                         db_options => \%options
                                         # or dbh => $dbh,
  
                                         schema_dir => '/path/to/xml_schema',
                                         feed_dir => '/path/to/directory/for/xml',
  
                                         merchant_id => 'xxx',
                                         access_key_id => 'xxx',
                                         secret_key => 'xxx',
  
                                         marketplace_id => 'xxx',
                                         endpoint => 'xxx',
  
                                         products => \@products,
                                        );
  
  # say once a day, retrieve the full batch and send it up
  $agent->upload; 
  
  # every 10 minutes or so, continue the work started with ->upload, if any
  $agent->resume;


=head1 UPGRADE NOTES

When migrating from 0.05 to 0.06 please execute this SQL statement

 ALTER TABLE amazon_mws_products ADD COLUMN listed BOOLEAN;

lib/Amazon/MWS/Uploader.pm  view on Meta::CPAN

}

=head2 get_orders($from_date)

This is a self-contained method and doesn't require a product list.
The from_date must be a L<DateTime> object. If not provided, it will
the last week.

Returns a list of Amazon::MWS::XML::Order objects.

Beware that it's possible you get some items with 0 quantity, i.e.
single items cancelled. The application code needs to be prepared to
deal with such phantom items. You can check each order looping over
C<$order->items> checking for C<$item->quantity>.

=cut

sub get_orders {
    my ($self, $from_date) = @_;
    unless ($from_date) {
        $from_date = DateTime->now;
        $from_date->subtract(days => $self->order_days_range);
    }
    my @order_structs;
    my $res;
    try {
        $res = $self->client->ListOrders(
                                         MarketplaceId => [$self->marketplace_id],
                                         CreatedAfter  => $from_date,
                                        );
        push @order_structs, @{ $res->{Orders}->{Order} };
    }
    catch {
        die Dumper($_);
    };
    while (my $next_token = $res->{NextToken}) {
        # print "Found next token!\n";
        try {
            $res = $self->client->ListOrdersByNextToken(NextToken => $next_token);
            push @order_structs, @{ $res->{Orders}->{Order} };
        }
        catch {
            die Dumper($_);
        };
    }
    my @orders;
    foreach my $order (@order_structs) {
        my $amws_id = $order->{AmazonOrderId};
        die "Missing amazon AmazonOrderId?!" unless $amws_id;

        my $get_orderline = sub {
        # begin of the closure
        my $orderline;
        my @items;
        try {
            $orderline = $self->client->ListOrderItems(AmazonOrderId => $amws_id);
            push @items, @{ $orderline->{OrderItems}->{OrderItem} };
        }
        catch {
            my $err = $_;
            if (blessed($err) && $err->isa('Amazon::MWS::Exception::Throttled')) {
                die "Request is throttled. Consider to adjust order_days_range as documented at https://metacpan.org/pod/Amazon::MWS::Uploader#ACCESSORS";
            }
            else {
                die Dumper($err);
            }
        };
        while (my $next = $orderline->{NextToken}) {
            try {
                $orderline =
                  $self->client->ListOrderItemsByNextToken(NextToken  => $next);
                push @items, @{ $orderline->{OrderItems}->{OrderItem} };
            }
            catch {
                die Dumper($_);
            };
        }
        return \@items;
        # end of the closure
        };

        push @orders, Amazon::MWS::XML::Order->new(order => $order,
                                                   retrieve_orderline_sub => $get_orderline);
    }
    return @orders;
}

=head2 order_already_registered($order)

Check in the amazon_mws_orders table if we already registered this
order.

Return the row for this table (as an hashref) if present, nothing
underwise.

=cut

sub order_already_registered {
    my ($self, $order) = @_;
    die "Bad usage, missing order" unless $order;
    my $sth = $self->_exe_query($self->sqla->select(amazon_mws_orders => '*',
                                                    {
                                                     amazon_order_id => $order->amazon_order_number,
                                                     shop_id => $self->_unique_shop_id,
                                                    }));
    if (my $exists = $sth->fetchrow_hashref) {
        $sth->finish;
        return $exists;
    }
    else {
        return;
    }
}

=head2 acknowledge_successful_order(@orders)

Accept a list of L<Amazon::MWS::XML::Order> objects, prepare a
acknowledge feed with the C<Success> status, and insert the orders in
the database.

=cut

lib/Amazon/MWS/Uploader.pm  view on Meta::CPAN

    return @orders;
}

sub _parse_order_reports_xml {
    my ($self, $xml) = @_;
    my @orders;
    my $data = $self->xml_reader->($xml);
    if (my $messages = $data->{Message}) {
        foreach my $message (@$messages) {
            if (my $order = $message->{OrderReport}) {
                my $order_object = Amazon::MWS::XML::Response::OrderReport->new(struct => $order);
                push @orders, $order_object;
            }
            else {
                die "Cannot found expected OrderReport in " . Dumper($message);
            }
        }
    }
    return @orders;
}


=head2 acknowledge_reports(@ids)

Mark the reports as processed.

=head2 unacknowledge_reports(@ids)

Mark the reports as not processed.

=cut

sub acknowledge_reports {
    my ($self, @ids) = @_;
    $self->_toggle_ack_reports(1, @ids);
}

sub unacknowledge_reports {
    my ($self, @ids) = @_;
    $self->_toggle_ack_reports(0, @ids);
}

sub _toggle_ack_reports {
    my ($self, $flag, @ids) = @_;
    return unless @ids;
    while (@ids) {
        # max 100 ids per run
        my @list = splice(@ids, 0, 100);
        try {
            $self->client->UpdateReportAcknowledgements(ReportIdList => \@list,
                                                        Acknowledged => $flag);
        } catch {
            _handle_exception($_);
        };
    }
    return;
}

sub _handle_exception {
    my ($err) = @_;
    if (blessed $err) {
        my $msg;
        if ( $err->isa('Amazon::MWS::Exception::Throttled') ) {
            $msg = $err->xml;
        }
        elsif ( $err->isa('Amazon::MWS::Exception')) {
            if (my $string = $err->error) {
                $msg = $string;
            }
            else {
                $msg = Dumper($err);
            }
        }
        else {
            $msg = Dumper($err);
        }
        if ( $err->isa('Amazon::MWS::Exception')) {
            $msg .= "\n" . $err->trace->as_string . "\n";
        }
        die $msg;
    }
    die $err;
}

=head2 job_timed_out($job_row) [INTERNAL]

Check if the hashref (which is a hashref of the amazon_mws_jobs row)
has timed out, comparing with the C<order_ack_days_timeout> and
C<job_hours_timeout> (depending on the job).


=cut

sub job_timed_out {
    my ($self, $job_row) = @_;
    my $task = $job_row->{task};
    die "Missing task in $job_row->{amws_job_id}" unless $task;
    my $started = $job_row->{job_started_epoch};
    die "Missing job_started_epoch in $job_row->{amws_job_id}" unless $started;
    my $now = time();
    my $timeout;
    if ($task eq 'order_ack') {
        $timeout = $self->order_ack_days_timeout * 60 * 60 * 24;
    }
    else {
        $timeout = $self->job_hours_timeout * 60 * 60;
    }
    die "Something is off, timeout not defined" unless defined $timeout;
    return unless $timeout;
    my $elapsed = $now - $started;
    if ($elapsed > $timeout) {
        return $elapsed;
    }
    else {
        return;
    }
}

sub _print_or_warn_error {
    my ($self, @args) = @_;
    my $action;