<commit_before>package WebServices::Zazzle;
use warnings;
use strict;
use vars qw($VERSION);

$VERSION = '1.49';

# dependencies
use Digest::MD5 qw(md5_hex);
use LWP::UserAgent;
use URI::Escape qw(uri_escape);
use XML::Simple qw(xml_in);

sub new {
	my ($package, $id, $key) = @_;
	my $session = {
	    'baseurl' => 'https://vendor.zazzle.com/v100/api.aspx?',
	    'url'     => undef,
	    'id'      => $id,
	    'secret'  => $key,
	};
	bless $session, $package;
	return $session;
}

sub fetch {
	my $self = shift;
	unless ($self->{'url'}) {
	    # this typically happens because fetch was called directly
	    die q($self->{'url'} undefined);
	}
	my $ua = LWP::UserAgent->new();
	$ua->protocols_allowed(['https']);
	my $response = $ua->get($self->{'url'});
	my $h = $response->{'_headers'};
	if ($h->header('client-warning')) {
	    die "$response->{'_msg'}";
	}
	unless (_validate($response->{'_content'})) {
	    die "invalid data";
	}
	$self->{'url'} = undef;
	return _xmltoh($response);
}

sub _validate {
	my $data = shift;
	my $test = 0;
	# fail right away if undefined
	return $test unless ($data);
	# returned data should contain SUCCESS code
	if ($data =~ m:<Code>SUCCESS</Code>: &&
	    $data =~ m:</Response>$:) {
		$test = 1;
	}
	return $test;
}

sub list_new_orders {
	my $self = shift;
        my $hash = md5_hex($self->{'id'}, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=listneworders";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&hash=$hash";
	return $self->fetch();
}

sub get_shipping_label {
	my ($self, $orderid, $weight, $format) = @_;
	die "no orderid specified" unless ($orderid);
	die "no order weight specified" unless ($weight);
	$format = 'PDF' unless ($format);
	unless ($format eq 'PDF'
	    || $format eq 'ZPL'
	    || $format eq 'PNG') {
		warn "invalid label format: $format - using PDF";
		$format = 'PDF';
	}
	my $hash = md5_hex($self->{'id'}, $orderid, $weight,
	    $format, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=getshippinglabel";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&orderid=$orderid";
	$self->{'url'} .= "\&weight=$weight\&format=$format";
	$self->{'url'} .= "\&hash=$hash";
	return $self->fetch();
}

sub ack_order {
	my ($self, $orderid, $type, $action) = @_;
	# die if ack_order was called directly without wrapper
	die "no orderid specified" unless ($orderid);
	die "no ack type specified" unless ($type);
	die "no ack action specified" unless ($action);
	unless ($type eq 'new'
	    || $type eq 'update'
	    || $type eq 'message') {
		die "invalid ack type: $type";
	}
	unless ($action eq 'accept' || $action eq 'reject') {
	    die "invalid ack action: $action";
	}
	my $hash = md5_hex($self->{'id'}, $orderid,
			   $type, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=ackorder";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&orderid=$orderid";
	$self->{'url'} .= "\&type=$type\&action=$action\&hash=$hash";
	return $self->fetch();
}

sub ack_order_new_accept {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'new', 'accept');
}

sub ack_order_new_reject {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'new', 'reject');
}

sub ack_order_update_accept {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'update', 'accept');
}

sub ack_order_update_reject {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'update', 'reject');
}

sub ack_order_message_accept {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'message', 'accept');
}

sub ack_order_message_reject {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'message', 'reject');
}

sub list_updated_orders {
	my $self = shift;
	my $hash = md5_hex($self->{'id'}, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=listupdatedorders";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&hash=$hash";
	return $self->fetch();
}

sub list_order_messages {
	my $self = shift;
	my $hash = md5_hex($self->{'id'}, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=listordermessages";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&hash=$hash";
	return $self->fetch();
}

sub add_order_activity {
	my ($self, $orderid, $activity) = @_;
	die "no orderid specified" unless ($orderid);
	die "no activity listed" unless ($activity);
	my $uri_msg = uri_escape($activity);
	my $hash = md5_hex($self->{'id'}, $orderid,
		$activity, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=addorderactivity";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&orderid=$orderid";
	$self->{'url'} .= "\&activity=$uri_msg\&hash=$hash";
	return $self->fetch();
}

sub get_order {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	my $hash = md5_hex($self->{'id'}, $orderid, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=getorder";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&orderid=$orderid";
	$self->{'url'} .= "\&hash=$hash";
	return $self->fetch();
}

sub _xmltoh {
	# parse xml content to hash ref and return
	my $response = shift;
	return xml_in($response->{'_content'},
	    SuppressEmpty => undef,
	    ForceArray => ['Order', 'LineItem', 'Product', 'Message',
		'ShippingDocument', 'PrintFile', 'PreviewFile'],
	    GroupTags => {'Products' => 'Product', 'Orders' => 'Order',
		'LineItems' => 'LineItem', 'Result' => 'Orders',
		'Messages' => 'Message', 'PackingSheet' => 'Page',
		'ShippingDocuments' => 'ShippingDocument',
		'PrintFiles' => 'PrintFile', 'Previews' => 'PreviewFile'});
}

sub license {
my $lic = q|
#########################################################################
# Copyright (c) 2014, <NAME> (ted at sranet dot com)                  #
# All rights reserved.                                                  #
#                                                                       #
# Redistribution and use in source and binary forms, with or without    #
#       modification, are permitted provided that the following         #
#       conditions are met:                                             #
#     * Redistributions of source code must retain the above copyright  #
#       notice, this list of conditions and the following disclaimer.   #
#     * Redistributions in binary form must reproduce the above         #
#       copyright notice, this list of conditions and the following     #
#       disclaimer in the documentation and/or other materials provided #
#       with the distribution.                                          #<commit_msg>Include Page tag in ForceArray.<commit_after>package WebServices::Zazzle;
use warnings;
use strict;
use vars qw($VERSION);

$VERSION = '1.49';

# dependencies
use Digest::MD5 qw(md5_hex);
use LWP::UserAgent;
use URI::Escape qw(uri_escape);
use XML::Simple qw(xml_in);

sub new {
	my ($package, $id, $key) = @_;
	my $session = {
	    'baseurl' => 'https://vendor.zazzle.com/v100/api.aspx?',
	    'url'     => undef,
	    'id'      => $id,
	    'secret'  => $key,
	};
	bless $session, $package;
	return $session;
}

sub fetch {
	my $self = shift;
	unless ($self->{'url'}) {
	    # this typically happens because fetch was called directly
	    die q($self->{'url'} undefined);
	}
	my $ua = LWP::UserAgent->new();
	$ua->protocols_allowed(['https']);
	my $response = $ua->get($self->{'url'});
	my $h = $response->{'_headers'};
	if ($h->header('client-warning')) {
	    die "$response->{'_msg'}";
	}
	unless (_validate($response->{'_content'})) {
	    die "invalid data";
	}
	$self->{'url'} = undef;
	return _xmltoh($response);
}

sub _validate {
	my $data = shift;
	my $test = 0;
	# fail right away if undefined
	return $test unless ($data);
	# returned data should contain SUCCESS code
	if ($data =~ m:<Code>SUCCESS</Code>: &&
	    $data =~ m:</Response>$:) {
		$test = 1;
	}
	return $test;
}

sub list_new_orders {
	my $self = shift;
        my $hash = md5_hex($self->{'id'}, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=listneworders";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&hash=$hash";
	return $self->fetch();
}

sub get_shipping_label {
	my ($self, $orderid, $weight, $format) = @_;
	die "no orderid specified" unless ($orderid);
	die "no order weight specified" unless ($weight);
	$format = 'PDF' unless ($format);
	unless ($format eq 'PDF'
	    || $format eq 'ZPL'
	    || $format eq 'PNG') {
		warn "invalid label format: $format - using PDF";
		$format = 'PDF';
	}
	my $hash = md5_hex($self->{'id'}, $orderid, $weight,
	    $format, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=getshippinglabel";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&orderid=$orderid";
	$self->{'url'} .= "\&weight=$weight\&format=$format";
	$self->{'url'} .= "\&hash=$hash";
	return $self->fetch();
}

sub ack_order {
	my ($self, $orderid, $type, $action) = @_;
	# die if ack_order was called directly without wrapper
	die "no orderid specified" unless ($orderid);
	die "no ack type specified" unless ($type);
	die "no ack action specified" unless ($action);
	unless ($type eq 'new'
	    || $type eq 'update'
	    || $type eq 'message') {
		die "invalid ack type: $type";
	}
	unless ($action eq 'accept' || $action eq 'reject') {
	    die "invalid ack action: $action";
	}
	my $hash = md5_hex($self->{'id'}, $orderid,
			   $type, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=ackorder";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&orderid=$orderid";
	$self->{'url'} .= "\&type=$type\&action=$action\&hash=$hash";
	return $self->fetch();
}

sub ack_order_new_accept {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'new', 'accept');
}

sub ack_order_new_reject {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'new', 'reject');
}

sub ack_order_update_accept {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'update', 'accept');
}

sub ack_order_update_reject {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'update', 'reject');
}

sub ack_order_message_accept {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'message', 'accept');
}

sub ack_order_message_reject {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	$self->ack_order($orderid, 'message', 'reject');
}

sub list_updated_orders {
	my $self = shift;
	my $hash = md5_hex($self->{'id'}, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=listupdatedorders";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&hash=$hash";
	return $self->fetch();
}

sub list_order_messages {
	my $self = shift;
	my $hash = md5_hex($self->{'id'}, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=listordermessages";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&hash=$hash";
	return $self->fetch();
}

sub add_order_activity {
	my ($self, $orderid, $activity) = @_;
	die "no orderid specified" unless ($orderid);
	die "no activity listed" unless ($activity);
	my $uri_msg = uri_escape($activity);
	my $hash = md5_hex($self->{'id'}, $orderid,
		$activity, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=addorderactivity";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&orderid=$orderid";
	$self->{'url'} .= "\&activity=$uri_msg\&hash=$hash";
	return $self->fetch();
}

sub get_order {
	my ($self, $orderid) = @_;
	die "no orderid specified" unless ($orderid);
	my $hash = md5_hex($self->{'id'}, $orderid, $self->{'secret'});
	$self->{'url'}  = "$self->{'baseurl'}method=getorder";
	$self->{'url'} .= "\&vendorid=$self->{'id'}\&orderid=$orderid";
	$self->{'url'} .= "\&hash=$hash";
	return $self->fetch();
}

sub _xmltoh {
	# parse xml content to hash ref and return
	my $response = shift;
	return xml_in($response->{'_content'},
	    SuppressEmpty => undef,
	    ForceArray => ['Order', 'LineItem', 'Product', 'Message',
		'ShippingDocument', 'PrintFile', 'PreviewFile', 'Page'],
	    GroupTags => {'Products' => 'Product', 'PackingSheet' => 'Page',
		 'Orders' => 'Order', 'LineItems' => 'LineItem', 'Result' => 'Orders',
		'Messages' => 'Message', 'ShippingDocuments' => 'ShippingDocument',
		'PrintFiles' => 'PrintFile', 'Previews' => 'PreviewFile'});
}

sub license {
my $lic = q|
#########################################################################
# Copyright (c) 2014, <NAME> (ted at sranet dot com)                  #
# All rights reserved.                                                  #
#                                                                       #
# Redistribution and use in source and binary forms, with or without    #
#       modification, are permitted provided that the following         #
#       conditions are met:                                             #
#     * Redistributions of source code must retain the above copyright  #
#       notice, this list of conditions and the following disclaimer.   #
#     * Redistributions in binary form must reproduce the above         #
#       copyright notice, this list of conditions and the following     #
#       disclaimer in the documentation and/or other materials provided #
#       with the distribution.                                          #
{'fraction_non_alphanumeric': 0.21705426356589147, 'fraction_numerical': 0.0031007751937984496, 'mean_word_length': 3.756320224719101, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 187, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 10}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 17, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2100595', 'n_tokens_mistral': 4736, 'n_tokens_neox': 4613, 'n_words': 1143}