File Coverage

blib/lib/Net/AWS/SES.pm
Criterion Covered Total %
statement 25 27 92.5
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 34 36 94.4


line stmt bran cond sub pod time code
1             package Net::AWS::SES;
2 1     1   156020 use strict;
  1         2  
  1         30  
3 1     1   4 use warnings;
  1         2  
  1         28  
4 1     1   5 use Carp ('croak');
  1         11  
  1         46  
5 1     1   5 use MIME::Base64;
  1         2  
  1         51  
6 1     1   1705 use Time::Piece;
  1         8768  
  1         4  
7 1     1   2181 use HTTP::Headers;
  1         8436  
  1         31  
8 1     1   6900 use LWP::UserAgent;
  1         56358  
  1         37  
9 1     1   1015 use Digest::HMAC_SHA1;
  1         6986  
  1         49  
10 1     1   612 use Net::AWS::SES::Response;
  0            
  0            
11             our $VERSION = '0.04';
12            
13             sub __timestamp {
14             return localtime->datetime;
15             }
16            
17             sub __signature {
18             my $self = shift;
19             my ($date) = @_;
20             unless ($date) {
21             croak "signature(): usage error";
22             }
23             my $hmac = Digest::HMAC_SHA1->new( $self->secret_key );
24             $hmac->add($date);
25             return encode_base64( $hmac->digest );
26             }
27             sub __user_agent {
28             my $self = shift;
29             my $ua = LWP::UserAgent->new(
30             agent => sprintf( "%s/%s", __PACKAGE__, $VERSION ),
31             default_headers => $self->__header
32             );
33             return $ua;
34             }
35            
36             sub __header {
37             my $self = shift;
38             my $h = HTTP::Headers->new;
39             $h->date(time);
40             $h->header(
41             'Content-type' => 'application/x-www-form-urlencoded',
42             'X-Amzn-Authorization' => sprintf(
43             "AWS3-HTTPS AWSAccessKeyId=%s,Algorithm=HmacSHA1,Signature=%s",
44             $self->access_key, $self->__signature( $h->header('Date') )
45             )
46             );
47             return $h;
48             }
49            
50             sub new {
51             my $class = shift;
52             my %data = (
53             access_key => '',
54             secret_key => '',
55             region => 'us-east-1',
56             from => '',
57             __user_agent => undef,
58             __response => undef,
59             @_
60             );
61             unless ( $data{access_key} && $data{secret_key} ) {
62             croak "new(): usage error";
63             }
64             return bless \%data, $class;
65             }
66            
67             sub DESTROY {
68             my $self = shift;
69             $self->{__response} = undef;
70             }
71            
72             sub response {
73             my $self = shift;
74             return $self->{__response};
75             }
76            
77             sub access_key {
78             my $self = shift;
79             my ($key) = @_;
80             return $self->{access_key} unless $key;
81             return $self->{access_key} = $key;
82             }
83            
84             sub secret_key {
85             my $self = shift;
86             my ($key) = @_;
87             return $self->{secret_key} unless $key;
88             return $self->{secret_key} = $key;
89             }
90            
91             sub region {
92             my $self = shift;
93             my ($key) = @_;
94             return $self->{region} unless $key;
95             return $self->{region} = $key;
96             }
97            
98             sub call {
99             my $self = shift;
100             my ( $action, $args, $responseClass ) = @_;
101             unless ($action) {
102             croak "call(): usage error";
103             }
104             $args->{AWSAccessKeyId} = $self->access_key;
105             $args->{Action} = $action;
106             $args->{Timestamp} = $self->__timestamp;
107             my $ua = $self->__user_agent;
108             my $response =
109             $ua->post( "https://email." . $self->region . ".amazonaws.com",
110             $args );
111             return Net::AWS::SES::Response->new( $response, $action );
112             }
113            
114             sub send {
115             my $self = shift;
116             return $self->send_mime(@_) if ( @_ == 1 );
117             my (%args) = @_;
118             unless ( ref( $args{To} ) ) {
119             $args{To} = [ $args{To} ];
120             }
121             my $from = $args{From} || $self->{from};
122             unless ($from) {
123             croak "send(): usage error";
124             }
125             unless ( $from && ( $args{Body} || $args{Body_html} ) && $args{To} ) {
126             croak "Usage Error";
127             }
128             my %call_args = (
129             'Message.Subject.Data' => $args{Subject},
130             'Message.Subject.Charset' => 'UTF-8',
131             'Source' => $from
132             );
133             if ( $args{Body} ) {
134             $call_args{'Message.Body.Text.Data'} = $args{Body};
135             $call_args{'Message.Body.Text.Charset'} = 'UTF-8',;
136             }
137             if ( $args{Body_html} ) {
138             $call_args{'Message.Body.Html.Data'} = $args{Body_html};
139             $call_args{'Message.Body.Html.Charset'} = 'UTF-8';
140             }
141             if ( $args{ReturnPath} ) {
142             $call_args{'ReturnPath'} = $args{ReturnPath};
143             }
144             for ( my $i = 0 ; $i < @{ $args{To} } ; $i++ ) {
145             my $email = $args{To}->[$i];
146             $call_args{ sprintf( 'Destination.ToAddresses.member.%d', $i + 1 ) } =
147             $email;
148             }
149             my $r = $self->call( 'SendEmail', \%call_args );
150             } ## end sub send
151            
152             sub verify_email {
153             my ( $self, $email ) = @_;
154             unless ($email) {
155             croak "verify_email(): usage error";
156             }
157             return $self->call( 'VerifyEmailIdentity', { EmailAddress => $email } );
158             }
159             *delete_domain = \&delete_identity;
160             *delete_email = \&delete_identity;
161            
162             sub delete_identity {
163             my ( $self, $identity ) = @_;
164             unless ($identity) {
165             croak "delete_identity(): usage error";
166             }
167             return $self->call( 'DeleteIdentity', { Identity => $identity } );
168             }
169            
170             sub list_emails {
171             my $self = shift;
172             my %args = @_;
173             my %call_args = ( IdentityType => 'EmailAddress' );
174             if ( $args{limit} ) {
175             $call_args{MaxItems} = $args{limit};
176             }
177             if ( $args{offset} ) {
178             $call_args{NextToken} = $args{offset};
179             }
180             my $r = $self->call( 'ListIdentities', \%call_args );
181             }
182            
183             sub list_domains {
184             my $self = shift;
185             my %args = @_;
186             my %call_args = ( IdentityType => 'Domain' );
187             if ( $args{limit} ) {
188             $call_args{MaxItems} = $args{limit};
189             }
190             if ( $args{offset} ) {
191             $call_args{NextToken} = $args{offset};
192             }
193             my $r = $self->call( 'ListIdentities', \%call_args );
194             }
195            
196             sub get_quota {
197             my $self = shift;
198             return $self->call('GetSendQuota');
199             }
200            
201             sub get_statistics {
202             my $self = shift;
203             return $self->call('GetSendStatistics');
204             }
205            
206             sub send_mime {
207             my $self = shift;
208             my $msg = $_[0] if ( @_ == 1 );
209             if ( $msg && ref($msg) && $msg->isa("MIME::Entity") ) {
210             my $r = $self->call( 'SendRawEmail',
211             { 'RawMessage.Data' => encode_base64( $msg->stringify ) } );
212             return $r;
213             }
214             }
215            
216             sub get_dkim_attributes {
217             my $self = shift;
218             my @identities = @_;
219             my %call_args = ();
220             for ( my $i = 0 ; $i < @identities ; $i++ ) {
221             my $id = $identities[$i];
222             $call_args{ 'Identities.member.' . ( $i + 1 ) } = $id;
223             }
224             return $self->call( 'GetIdentityDkimAttributes', \%call_args );
225             }
226             __END__