line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Triggermail; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1141
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
4
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
52
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '1.005'; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
27
|
use constant API_URI => 'https://api.sailthru.com'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
56
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
3573
|
use LWP; |
|
1
|
|
|
|
|
158271
|
|
|
1
|
|
|
|
|
45
|
|
11
|
1
|
|
|
1
|
|
1874
|
use JSON::XS; |
|
1
|
|
|
|
|
14589
|
|
|
1
|
|
|
|
|
292
|
|
12
|
1
|
|
|
1
|
|
12
|
use URI::Escape; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
73
|
|
13
|
1
|
|
|
1
|
|
5
|
use HTTP::Request; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
14
|
1
|
|
|
1
|
|
5
|
use Digest::MD5 qw( md5_hex); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
69
|
|
15
|
1
|
|
|
1
|
|
5364
|
use Params::Validate qw( :all ); |
|
1
|
|
|
|
|
28708
|
|
|
1
|
|
|
|
|
214
|
|
16
|
1
|
|
|
1
|
|
9
|
use warnings::register; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1454
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new { |
19
|
1
|
|
|
1
|
0
|
1269
|
my $class = shift; |
20
|
1
|
|
|
|
|
6
|
my $self = { |
21
|
|
|
|
|
|
|
api_key => shift, |
22
|
|
|
|
|
|
|
secret => shift, |
23
|
|
|
|
|
|
|
timeout => shift, |
24
|
|
|
|
|
|
|
}; |
25
|
1
|
|
|
|
|
489
|
warnings::warnif( 'deprecated', 'The module Triggermail is now deprecated. Use Sailthru::Client instead.' ); |
26
|
1
|
|
|
|
|
7
|
return bless $self, $class; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub getEmail { |
30
|
1
|
|
|
1
|
1
|
1766
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR } ); |
31
|
1
|
|
|
|
|
40
|
my ( $self, $email ) = @_; |
32
|
1
|
|
|
|
|
4
|
my %data = ( email => $email ); |
33
|
1
|
|
|
|
|
7
|
return $self->_apiCall( 'email', \%data, 'GET' ); |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub setEmail { |
37
|
0
|
|
|
0
|
1
|
0
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR }, 0, 0, 0 ); |
38
|
0
|
|
|
|
|
0
|
my ( $self, $email, $vars_ref, $lists_ref, $templates_ref ) = @_; |
39
|
0
|
|
|
|
|
0
|
my %data; |
40
|
0
|
|
|
|
|
0
|
$data{'email'} = $email; |
41
|
0
|
0
|
|
|
|
0
|
$self->_flatten_hash( 'vars', $vars_ref, \%data ) if $vars_ref; |
42
|
0
|
0
|
|
|
|
0
|
$self->_flatten_hash( 'lists', $lists_ref, \%data ) if $lists_ref; |
43
|
0
|
0
|
|
|
|
0
|
$self->_flatten_hash( 'templates', $templates_ref, \%data ) |
44
|
|
|
|
|
|
|
if $templates_ref; |
45
|
0
|
|
|
|
|
0
|
return $self->_apiCall( 'email', \%data, 'POST' ); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub send { |
49
|
0
|
|
|
0
|
1
|
0
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR }, { type => SCALAR }, 0, 0, 0 ); |
50
|
0
|
|
|
|
|
0
|
my %data; |
51
|
0
|
|
|
|
|
0
|
my ( $self, $template, $email, $vars_hash, $options_hash, $schedule_time ) = @_; |
52
|
0
|
|
|
|
|
0
|
$data{'template'} = $template; |
53
|
0
|
|
|
|
|
0
|
$data{'email'} = $email; |
54
|
0
|
|
|
|
|
0
|
$data{'schedule_time'} = $schedule_time; |
55
|
0
|
0
|
|
|
|
0
|
$self->_flatten_hash( 'vars', $vars_hash, \%data ) if $vars_hash; |
56
|
0
|
0
|
|
|
|
0
|
$self->_flatten_hash( 'options', $options_hash, \%data ) if $options_hash; |
57
|
0
|
|
|
|
|
0
|
return $self->_apiCall( 'send', \%data, 'POST' ); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub getSend { |
61
|
0
|
|
|
0
|
1
|
0
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR } ); |
62
|
0
|
|
|
|
|
0
|
my ( $self, $send_id ) = @_; |
63
|
0
|
|
|
|
|
0
|
my %data = ( send_id => $send_id ); |
64
|
0
|
|
|
|
|
0
|
return $self->_apiCall( 'send', \%data, 'GET' ); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub scheduleBlast { |
68
|
0
|
|
|
0
|
1
|
0
|
validate_pos( |
69
|
|
|
|
|
|
|
@_, |
70
|
|
|
|
|
|
|
{ type => HASHREF }, |
71
|
|
|
|
|
|
|
{ type => SCALAR }, |
72
|
|
|
|
|
|
|
{ type => SCALAR }, |
73
|
|
|
|
|
|
|
{ type => SCALAR }, |
74
|
|
|
|
|
|
|
{ type => SCALAR }, |
75
|
|
|
|
|
|
|
{ type => SCALAR }, |
76
|
|
|
|
|
|
|
{ type => SCALAR }, |
77
|
|
|
|
|
|
|
{ type => SCALAR }, |
78
|
|
|
|
|
|
|
{ type => SCALAR }, |
79
|
|
|
|
|
|
|
0 |
80
|
|
|
|
|
|
|
); |
81
|
0
|
|
|
|
|
0
|
my ( $self, $name, $list, $schedule_time, $from_name, $from_email, $subject, $content_html, $content_text, |
82
|
|
|
|
|
|
|
$options ) = @_; |
83
|
0
|
|
|
|
|
0
|
my %data = ( |
84
|
|
|
|
|
|
|
name => $name, |
85
|
|
|
|
|
|
|
list => $list, |
86
|
|
|
|
|
|
|
schedule_time => $schedule_time, |
87
|
|
|
|
|
|
|
from_name => $from_name, |
88
|
|
|
|
|
|
|
from_email => $from_email, |
89
|
|
|
|
|
|
|
subject => $subject, |
90
|
|
|
|
|
|
|
content_html => $content_html, |
91
|
|
|
|
|
|
|
content_text => $content_text |
92
|
|
|
|
|
|
|
); |
93
|
0
|
0
|
|
|
|
0
|
if ($options) { |
94
|
0
|
|
|
|
|
0
|
my %merged_hash = ( %data, %{$options} ); #merge in the options hash |
|
0
|
|
|
|
|
0
|
|
95
|
0
|
|
|
|
|
0
|
%data = %merged_hash; |
96
|
|
|
|
|
|
|
} |
97
|
0
|
|
|
|
|
0
|
return $self->_apiCall( 'blast', \%data, 'POST' ); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub getBlast { |
101
|
0
|
|
|
0
|
1
|
0
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR } ); |
102
|
0
|
|
|
|
|
0
|
my ( $self, $blast_id ) = @_; |
103
|
0
|
|
|
|
|
0
|
my %data = ( blast_id => $blast_id ); |
104
|
0
|
|
|
|
|
0
|
return $self->_apiCall( 'blast', \%data, 'GET' ); |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub copyTemplate { |
108
|
0
|
|
|
0
|
1
|
0
|
validate_pos( |
109
|
|
|
|
|
|
|
@_, |
110
|
|
|
|
|
|
|
{ type => HASHREF }, |
111
|
|
|
|
|
|
|
{ type => SCALAR }, |
112
|
|
|
|
|
|
|
{ type => SCALAR }, |
113
|
|
|
|
|
|
|
{ type => SCALAR }, |
114
|
|
|
|
|
|
|
{ type => SCALAR }, |
115
|
|
|
|
|
|
|
{ type => SCALAR }, |
116
|
|
|
|
|
|
|
{ type => SCALAR }, |
117
|
|
|
|
|
|
|
0 |
118
|
|
|
|
|
|
|
); |
119
|
0
|
|
|
|
|
0
|
my ( $self, $template, $data_feed, $setup, $subject_line, $schedule_time, $list, $options ) = @_; |
120
|
0
|
|
|
|
|
0
|
my %data = ( |
121
|
|
|
|
|
|
|
copy_template => $template, |
122
|
|
|
|
|
|
|
data_feed_url => $data_feed, |
123
|
|
|
|
|
|
|
setup => $setup, |
124
|
|
|
|
|
|
|
name => $subject_line, |
125
|
|
|
|
|
|
|
schedule_time => $schedule_time, |
126
|
|
|
|
|
|
|
list => $list, |
127
|
|
|
|
|
|
|
); |
128
|
|
|
|
|
|
|
# $self->_flatten_hash( 'options', $options, \%data ) if $options; |
129
|
0
|
0
|
|
|
|
0
|
if ($options) { |
130
|
|
|
|
|
|
|
# merge in the options hash |
131
|
0
|
|
|
|
|
0
|
my %merged_hash = ( %data, %{$options} ); |
|
0
|
|
|
|
|
0
|
|
132
|
0
|
|
|
|
|
0
|
%data = %merged_hash; |
133
|
|
|
|
|
|
|
} |
134
|
0
|
|
|
|
|
0
|
return $self->_apiCall( 'blast', \%data, 'POST' ); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub getTemplate { |
138
|
0
|
|
|
0
|
1
|
0
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR } ); |
139
|
0
|
|
|
|
|
0
|
my ( $self, $template ) = @_; |
140
|
0
|
|
|
|
|
0
|
my %data = ( template => $template ); |
141
|
0
|
|
|
|
|
0
|
return $self->_apiCall( 'template', \%data, 'GET' ); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub importContacts { |
145
|
0
|
|
|
0
|
1
|
0
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR }, 0 ); |
146
|
0
|
|
|
|
|
0
|
my ( $self, $email, $password, $include_names ) = @_; |
147
|
0
|
0
|
|
|
|
0
|
$include_names = 0 if ( !$include_names ); |
148
|
0
|
|
|
|
|
0
|
my %data = ( |
149
|
|
|
|
|
|
|
email => $email, |
150
|
|
|
|
|
|
|
password => $password, |
151
|
|
|
|
|
|
|
include_names => $include_names |
152
|
|
|
|
|
|
|
); |
153
|
0
|
|
|
|
|
0
|
return $self->_apiCall( 'contacts', \%data, 'POST' ); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub _apiCall { |
157
|
1
|
|
|
1
|
|
19
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR }, { type => HASHREF }, { type => SCALAR } ); |
158
|
1
|
|
|
|
|
5
|
my ( $self, $action, $data, $method ) = @_; |
159
|
1
|
|
|
|
|
4
|
$data->{'api_key'} = $self->{api_key}; |
160
|
1
|
|
|
|
|
2
|
$data->{'format'} = 'json'; |
161
|
1
|
|
|
|
|
4
|
$data->{'sig'} = $self->_getSignatureHash($data); |
162
|
1
|
|
|
|
|
8
|
my $result = $self->_httpRequest( API_URI . "/" . $action, $data, $method ); |
163
|
|
|
|
|
|
|
|
164
|
1
|
|
|
|
|
58
|
my $json = JSON::XS->new->ascii->pretty->allow_nonref; |
165
|
1
|
|
|
|
|
9
|
my $decoded = $json->decode( $result->content ); |
166
|
1
|
50
|
|
|
|
60
|
return $decoded ? $decoded : $result; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub _httpRequest { |
170
|
1
|
|
|
1
|
|
20
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR }, { type => HASHREF }, { type => SCALAR } ); |
171
|
1
|
|
|
|
|
4
|
my ( $self, $url, $data, $method ) = @_; |
172
|
1
|
|
|
|
|
12
|
my $browser = LWP::UserAgent->new; |
173
|
1
|
50
|
|
|
|
8180
|
$browser->timeout( $self->{timeout} ) if $self->{timeout}; |
174
|
1
|
|
|
|
|
2
|
my $response; |
175
|
1
|
50
|
|
|
|
6
|
if ( $method eq 'POST' ) { |
176
|
0
|
|
|
|
|
0
|
$response = $browser->post( $url, $data ); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
else { #GET |
179
|
1
|
|
|
1
|
|
7
|
use URI; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
493
|
|
180
|
1
|
|
|
|
|
32
|
$url = URI->new($url); |
181
|
1
|
|
|
|
|
25572
|
$url->query_form( %{$data} ); |
|
1
|
|
|
|
|
15
|
|
182
|
1
|
|
|
|
|
244
|
$response = $browser->get($url); |
183
|
|
|
|
|
|
|
} |
184
|
1
|
50
|
|
|
|
814220
|
if ($response) { |
185
|
1
|
|
|
|
|
448
|
return $response; |
186
|
|
|
|
|
|
|
} |
187
|
0
|
|
|
|
|
0
|
return; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub _getSignatureHash { |
191
|
2
|
|
|
2
|
|
70
|
validate_pos( @_, { type => HASHREF }, { type => HASHREF } ); |
192
|
2
|
|
|
|
|
7
|
my ( $self, $params ) = @_; |
193
|
2
|
|
|
|
|
3
|
my @values; |
194
|
2
|
|
|
|
|
7
|
$self->_extractValues( $params, \@values ); |
195
|
2
|
|
|
|
|
8
|
@values = sort @values; |
196
|
2
|
|
|
|
|
11
|
my $string = $self->{secret} . join( '', @values ); |
197
|
2
|
|
|
|
|
19
|
return md5_hex($string); |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub _flatten_hash { |
201
|
0
|
|
|
0
|
|
0
|
validate_pos( @_, { type => HASHREF }, { type => SCALAR }, { type => HASHREF }, { type => HASHREF } ); |
202
|
0
|
|
|
|
|
0
|
my ( $self, $name, $nested_hash, $mother_hash ) = @_; |
203
|
0
|
|
|
|
|
0
|
while ( ( my $key, my $value ) = each %{$nested_hash} ) { |
|
0
|
|
|
|
|
0
|
|
204
|
0
|
0
|
0
|
|
|
0
|
if ( ref( $nested_hash->{$key} ) eq 'HASH' |
205
|
|
|
|
|
|
|
|| ref( $nested_hash->{$key} ) eq 'REF' ) { |
206
|
0
|
|
|
|
|
0
|
$self->_flatten_hash( $key, $nested_hash->{$key}, $mother_hash ); |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
else { |
209
|
0
|
|
|
|
|
0
|
$mother_hash->{ $name . "[" . $key . "]" } = $value; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
} |
212
|
0
|
|
|
|
|
0
|
return; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub _extractValues { |
216
|
2
|
|
|
2
|
|
32
|
validate_pos( @_, { type => HASHREF }, { type => HASHREF }, { type => ARRAYREF } ); |
217
|
2
|
|
|
|
|
9
|
my ( $self, $hash, $array ) = @_; |
218
|
2
|
|
|
|
|
3
|
while ( ( my $key, my $value ) = each %{$hash} ) { |
|
6
|
|
|
|
|
23
|
|
219
|
4
|
50
|
33
|
|
|
23
|
if ( ref($value) eq 'HASH' || ref($value) eq 'REF' ) { |
220
|
0
|
|
|
|
|
0
|
$self->_extractValues( $value, $array ); |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
else { |
223
|
4
|
|
|
|
|
4
|
push @{$array}, $value; |
|
4
|
|
|
|
|
10
|
|
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} |
226
|
2
|
|
|
|
|
7
|
return; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
1; |
230
|
|
|
|
|
|
|
__END__ |