File Coverage

blib/lib/WebService/MyAffiliates.pm
Criterion Covered Total %
statement 32 85 37.6
branch 5 42 11.9
condition 1 7 14.2
subroutine 10 17 58.8
pod 6 9 66.6
total 54 160 33.7


line stmt bran cond sub pod time code
1             package WebService::MyAffiliates;
2              
3 3     3   29588 use strict;
  3         6  
  3         67  
4 3     3   68 use 5.008_005;
  3         8  
5             our $VERSION = '0.07';
6              
7 3     3   12 use Carp;
  3         9  
  3         241  
8 3     3   2713 use Mojo::UserAgent;
  3         910314  
  3         29  
9 3     3   109 use Mojo::Util qw(b64_encode url_escape);
  3         6  
  3         152  
10 3     3   3853 use XML::Simple 'XMLin';
  3         29025  
  3         24  
11              
12 3     3   274 use vars qw/$errstr/;
  3         7  
  3         2799  
13 0     0 0 0 sub errstr { $errstr }
14              
15             sub new {
16 1     1 1 11 my $class = shift;
17 1 50       10 my %args = @_ % 2 ? %{$_[0]} : @_;
  0         0  
18              
19 1         3 for (qw/user pass host/) {
20 3 50       11 $args{$_} || croak "Param $_ is required.";
21             }
22              
23             # fix host with schema
24 1 50       8 $args{host} = 'http://' . $args{host} unless $args{host} =~ m{^https?\://};
25 1         3 $args{host} =~ s{/$}{};
26              
27 1   50     7 $args{timeout} ||= 30; # for ua timeout
28              
29 1         4 return bless \%args, $class;
30             }
31              
32             sub __ua {
33 0     0   0 my $self = shift;
34              
35 0 0       0 return $self->{ua} if exists $self->{ua};
36              
37 0         0 my $ua = Mojo::UserAgent->new;
38 0         0 $ua->max_redirects(3);
39 0         0 $ua->inactivity_timeout($self->{timeout});
40 0         0 $ua->proxy->detect; # env proxy
41 0         0 $ua->max_connections(100);
42 0         0 $self->{ua} = $ua;
43              
44 0         0 return $ua;
45             }
46              
47             ## https://myaffiliates.atlassian.net/wiki/display/PUB/Feed+1%3A+Users+Feed
48             sub get_users {
49 0     0 1 0 my $self = shift;
50 0 0       0 my %args = @_ % 2 ? %{$_[0]} : @_;
  0         0  
51 0         0 my $url = Mojo::URL->new('/feeds.php?FEED_ID=1');
52 0 0       0 $url->query(\%args) if %args;
53 0         0 $self->request($url->to_string);
54             }
55              
56             sub get_user {
57 0     0 1 0 my ($self, $id) = @_;
58              
59 0 0       0 $id or croak "id is required.";
60 0 0       0 my $user = $self->get_users(USER_ID => $id) or return;
61 0         0 return $user->{USER};
62             }
63              
64             ## https://myaffiliates.atlassian.net/wiki/display/PUB/Feed+4%3A+Decode+Token
65             sub decode_token {
66 1     1 1 524 my $self = shift;
67 1 50       19 my @tokens = @_ or croak 'Must pass at least one token.';
68              
69 0         0 $self->request('/feeds.php?FEED_ID=4&TOKENS=' . url_escape(join(',', @tokens)));
70             }
71              
72             ## https://myaffiliates.atlassian.net/wiki/display/PUB/Feed+5%3A+Encode+Token
73             sub encode_token {
74 0     0 1 0 my $self = shift;
75 0 0       0 my %args = @_ % 2 ? %{$_[0]} : @_;
  0         0  
76              
77 0 0       0 $args{USER_ID} or croak "USER_ID is required.";
78 0 0       0 $args{SETUP_ID} or croak "SETUP_ID is required.";
79              
80 0         0 my $url = Mojo::URL->new('/feeds.php?FEED_ID=5');
81 0 0       0 $url->query(\%args) if %args;
82 0         0 $self->request($url->to_string);
83             }
84              
85             ## https://myaffiliates.atlassian.net/wiki/display/PUB/Feed+6%3A+User+Transactions+Feed
86             sub get_user_transactions {
87 0     0 1 0 my $self = shift;
88 0 0       0 my %args = @_ % 2 ? %{$_[0]} : @_;
  0         0  
89              
90 0 0       0 $args{FROM_DATE} or croak 'FROM_DATE is reqired.';
91              
92 0         0 my $url = Mojo::URL->new('/feeds.php?FEED_ID=6');
93 0 0       0 $url->query(\%args) if %args;
94 0         0 $self->request($url->to_string);
95             }
96              
97             sub request {
98 0     0 0 0 my ($self, $url, $method, %params) = @_;
99              
100 0   0     0 $method ||= 'GET';
101              
102 0         0 my $ua = $self->__ua;
103             my $header = {
104 0         0 Authorization => 'Basic ' . b64_encode($self->{user} . ':' . $self->{pass}, '')
105             };
106 0 0       0 my @extra = %params ? (form => \%params) : ();
107 0         0 my $tx = $ua->build_tx($method => $self->{host} . $url => $header => @extra);
108              
109 0         0 $tx = $ua->start($tx);
110             # use Data::Dumper; print STDERR Dumper(\$tx);
111 0 0 0     0 if ($tx->res->headers->content_type and $tx->res->headers->content_type =~ 'text/xml') {
112 0         0 return XMLin($tx->res->body);
113             }
114 0 0       0 if (! $tx->success) {
115 0         0 $errstr = $tx->error->{message};
116 0         0 return;
117             }
118              
119 0         0 $errstr = "Unknown Response.";
120 0         0 return;
121             }
122              
123             ## un-documented helper
124             sub get_affiliate_id_from_token {
125 1     1 0 842 my ($self, $token) = @_;
126              
127 1 50       11 $token or croak 'Must pass a token to get_affiliate_id_from_token.';
128              
129 0 0         my $token_info = $self->decode_token($token) or return;
130 0           return $token_info->{TOKEN}->{USER_ID};
131             }
132              
133             1;
134             __END__