File Coverage

blib/lib/WWW/Mailchimp.pm
Criterion Covered Total %
statement 29 58 50.0
branch 0 8 0.0
condition n/a
subroutine 10 107 9.3
pod 0 94 0.0
total 39 267 14.6


line stmt bran cond sub pod time code
1             package WWW::Mailchimp;
2 2     2   32264 use Moo;
  2         54280  
  2         344  
3 2     2   6108 use LWP;
  2         198882  
  2         97  
4 2     2   1276 use JSON;
  2         14638  
  2         18  
5 2     2   347 use URI;
  2         5  
  2         54  
6 2     2   9 use URI::Escape;
  2         5  
  2         146  
7 2     2   1803 use PHP::HTTPBuildQuery qw(http_build_query);
  2         9096  
  2         193  
8 2     2   2009 use MooX::Types::MooseLike::Base qw(Int InstanceOf Num Str);
  2         15819  
  2         247  
9 2     2   24 use Sub::Name;
  2         4  
  2         2169  
10              
11             our $VERSION = '0.009';
12             $VERSION = eval $VERSION;
13              
14             =head1 NAME
15              
16             WWW::Mailchimp - Perl wrapper around the Mailchimp v1.3 API
17              
18             =head1 SYNOPSIS
19              
20             use strict;
21             use WWW::Mailchimp
22              
23             my $mailchimp = WWW::Mailchimp->new(apikey => $apikey);
24             # defaults ( datacenter => 'us1', timeout => 5, output_format => 'json', api_version => 1.3 )
25              
26             my $campaigns = $mailchimp->campaigns;
27             my $lists = $mailchimp->lists;
28             my $subscribers = $mailchimp->listMembers( $lists->{data}->[0]->{id} );
29             my $ok = $mailchimp->listSubscribe( id => $lists->{data}->[0]->{id},
30             email_address => 'foo@bar.com',
31             update_existing => 1,
32             merge_vars => [ FNAME => 'foo',
33             LNAME => 'bar' ] );
34              
35             =head1 DESCRIPTION
36              
37             WWW::Mailchimp is a simple Perl wrapper around the Mailchimp API v1.3.
38              
39             It is as simple as creating a new WWW::Mailchimp object and calling ->method
40             Each key/value pair becomes part of a query string, for example:
41              
42             $mailchimp->listSubscribe( id => 1, email_address => 'foo@bar.com' );
43              
44             results in the query string
45              
46             ?method=listSubscribe&id=1&email_address=foo@bar.com
47             # apikey, output, etc are tacked on by default. This is also uri_escaped
48              
49             =head1 BUGS
50              
51             Currently, this module is hardcoded to JSON::from_json the result of the LWP request.
52             This should be changed to be dependent on the output_format. Patches welcome.
53              
54             I am also rather sure handling of merge_vars can be done better. If it isn't working
55             properly, you can always use a key of 'merge_vars[FNAME]', for example.
56              
57             =head1 SEE ALSO
58              
59             Mail::Chimp::API - Perl wrapper around the Mailchimp v1.2 API using XMLRPC
60              
61             =head1 AUTHOR
62              
63             Justin Hunter
64              
65             Fayland Lam
66              
67             =head1 COPYRIGHT AND LICENSE
68              
69             This software is copyright (c) 2011 by Justin Hunter
70              
71             This is free software; you can redistribute it and/or modify it under
72             the same terms as the Perl 5 programming language system itself.
73              
74             =cut
75              
76             has api_version => (
77             is => 'ro',
78             isa => Num,
79             lazy => 1,
80             default => sub { 1.3 },
81             );
82              
83             has datacenter => (
84             is => 'rw',
85             isa => Str,
86             lazy => 1,
87             default => sub { 'us1' },
88             );
89              
90             has apikey => (
91             is => 'ro',
92             isa => Str,
93             required => 1,
94             trigger => sub {
95             my ($self, $val) = @_;
96             my ($datacenter) = ($val =~ /\-(\w+)$/);
97             $self->datacenter($datacenter)
98             },
99             );
100              
101             has api_url => (
102             is => 'rw',
103             isa => Str,
104             lazy => 1,
105             default => sub { my $self = shift; return 'https://' . $self->datacenter . '.api.mailchimp.com/' . $self->api_version . '/'; },
106             );
107              
108             has output_format => (
109             is => 'rw',
110             isa => Str,
111             lazy => 1,
112             default => sub { 'json' },
113             );
114              
115             has ua => (
116             is => 'lazy',
117             isa => InstanceOf['LWP::UserAgent'],
118             handles => [ qw(request) ],
119             );
120              
121             has timeout => (
122             is => 'rw',
123             isa => Int,
124             lazy => 1,
125             default => sub { 5 },
126             );
127              
128             has json => (
129             is => 'ro',
130             isa => InstanceOf['JSON'],
131             is => 'lazy',
132             );
133              
134             sub _build_ua {
135 1     1   2009 my $self = shift;
136 1         7 my $ua = LWP::UserAgent->new( timeout => $self->timeout, agent => __PACKAGE__ . ' ' . $VERSION, ssl_opts => { verify_hostname => 0, SSL_verify_mode => 0x00 } );
137             }
138              
139 0     0     sub _build_json { JSON->new->allow_nonref }
140              
141             sub _build_query_args {
142 0     0     my ($self, %args) = @_;
143 0 0         my %merge_vars = @{delete $args{merge_vars} || []};
  0            
144 0           for my $var (keys %merge_vars) {
145 0 0         if (ref($merge_vars{$var}) eq 'ARRAY') {
146 0           my $count = 0;
147 0           for my $val (@{$merge_vars{$var}}) {
  0            
148 0           $args{"merge_vars[$var][$count]"} = $val;
149 0           $count++;
150             }
151             } else {
152 0           $args{"merge_vars[$var]"} = $merge_vars{$var};
153             }
154             }
155              
156 0           my $uri = URI->new( $self->api_url );
157 0           $args{apikey} = $self->apikey;
158 0           $args{output} = $self->output_format;
159 0           delete $args{$_} for qw(json ua);
160              
161 0           return \%args;
162             }
163              
164             sub _request {
165 0     0     my $self = shift;
166 0           my $method = shift;
167 0 0         my %args = ref($_[0]) ? %{$_[0]} : @_;
  0            
168              
169             # uri must include the method (even for a POST request)
170 0           my $uri = URI->new( $self->api_url );
171 0           $uri->query( http_build_query( { method => $method } ) );
172              
173             # build a POST request with json-encoded arguments
174 0           my $post_args = $self->_build_query_args(%args);
175 0           my $req = HTTP::Request->new('POST', $uri);
176 0           $req->content( uri_escape( $self->json->encode($post_args) ) );
177              
178 0           my $response = $self->request( $req );
179 0 0         return $response->is_success ? $self->json->decode($response->content) : $response->status_line;
180             }
181              
182             my @api_methods = qw(
183             campaignContent
184             campaignCreate
185             campaignDelete
186             campaignEcommOrderAdd
187             campaignPause
188             campaignReplicate
189             campaignResume
190             campaignSchedule
191             campaignSegmentTest
192             campaignSendNow
193             campaignSendTest
194             campaignShareReport
195             campaignTemplateContent
196             campaignUnschedule
197             campaignUpdate
198             campaigns
199             campaignAbuseReports
200             campaignAdvice
201             campaignAnalytics
202             campaignBounceMessage
203             campaignBounceMessages
204             campaignClickStats
205             campaignEcommOrders
206             campaignEepUrlStats
207             campaignEmailDomainPerformance
208             campaignGeoOpens
209             campaignGeoOpensForCountry
210             campaignHardBounces
211             campaignMembers
212             campaignSoftBounces
213             campaignStats
214             campaignUnsubscribes
215             campaignClickDetailAIM
216             campaignEmailStatsAIM
217             campaignEmailStatsAIMAll
218             campaignNotOpenedAIM
219             campaignOpenedAIM
220             ecommOrderAdd
221             ecommOrderDel
222             ecommOrders
223             folderAdd
224             folderDel
225             folderUpdate
226             folders
227             campaignsForEmail
228             chimpChatter
229             generateText
230             getAccountDetails
231             inlineCss
232             listsForEmail
233             ping
234             listAbuseReports
235             listActivity
236             listBatchSubscribe
237             listBatchUnsubscribe
238             listClients
239             listGrowthHistory
240             listInterestGroupAdd
241             listInterestGroupDel
242             listInterestGroupUpdate
243             listInterestGroupingAdd
244             listInterestGroupingDel
245             listInterestGroupingUpdate
246             listInterestGroupings
247             listLocations
248             listMemberActivity
249             listMemberInfo
250             listMembers
251             listMergeVarAdd
252             listMergeVarDel
253             listMergeVarUpdate
254             listMergeVars
255             listStaticSegmentAdd
256             listStaticSegmentDel
257             listStaticSegmentMembersAdd
258             listStaticSegmentMembersDel
259             listStaticSegmentReset
260             listStaticSegments
261             listSubscribe
262             listUnsubscribe
263             listUpdateMember
264             listWebhookAdd
265             listWebhookDel
266             listWebhooks
267             lists
268             apikeyAdd
269             apikeyExpire
270             apikeys
271             templateAdd
272             templateDel
273             templateInfo
274             templateUndel
275             templateUpdate
276             templates
277             );
278              
279 2     2   15 no strict 'refs';
  2         21  
  2         242  
280             for my $method (@api_methods) {
281 0     0 0   *{$method} = subname $method => sub { shift->_request($method, @_) };
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
        0 0    
282             }
283              
284             1;