├── .gitignore
├── .travis.yml
├── CHANGELOG.md
├── Makefile.PL
├── README.md
├── SendGrid-1.3.tar.gz
├── lib
    └── Email
    │   ├── SendGrid.pm
    │   └── SendGrid
    │       ├── Header.pm
    │       └── Transport
    │           ├── REST.pm
    │           ├── SMTP.pm
    │           └── Sendmail.pm
└── t
    ├── lib
        ├── Email
        │   └── SendGrid
        │   │   ├── Header
        │   │       └── Test.pm
        │   │   ├── Test.pm
        │   │   └── Transport
        │   │       ├── REST
        │   │           └── Test.pm
        │   │       └── SMTP
        │   │           └── Test.pm
        └── Mock
        │   └── Net
        │       └── SMTP
        │           └── TLS.pm
    └── test.t


/.gitignore:
--------------------------------------------------------------------------------
 1 | MANIFEST
 2 | MANIFEST.skip
 3 | META.yml
 4 | MYMETA.yml
 5 | MYMETA.json
 6 | Makefile.old
 7 | Makefile
 8 | pm_to_blib
 9 | blib/
10 | inc/
11 | 
12 | 


--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
 1 | language: perl
 2 | perl:
 3 | - '5.20'
 4 | - '5.18'
 5 | - '5.16'
 6 | - '5.14'
 7 | - '5.8'
 8 | notifications:
 9 |   hipchat:
10 |     rooms:
11 |       secure: nGaR7tHknJd4k0dDSR3mK4BuD1Amt8rLVNyUW5cPxNzPcJMMHQcEZ22zk5qzOW8cA9n3JgjjyesfRVSr/wiLnNjurIy8el3EIqXGp3qfQ4WNtVTJpR6QLqwd+ukwHSn+jloXbLCgkXwWXN7bEQXSyF8D9nOwTF/waZDqzryf/PU=
12 |     template:
13 |     - '<a href="https://travis-ci.org/%{repository}/builds/%{build_id}">%{repository}
14 |       Build %{build_number}</a> on branch <i>%{branch}</i> by %{author}: <strong>%{message}</strong>
15 |       <a href="https://github.com/sendgrid/docs/commits/%{commit}">View on GitHub</a>'
16 |     format: html
17 |     notify: true
18 | 


--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Change Log
2 | All notable changes to this project will be documented in this file.
3 | 
4 | ## [1.3] - 2015-4-29
5 | ### Added
6 | - Support for API keys
7 | 
8 | 


--------------------------------------------------------------------------------
/Makefile.PL:
--------------------------------------------------------------------------------
 1 | use inc::Module::Install;
 2 | 
 3 | # Define metadata
 4 | name 'SendGrid';
 5 | all_from 'lib/Email/SendGrid.pm';
 6 | license 'MIT';
 7 | 
 8 | # Specific dependencies
 9 | test_requires 'Test::More';
10 | test_requires 'Test::MockObject';
11 | test_requires 'Test::MockModule';
12 | test_requires 'Test::Class::Load';
13 | 
14 | requires 'Net::SMTP::TLS';
15 | requires 'Sys::Hostname';
16 | requires 'Carp';
17 | requires 'LWP::UserAgent';
18 | requires 'LWP::Protocol::https';
19 | requires 'Mail::Address';
20 | requires 'Sys::Hostname';
21 | requires 'URI::Escape';
22 | requires 'JSON';
23 | requires 'Encode';
24 | requires 'MIME::Entity';
25 | 
26 | WriteAll;
27 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | **IMPORTANT ANNOUNCEMENT**
 2 | 
 3 | **As of May 1, 2016, SendGrid will no longer support this library.**
 4 | 
 5 | Please direct any questions to the [Developer Experience](mailto:dx@sendgrid.com) team.
 6 | 
 7 | [![Build Status](https://travis-ci.org/sendgrid/sendgrid-perl.png?branch=master)](https://travis-ci.org/sendgrid/sendgrid-perl)
 8 | 
 9 | #sendgrid-perl
10 | Send emails via SendGrid. Provides wrapper for custom SMTP API fields
11 | and allows for easy manipulation of filter/app settings.
12 | 
13 | Written by Tim Jenkins.
14 | 
15 | #License
16 | Licensed under the MIT License.
17 | 
18 | #Install
19 | We are currently working on getting this module on CPAN. In the
20 | meantime, you can install from the included archive.
21 | 
22 |     git clone https://github.com/sendgrid/sendgrid-perl.git
23 |     cd sendgrid-perl
24 |     sudo cpanm SendGrid-1.3.tar.gz
25 | 
26 | You can also build the archive yourself:
27 |     
28 |     perl Makefile.PL
29 |     make
30 |     make test
31 |     make dist
32 | 
33 | #Basic usage
34 | 
35 | For authentication, please use either your SendGrid credentials or an [API key](https://sendgrid.com/docs/User_Guide/Account/api_keys.html).
36 | 
37 | ```perl
38 | use warnings;
39 | use strict;
40 | 
41 | use Email::SendGrid;
42 | use Email::SendGrid::Transport::REST;
43 | 
44 | my $sg = Email::SendGrid->new( from => 'from@example.com',
45 |                               to => 'to@example.com',
46 |                               subject => 'Testing',
47 |                               text => "Some text http://sendgrid.com/\n",
48 |                               html => '<html><body>Some html
49 |                                                   <a href="http://sendgrid.com">SG</a>
50 |                                        </body></html>' );
51 | 
52 | #disable click tracking filter for this request
53 | $sg->disableClickTracking();
54 | 
55 | #turn on the unsubscribe filter here with custom values
56 | $sg->enableUnsubscribe( text => "Unsubscribe here: <% %>", html => "Unsubscribe <% here %>" );
57 | 
58 | #set a category
59 | $sg->header->setCategory('first contact');
60 | 
61 | #add unique arguments
62 | $sg->header->addUniqueIdentifier( customer => '12345', location => 'somewhere' );
63 | 
64 | my $trans = Email::SendGrid::Transport::REST->new( username => 'sendgrid_username', password => 'sendgrid_password' );
65 | 
66 | my $error = $trans->deliver($sg);
67 | die $error if ( $error );
68 | ```
69 | 
70 | #Advanced Usage
71 | For more detailed information, please refer to the perldocs.
72 | 


--------------------------------------------------------------------------------
/SendGrid-1.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/sendgrid/sendgrid-perl/77553bfe7adf289fea539de07094ff48a6ffa8b6/SendGrid-1.3.tar.gz


--------------------------------------------------------------------------------
/lib/Email/SendGrid.pm:
--------------------------------------------------------------------------------
  1 | # Copyright(c) 2010 SendGrid
  2 | 
  3 | package Email::SendGrid;
  4 | 
  5 | use strict;
  6 | use vars qw($VERSION);
  7 | 
  8 | $VERSION = '1.3';
  9 | 
 10 | use Email::SendGrid::Header;
 11 | use Mail::Address;
 12 | use Encode;
 13 | use MIME::Words qw(encode_mimeword decode_mimewords);
 14 | 
 15 | use Carp;
 16 | 
 17 | sub new
 18 | {
 19 |   my $class = shift;
 20 | 
 21 |   my $self = bless { header => Email::SendGrid::Header->new(),
 22 |                      rcpts => [],
 23 |                      to => [],
 24 |                      cc => [],
 25 |                      bcc => [],
 26 |                      attachments => [],
 27 |                      encoding => 'quoted-printable',
 28 |                      charset => 'UTF-8',
 29 |                      @_ }, $class;
 30 | 
 31 |   return $self;
 32 | }
 33 | 
 34 | 
 35 | sub header
 36 | {
 37 |   my $self = shift;
 38 |   return $self->{header};
 39 | }
 40 | 
 41 | sub addTo
 42 | {
 43 |   my $self = shift;
 44 |   my @rcpts = @_;
 45 |   push(@{$self->{to}}, @rcpts);
 46 | }
 47 | 
 48 | sub addCc
 49 | {
 50 |   my $self = shift;
 51 |   my @rcpts = @_;
 52 |   push(@{$self->{cc}}, @rcpts);
 53 | }
 54 | 
 55 | sub addBcc
 56 | {
 57 |   my $self = shift;
 58 |   my @rcpts = @_;
 59 |   push(@{$self->{bcc}}, @rcpts);
 60 | }
 61 | 
 62 | sub addRcpts
 63 | {
 64 |   my $self = shift;
 65 |   my @rcpts = @_;
 66 | 
 67 |   foreach my $rcpt (@rcpts)
 68 |   {
 69 |     my ($addr) = Mail::Address->parse($rcpt);
 70 |     my $to = $addr->address();
 71 |     push(@{$self->{rcpts}}, $to);
 72 |   }
 73 | }
 74 | 
 75 | sub get
 76 | {
 77 |   my $self = shift;
 78 |   my $field = shift;
 79 |   my %args = @_;
 80 | 
 81 |   my $fields = { date => 1, text => 1, html => 1, subject => 1, from => 1, 'reply-to' => 1,
 82 |                  encoding => 1, charset => 1, attachments => 1, mail_from => 1,
 83 |                  to => 1, cc => 1, bcc => 1, 'message-id' => 1 };
 84 | 
 85 |   croak "Unknown field '$field'" if ( !defined($fields->{$field}) );
 86 | 
 87 |   my $ret = $self->{$field};
 88 |   $ret = encode($self->{charset}, $ret) if ( $args{'encode'} );
 89 | 
 90 |   return $ret;
 91 | }
 92 | 
 93 | sub set
 94 | {
 95 |   my $self = shift;
 96 |   my $field = shift;
 97 |   my $val = shift;
 98 | 
 99 |   my $fields = { date => 1, text => 1, html => 1, subject => 1, from => 1, 'reply-to' => 1,
100 |                  encoding => 1, charset => 1, attachments => 1, 'message-id' => 1 };
101 | 
102 |   croak "Unknown field '$field'" if ( !defined($fields->{$field}) );
103 | 
104 |   $self->{$field} = $val;
105 | }
106 | 
107 | sub addAttachment
108 | {
109 |   my $self = shift;
110 |   my $attach = shift;
111 |   push(@{$self->{attachments}}, { data => $attach, @_ });
112 | }
113 | 
114 | sub getMailFrom
115 | {
116 |   my $self = shift;
117 |   my ($addr) = Mail::Address->parse($self->{from});
118 |   my $mailFrom = $addr->address();
119 |   return $mailFrom
120 | }
121 | 
122 | sub createMimeMessage
123 | {
124 |   my $self = shift;
125 | 
126 |   my $mime;
127 | 
128 |   if ( !defined($self->{text}) && !defined($self->{html}) )
129 |   {
130 |     croak "No message data specified";
131 |   }
132 | 
133 |   my $text = $self->{text};
134 |   my $html = $self->{html};
135 | 
136 |   $text = encode($self->{charset}, $self->{text}) if ( $self->{text} && utf8::is_utf8($self->{text}) );
137 |   $html = encode($self->{charset}, $self->{html}) if ( $self->{html} && utf8::is_utf8($self->{html}) );
138 | 
139 |   if ( defined($text) && defined($html) )
140 |   {
141 |     $mime = MIME::Entity->build( Type => 'multipart/alternative' );
142 | 
143 |     $mime->attach(Type => 'text/plain',
144 |                   Encoding => $self->{encoding},
145 |                   Charset => $self->{charset},
146 |                   Data => $text);
147 | 
148 |     $mime->attach(Type => 'text/html',
149 |                   Encoding => $self->{encoding},
150 |                   Charset => $self->{charset},
151 |                   Data => $html);
152 |   }
153 |   elsif ( defined($self->{text}) )
154 |   {
155 |     $mime = MIME::Entity->build(Type => 'text/plain',
156 |                                 Encoding => $self->{encoding},
157 |                                 Charset => $self->{charset},
158 |                                 Data => $text);
159 |   }
160 |   else
161 |   {
162 |     $mime = MIME::Entity->build(Type => 'text/html',
163 |                                 Encoding => $self->{encoding},
164 |                                 Charset => $self->{charset},
165 |                                 Data => $html);
166 |   }
167 | 
168 |   foreach my $attach ( @{$self->{attachments}} )
169 |   {
170 |     my $data = $attach->{data};
171 |     my %params;
172 | 
173 |     if ( -f $data )
174 |     {
175 |       $params{Path} = $data;
176 |     }
177 |     else
178 |     {
179 |       $params{Data} = $data;
180 |     }
181 |     $params{Type} = $attach->{type} if ( defined($attach->{type}) );
182 |     $params{Encoding} = $attach->{encoding} if ( defined($attach->{encoding}) );
183 | 
184 |     $mime->attach( %params );
185 |   }
186 | 
187 |   if ( defined($self->{subject}) )
188 |   {
189 |     $mime->head->replace('subject', $self->encodeHeader($self->{subject}));
190 |   }
191 | 
192 |   if ( defined($self->{from}) )
193 |   {
194 |     $mime->head->replace('from', $self->encodeHeader($self->{from}));
195 |   }
196 | 
197 |   if ( defined($self->{date}) )
198 |   {
199 |     $mime->head->replace('date', $self->encodeHeader($self->{date}));
200 |   }
201 | 
202 |   if ( defined($self->{'message-id'}) )
203 |   {
204 |     $mime->head->replace('message-id', $self->{'message-id'});
205 |   }
206 | 
207 |   if ( defined($self->{'reply-to'}) )
208 |   {
209 |     $mime->head->replace('reply-to', $self->encodeHeader($self->{'reply-to'}));
210 |   }
211 | 
212 |   $self->mergeAddresses($mime, 'to');
213 |   $self->mergeAddresses($mime, 'cc');
214 | 
215 |   if ( keys(%{$self->header->{data}}) )
216 |   {
217 |     $mime->head->replace('x-smtpapi', $self->header->asJSON( fold => 72 ));
218 |   }
219 | 
220 |   return $mime;
221 | }
222 | 
223 | sub mergeAddresses
224 | {
225 |   my $self = shift;
226 |   my $mime = shift;
227 |   my $field = shift;
228 | 
229 |   if ( defined($self->{$field}) )
230 |   {
231 |     my $str = $self->{$field};
232 | 
233 |     if ( ref($self->{$field}) eq "ARRAY" )
234 |     {
235 |       $str = '';
236 |       foreach my $addr (@{$self->{$field}})
237 |       {
238 |         $str .= "$addr, ";
239 |       }
240 |       # Remove the trailing , on the last entry
241 |       chop($str);
242 |       chop($str);
243 |     }
244 | 
245 |     # If we had any addresses to put here, do so
246 |     if ( $str )
247 |     {
248 |       $mime->head->replace($field, $self->encodeHeader($str));
249 |     }
250 |   }
251 | }
252 | 
253 | sub getRecipients
254 | {
255 |   my $self = shift;
256 |   my @rcpts = $self->extractRecipients('to');
257 |   push(@rcpts, $self->extractRecipients('cc'));
258 |   push(@rcpts, $self->extractRecipients('bcc'));
259 |   return @rcpts;
260 | }
261 | 
262 | sub extractRecipients
263 | {
264 |   my $self = shift;
265 |   my $field = shift;
266 | 
267 |   my @list;
268 |   if ( ref($self->{$field}) ne "ARRAY" )
269 |   {
270 |     $self->{$field} = [ $self->{$field} ];
271 |   }
272 | 
273 |   foreach my $addr ( @{$self->{$field}} )
274 |   {
275 |     my @addrs = Mail::Address->parse($addr);
276 | 
277 |     foreach my $ad ( @addrs )
278 |     {
279 |       my $a = $ad->address();
280 |       if ( $a )
281 |       {
282 |         push(@list, $a);
283 |       }
284 |     }
285 |   }
286 | 
287 |   return @list;
288 | }
289 | 
290 | # This returns a string with proper MIME header encoding
291 | sub encodeHeader
292 | {
293 |   my $self = shift;
294 |   my $header = shift;
295 | 
296 |   my $str = $header;
297 | 
298 |   # First, if the thing is unicode, downgrade it
299 |   if ( utf8::is_utf8($header) )
300 |   {
301 |     $str = encode($self->{charset}, $str);
302 |   }
303 | 
304 |   # If the string is not 7bit clean, encode the header.
305 |   if ( my $count = () = $str =~ /[^\x00-\x7f]/g )
306 |   {
307 |     my $type = 'q';
308 |     # If the number of characters to be encoded is over 6, use base 64
309 |     $type = 'b' if ( $count > 6 );
310 | 
311 |     $str = encode_mimeword($str, $type, $self->{charset});
312 |   }
313 | 
314 |   return $str;
315 | }
316 | 
317 | 
318 | #############################################################
319 | # Convienience functions for working with the api
320 | 
321 | # Make the filter map something that can be exported so new filters can be added on the fly
322 | our $filterMap = { 'Gravatar' => { filter => 'gravatar' },
323 |                    'OpenTracking' => { filter => 'opentrack' },
324 |                    'ClickTracking' => { filter => 'clicktrack',
325 |                                         settings => {
326 |                                           shorten => {
327 |                                             setting => 'shorten',
328 |                                             },
329 |                                           text => {
330 |                                             setting => 'enable_text'
331 |                                           }
332 |                                         }
333 |                    },
334 |                    'SpamCheck' => { filter => 'spamcheck',
335 |                                     settings => {
336 |                                       score => {
337 |                                         setting => 'maxscore',
338 |                                       },
339 |                                       url => {
340 |                                         setting => 'url'
341 |                                       }
342 |                                     }
343 |                    },
344 |                    'Unsubscribe' => {
345 |                      filter => 'subscriptiontrack',
346 |                      settings => {
347 |                        text => {
348 |                          setting => 'text/plain',
349 |                          validation => sub {
350 |                            croak "Missing substitution tag in text" if ( $_[0] !~ /<\%\s*\%>/ );
351 |                          }
352 |                        },
353 |                        html => {
354 |                          setting => 'text/html',
355 |                          validation => sub {
356 |                            croak "Missing substitution tag in html" if ( $_[0] !~ /<\%\s*[^\s]+\s*\%>/ );
357 |                          }
358 |                        },
359 |                        replace => {
360 |                          setting => 'replace',
361 |                        },
362 |                      },
363 |                    },
364 |                    'Footer' => {
365 |                      filter => 'footer',
366 |                      settings => {
367 |                        text => { setting => 'text/plain' },
368 |                        html => { setting => 'text/html' },
369 |                      },
370 |                    },
371 |                    'GoogleAnalytics' => {
372 |                      filter => 'ganalytics',
373 |                      settings => {
374 |                        source => { setting => 'utm_source' },
375 |                        medium => { setting => 'utm_medium' },
376 |                        term => { setting => 'utm_term' },
377 |                        content => { setting => 'utm_content' },
378 |                        campaign => { setting => 'utm_campaign' },
379 |                      },
380 |                    },
381 |                    'DomainKeys' => {
382 |                      filter => 'domainkeys',
383 |                      settings => {
384 |                        domain => { setting => 'domain' },
385 |                        sender => { setting => 'sender' },
386 |                      },
387 |                    },
388 |                    'DKIM' => {
389 |                      filter => 'dkim',
390 |                      settings => {
391 |                        domain => { setting => 'domain' },
392 |                        use_from => { setting => 'use_from' },
393 |                      },
394 |                    },
395 |                    'Template' => {
396 |                      filter => 'template',
397 |                      validation => sub {
398 |                        my %args = @_;
399 |                        croak 'Missing html template' if ( !defined($args{html}) );
400 |                      },
401 |                      settings => {
402 |                        html => {
403 |                          setting => 'text/html',
404 |                          validation => sub {
405 |                            croak "Missing body substitution tag in template" if ( $_[0] !~ /<\%\s*\%>/ );
406 |                          },
407 |                        },
408 |                      },
409 |                    },
410 |                    'Twitter' => {
411 |                      filter => 'twitter',
412 |                      validation => sub {
413 |                        my %args = @_;
414 |                        croak 'Missing twitter username' if ( !defined($args{username}) );
415 |                        croak 'Missing twitter password' if ( !defined($args{password}) );
416 |                      },
417 |                      settings => {
418 |                        username => { setting => 'username' },
419 |                        password => { setting => 'password' },
420 |                      },
421 |                    },
422 |                    'Bcc' => {
423 |                      filter => 'bcc',
424 |                      validation => sub {
425 |                        my %args = @_;
426 |                        croak 'Missing bcc email' if ( !defined($args{email}) );
427 |                      },
428 |                      settings => {
429 |                        email => { setting => 'email' },
430 |                      },
431 |                    },
432 |                    'BypassListManagement' => {
433 |                      filter => 'bypass_list_management',
434 |                    },
435 |                    'Hold' => {
436 |                      filter => 'hold',
437 |                    },
438 |                    'Drop' => {
439 |                      filter => 'drop',
440 |                    }
441 |     };
442 | 
443 | our $AUTOLOAD;
444 | 
445 | # We autoload all of the filters and how their settings map to the smtpapi via the map above
446 | sub AUTOLOAD
447 | {
448 |   my $self = shift;
449 | 
450 |   my $type = ref ($self) || croak "$self is not an object";
451 |   my $func = $AUTOLOAD;
452 |   $func =~ s/.*://;
453 | 
454 |   if ( $func =~ /^disable(.*)/ )
455 |   {
456 |     my $filterFunc = $1;
457 | 
458 |     my $filter = $filterMap->{$filterFunc}->{filter};
459 | 
460 |     croak "Unknown filter function '$func'" if ( !defined($filter) );
461 |     $self->header->disable($filter);
462 |   }
463 |   elsif ( $func =~ /^enable(.*)/ )
464 |   {
465 |     my $filterFunc = $1;
466 |     my %args = @_;
467 | 
468 |     my $filterData = $filterMap->{$filterFunc};
469 |     $filterData->{validation}(%args) if ( defined($filterData->{validation}) );
470 | 
471 |     my $filter = $filterData->{filter};
472 |     croak "Unknown filter function '$func'" if ( !defined($filter) );
473 | 
474 |     $self->header->enable($filter);
475 |     foreach my $set ( keys(%args) )
476 |     {
477 |       my $filtSet = $filterData->{settings}->{$set};
478 |       croak "Unknown filter setting '$set'" if ( !defined($filtSet) );
479 |       $filtSet->{validation}($args{$set}) if ( defined($filtSet->{validation}) );
480 | 
481 |       $self->header->addFilterSetting($filter, $filtSet->{setting}, $args{$set});
482 |     }
483 |   }
484 |   else
485 |   {
486 |     croak "Unknown subroutine '$func'";
487 |   }
488 | }
489 | 
490 | # Have to define so that AUTOLOAD doesn't eat this
491 | sub DESTROY
492 | {
493 | }
494 | 
495 | =head1 NAME
496 | 
497 | Email::SendGrid - Class for building a message to be sent through the SendGrid
498 | mail service
499 | 
500 | =head1 SYNOPSIS
501 | 
502 |     use Email::SendGrid
503 | 
504 |     my $sg = Email::SendGrid->new( from => $from,
505 |                                   to => $to,
506 |                                   subject => 'Testing',
507 |                                   text => "Some text http://sendgrid.com/\n",
508 |                                   html => '<html><body>Some html
509 |                                                       <a href="http://sendgrid.com">SG</a>
510 |                                            </body></html>',
511 |                               );
512 | 
513 |     $sg->disableClickTracking();
514 |     $sg->enableUnsubscribe( text => "Unsubscribe here: <% %>", html => "Unsubscribe <% here %>" );
515 | 
516 | =head1 DESCRIPTION
517 | 
518 | This module allows for easy integration with the SendGrid email distribution
519 | service and its SMTP API. It allows you to build up the pieces that make the
520 | email itself, and then pass this object to the Email::SendGrid::Transport class
521 | that you wish to use for final delivery.
522 | 
523 | =head1 CLASS METHODS
524 | 
525 | =head2 Creation
526 | 
527 | =head3 new[ARGS]
528 | 
529 | This creates the object and optionally populates some of the data fields. Available fields are:
530 | 
531 | =over
532 | 
533 | =item from
534 | 
535 | The From address to use in the email
536 | 
537 |   from => 'Your Name <you@yourcompany.com>'
538 | 
539 | =item to
540 | 
541 | Either a string or ARRAYREF containing the addresses to send to
542 | 
543 |   to => 'Your Customer <them@theircompany.com>, Another Customer <someone@somewhereelse.com>'
544 | 
545 |   to => [ them@theircompany.com, someone@somewhereelse.com ]
546 | 
547 | =item cc
548 | 
549 | Adds additional recipients for the email and sets the CC field of the email
550 | 
551 | =item bcc
552 | 
553 | Adds additional recipients whose addresses will not appear in the headers of
554 | the email
555 | 
556 | =item subject
557 | 
558 | Sets the subject for the message
559 | 
560 | =item date
561 | 
562 | Sets the date header for the message. If this is not specified, the current
563 | date will be used
564 | 
565 | =item message-id
566 | 
567 | Sets the message id header. If this is not specified, one will be randomly
568 | generated
569 | 
570 | =item encoding
571 | 
572 | Sets the encoding for the email. Options are 7bit, base64, binary, and
573 | quoted-printable.
574 | Quoted printable is the default encoding
575 | 
576 | =item charset
577 | 
578 | Sets the default character set. iso-8859-1 (latin1) is the default
579 | If you will be using wide characters, it is expected that the strings
580 | passed in will already be encoded with this charset
581 | 
582 | =item text
583 | 
584 | Sets the data for the plain text portion of the email
585 | 
586 | =item html
587 | 
588 | Sets the data for the html portion of the email
589 | 
590 | =back
591 | 
592 | =head2 Methods for setting data
593 | 
594 | =head3 addTo(LIST)
595 | 
596 | =head3 addCc(LIST)
597 | 
598 | =head3 addBcc(LIST)
599 | 
600 | Inserts additional recipients for the message
601 | 
602 | =head3 get(PARAMETER)
603 | 
604 | =head3 set(PARAMETER, VALUE)
605 | 
606 | Returns / sets a parameter for this message. Parameters are the same as those
607 | in the new method
608 | 
609 | =head3 addAttachment(DATA, [OPTIONS])
610 | 
611 | Specifies an attachment for the email. This can either be the data for the
612 | attachment, or a file to attach
613 | 
614 | While the underlying MIME::Entity that will be created will try to determine
615 | the best encoding and MIME type, you can also specify it in the options
616 | 
617 |   $sg->addAttachment('/tmp/my.pdf',
618 |                       type => 'application/pdf',
619 |                       encoding => 'base64');
620 | 
621 | =head2 SMTP API functions
622 | 
623 | This class contains a number of methods for working with the SMTP API. The
624 | SMTP API allows for customization of SendGrid filters on an individual
625 | basis for emails. For more information about the api, please visit
626 | http://wiki.sendgrid.com/doku.php?id=smtp_api
627 | 
628 | =head3 header
629 | 
630 | Returns a reference to the Email::SendGrid::Header object used to communicate
631 | with the SMTP API. Useful if you want to set unique identifiers or use the
632 | mail merge functionality
633 | 
634 | =head3 enableGravatar
635 | 
636 | =head3 disableGravatar
637 | 
638 | Enable / disable the addition of a gravatar in the email
639 | 
640 | =head3 enableClickTracking
641 | 
642 | =head3 disableClickTracking
643 | 
644 | Enables / disables click tracking for emails. By default this will only
645 | enable click tracking for the html portion of emails. If you want to
646 | also do click tracking on plain text, you can use the addition prameter 'text'
647 |   $sg->enableClickTracking( text => 1 );
648 | 
649 | =head3 enableUnsubscribe
650 | 
651 | =head3 disableUnsubscribe
652 | 
653 | Enables / disables the addition of subscription management headers / links
654 | in the email.
655 | 
656 | If no arguments are specified for enable, only a list-unsubscribe header
657 | will be added to the email. Additional parameters are:
658 | 
659 | =over
660 | 
661 | =item text
662 | 
663 | The string to be added to the plain text portion of the email. This must
664 | contain the string <% %>, which is where the link will be placed
665 | 
666 | =item html
667 | 
668 | The string to be added to the html portion of the email. This must contain a
669 | tag with the format "<% link text %>", which will be replaced with the link
670 | 
671 | =item replace
672 | 
673 | A string inside of the email body to replace with the unsubscribe link. If
674 | this tag is not found in the body of the email, then the appropriate text or
675 | html setting will be used. If none of these are found, a link will not be
676 | inserted
677 | 
678 |   $sg->enableUnsubscribe( text => 'Unsubscribe here: <% %>',
679 |                           html => 'Unsubscribe <% here %>',
680 |                           replace => 'MyUnsubscribeTag' );
681 | 
682 | =back
683 | 
684 | =head3 enableOpenTracking
685 | 
686 | =head3 disableOpenTracking
687 | 
688 | Enables / disables open tracking
689 | 
690 | =head3 enableFooter
691 | 
692 | =head3 disableFooter
693 | 
694 | Enables / disables the insertion of a footer in this email.
695 | 
696 | Parameters are:
697 | 
698 | =over
699 | 
700 | =item text
701 | 
702 | String to insert into the plain text portion of the email
703 | 
704 | =item html
705 | 
706 | String to insert into the html portion of the email
707 | 
708 |   $sg->enableFooter( text => 'Text footer', html => 'Html footer' );
709 | 
710 | =back
711 | 
712 | =head3 enableSpamCheck
713 | 
714 | =head3 disableSpamCheck
715 | 
716 | Enables / disables the checking of email for spam content. This is useful when
717 | you are sending content that is generated by your users, such as a forum
718 | 
719 | Parameters are:
720 | 
721 | =over
722 | 
723 | =item score
724 | 
725 | Spam Assassin score at which point the email will be flagged as spam and
726 | dropped. If this is not specified, 5 will be used
727 | 
728 | =item url
729 | 
730 | A url to post to in the event that the message is flagged as spam and dropped.
731 | 
732 | =back
733 | 
734 | =head3 enableGoogleAnalytics
735 | 
736 | =head3 disabelGoogleAnalytics
737 | 
738 | Enables / disables link rewrites to support Google Analytics.
739 | 
740 | Paramters are:
741 | 
742 | =over
743 | 
744 | =item source
745 | 
746 | Sets the string for the utm_source field
747 | 
748 | =item medium
749 | 
750 | Sets the string for the utm_medium field
751 | 
752 | =item term
753 | 
754 | Sets the string for the utm_term field
755 | 
756 | =item content
757 | 
758 | Sets the string for the utm_content field
759 | 
760 | =item campaign
761 | 
762 | Sets the string for the utm_campaign field
763 | 
764 | =back
765 | 
766 | =head3 enableDomainKeys
767 | 
768 | =head3 disableDomainKeys
769 | 
770 | Enables / disables Domain Keys signatures for the message.
771 | 
772 | Domain Keys is a digitial signature method, primarily used by Yahoo.
773 | 
774 | Parameters are:
775 | 
776 | =over
777 | 
778 | =item domain
779 | 
780 | The domain to sign the messages as. This domain must be set up with the proper
781 | DNS records, which can be found when going through the whitelabel wizard
782 | 
783 | =item sender
784 | 
785 | Sets if SendGrid will add a Sender header if the From email address does not
786 | match the specified domain. This allows for messages to still have a valid
787 | DomainKeys signature if the email address in the From field does not have
788 | whitelabeling set up, however it means that some email clients will display
789 | the message as "on behalf of" the From address
790 | 
791 | =back
792 | 
793 | =head3 enableTemplate
794 | 
795 | =head3 disableTemplate
796 | 
797 | Enables / disables the insertion of an email template. If you are enabling a
798 | template, you must specify the text of it in the html parameter. This
799 | text must contain the string "<% %>", which will be replaced with the body
800 | of the message
801 | 
802 | =head3 enableTwitter
803 | 
804 | Allows you to set twitter username / password information for this email.
805 | The Twitter filter can be used to send either status updates or direct
806 | messages, based on the recipient email address
807 | 
808 |   my $sg = Email::SendGrid->new( to => 'sendgrid@twitter', text => "My update" );
809 | 
810 |   $sg->enableTwitter( username => 'myusername', password => 'mypassword' );
811 | 
812 | =head3 enableBcc
813 | 
814 | =head3 disableBcc
815 | 
816 | Enables / disables the automatic blind carbon copy of the email to a specific
817 | email address. While it makes little sense to enable a bcc here, versus adding
818 | it as a Bcc with the methods discussed previously, you can specify an email
819 | paramter which is the address to send to
820 | 
821 | =head3 enableBypassListManagement
822 | 
823 | Allows you to specify that this email should not be suppressed for any reason,
824 | including the address appearing on the bounce, unsubscribe, or spam report
825 | suppression lists. This is useful for urgent emails, such as password reset
826 | notifications, that should always be attempted for delivery.
827 | 
828 | =head2 Transport methods
829 | 
830 | If you don't want to use one of the Email::SendGrid::Transport classes, or
831 | want to build your own, these methods are used to get the data for transport
832 | 
833 | =head3 createMimeMessage
834 | 
835 | Returns a MIME::Entity for the email
836 | 
837 | =head3 getMailFrom
838 | 
839 | Returns the address to be used in the MAIL FROM portion of the SMTP protocol
840 | 
841 | =head3 getRecipients
842 | 
843 | Returns an array of the recipient address for the email, to be used in the
844 | RCPT TO portion of the SMTP protocol
845 | 
846 | =head1 AUTHOR
847 | 
848 | Tim Jenkins <tim@sendgrid.com>
849 | 
850 | =head1 COPYRIGHT
851 | 
852 | Copyright (c) 2010 SendGrid. All rights reserved.
853 | This program is free software; you can redistribute it and/or modify
854 | it under the same terms as Perl itself.
855 | 
856 | =cut
857 | 
858 | 
859 | 1;
860 | 


--------------------------------------------------------------------------------
/lib/Email/SendGrid/Header.pm:
--------------------------------------------------------------------------------
  1 | package Email::SendGrid::Header;
  2 | 
  3 | use strict;
  4 | 
  5 | use JSON;
  6 | use MIME::Entity;
  7 | 
  8 | sub new
  9 | {
 10 |   my $class = shift;
 11 | 
 12 |   my $self = bless { 'data' => { },
 13 |                      @_
 14 |                    }, $class;
 15 | 
 16 |   return $self;
 17 | }
 18 | 
 19 | sub addTo
 20 | {
 21 |   my $self = shift;
 22 |   my @to = @_;
 23 |   push(@{$self->{data}->{to}}, @to);
 24 | }
 25 | 
 26 | sub addSubVal
 27 | {
 28 |   my $self = shift;
 29 |   my $var = shift;
 30 |   my @val = @_;
 31 | 
 32 |   if (!defined($self->{data}->{sub}->{$var}))
 33 |   {
 34 |     $self->{data}->{sub}->{$var} = [];
 35 |   }
 36 |   push(@{$self->{data}->{sub}->{$var}}, @val);
 37 | }
 38 | 
 39 | sub addUniqueIdentifier
 40 | {
 41 |   my $self = shift;
 42 |   my $args;
 43 |   if ( scalar(@_) == 1 && ref($_[0]) eq "HASH" )
 44 |   {
 45 |     $args = $_[0];
 46 |   }
 47 |   else
 48 |   {
 49 |     $args = { @_ };
 50 |   }
 51 | 
 52 |   foreach my $arg ( keys(%{$args}) )
 53 |   {
 54 |     $self->{data}->{unique_args}->{$arg} = $args->{$arg};
 55 |   }
 56 | }
 57 | 
 58 | sub addSection
 59 | {
 60 |   my $self = shift;
 61 |   my %sections = @_;
 62 |   foreach my $sec ( keys(%sections) )
 63 |   {
 64 |     $self->{data}->{section}->{$sec} = $sections{$sec};
 65 |   }
 66 | }
 67 | 
 68 | sub setCategory
 69 | {
 70 |   my $self = shift;
 71 |   my $cat = shift;
 72 |   $self->{data}->{category} = $cat;
 73 | }
 74 | 
 75 | sub enable
 76 | {
 77 |   my $self = shift;
 78 |   my $filter = shift;
 79 | 
 80 |   $self->addFilterSetting($filter, 'enable', 1);
 81 | }
 82 | 
 83 | sub disable
 84 | {
 85 |   my $self = shift;
 86 |   my $filter = shift;
 87 | 
 88 |   $self->addFilterSetting($filter, 'enable', 0);
 89 | }
 90 | 
 91 | sub addFilterSetting
 92 | {
 93 |   my $self = shift;
 94 |   my $filter = shift;
 95 | 
 96 |   my $val = pop;
 97 | 
 98 |   if (!defined($self->{data}->{filters}->{$filter}))
 99 |   {
100 |     $self->{data}->{filters}->{$filter} = {};
101 |   }
102 |   if (!defined($self->{data}->{filters}->{$filter}->{settings}))
103 |   {
104 |     $self->{data}->{filters}->{$filter}->{settings} = {};
105 |   }
106 | 
107 |   my $set = $self->{data}->{filters}->{$filter}->{settings};
108 | 
109 |   while ( my $setting = shift(@_) )
110 |   {
111 |     if ( scalar(@_ ) )
112 |     {
113 |       $set->{$setting} = {} if ( !defined($set->{$setting}) );
114 |       die "Attempt to overwrite setting" if ( ref($set->{$setting}) ne "HASH" );
115 |       $set = $set->{$setting};
116 |     }
117 |     else
118 |     {
119 |       die "Attempt to overwrite hash" if ( ref($set->{$setting}) );
120 |       $set->{$setting} = $val;
121 |     }
122 |   }
123 | }
124 | 
125 | sub setASMGroupID
126 | {
127 |   my $self = shift;
128 |   my $asmGroupId = shift;
129 |   $self->{data}->{asm_group_id} = $asmGroupId;
130 | }
131 | 
132 | sub addHeader
133 | {
134 |   my $self = shift;
135 |   my $mime = shift;
136 | 
137 |   $mime->head->replace('x-smtpapi', $self->asJSON());
138 |   $mime->head->fold('x-smtpapi');
139 | }
140 | 
141 | sub asJSON
142 | {
143 |   my $self = shift;
144 |   my %args = @_;
145 | 
146 |   my $json = JSON->new;
147 |   $json->space_before(1);
148 |   $json->space_after(1);
149 |   $json->ascii(1);
150 |   my $str = $json->encode($self->{data});
151 |   if ( $args{fold} )
152 |   {
153 |     my $length = $args{fold};
154 | 
155 |     $str =~ s/(.{1,$length})(\s)/$1\n$2/g;
156 |   }
157 | 
158 |   return $str;
159 | }
160 | 
161 | =head1 NAME
162 | 
163 | Email::SendGrid::Header - Functions for building the string necessary for
164 | working with SendGrid's SMTP API
165 | 
166 | =head1 SYNOPSIS
167 | 
168 |   use Email::SendGrid::Header;
169 | 
170 |   my $hdr = Email::SendGrid::Header->new();
171 |   $hdr->setCategory('first contact');
172 |   $hdr->addUniqueIdentifier( customer_id => 4 );
173 |   my $str = $hdr->asJSON( fold => 72 );
174 | 
175 | =head1 DESCRIPTION
176 | 
177 | This class handles setting the appropriate hash variables to work with
178 | SendGrid's SMTP API. With the SMTP API you can control filters that are
179 | applied to your email, supply additional parameters to identify the message,
180 | and make use of mail merge capabilities.
181 | 
182 | =head1 CLASS METHODS
183 | 
184 | =head2 new
185 | 
186 | Creates a new instance of the class
187 | 
188 | =head2 addFilterSetting
189 | 
190 | Allows you to specify a filter setting. You can find a list of filters and
191 | their settings here:
192 | http://wiki.sendgrid.com/doku.php?id=filters
193 | 
194 |   $hdr->addFilterSetting('twitter', 'username', 'myusername');
195 | 
196 | =head2 enable
197 | 
198 | =head2 disable
199 | 
200 | These are shortcut methods for enabling / disabling a filter. They are
201 | the same as using addFilterSetting on the 'enable' setting.
202 | 
203 |   $hdr->enable('opentrack');
204 | 
205 | is the same as
206 | 
207 |   $hdr->addFilterSetting('opentrack', 'enable', 1)
208 | 
209 | =head2 setCategory
210 | 
211 | This sets the category for this email. Statistics are stored on a per
212 | category basis, so this can be useful for tracking on a per group
213 | basis
214 | 
215 | =head2 addUniqueIdentifier
216 | 
217 | This adds parameters and values that will be passed back through SendGrid's
218 | Event API if an event notification is triggered by this email
219 | 
220 |   $hdr->addUniqueIdentifier( customer => 'someone', location => 'somewhere' );
221 | 
222 | =head2 addSection
223 | 
224 | This adds sections of text that will be replaced, allowing for common text that will be reused
225 | on multiple recipients to be combined in one location.
226 | 
227 |   $hdr->addSection( String-in-Substitutions => String-To-replace )
228 | 
229 | An example of this would look like the following:
230 | 
231 | $hdr->addSubVal('%body', '%body1%', '%body2%');
232 | $hdr->addSubVal('%name%', 'Tim', 'Joe');
233 | $hdr->addSection('%body1' => "Body text specific unspecific for %name%");
234 | $hdr->addSection('%body2' => "Some other body text, customized for %name%");
235 | 
236 | =head2 addTo(ARRAY)
237 | 
238 | This adds recipients for the mail merge functionality. Recipients can be
239 | specified as simply an email address, such as
240 | 
241 |  'someone@somewhere.com'
242 | 
243 | or as a full name and address, like
244 | 
245 |  'Someone Special <someone@somewhere.com>'
246 | 
247 | This value will be substituted into the To header of the email when it is merged
248 | 
249 | This functionality can also be used to help decrease the latency caused by the
250 | SMTP protocol when sending the same message to a large number of recipients
251 | 
252 | =head2 addSubVal(TAG, ARRAY)
253 | 
254 | This adds a substitution value to be used during the mail merge. Substitutions
255 | will happen in order added, so calls to this should match calls to addTo
256 | 
257 |   $hdr->addTo('me@myplace.com');
258 |   $hdr->addTo('you@myplace.com');
259 | 
260 |   $hdr->addSubVal('%name%', 'me', 'you');
261 | 
262 | =head2 setASMGroupID
263 | 
264 | This sets the ASM Group ID for this email. Please read the documentation here:
265 | https://sendgrid.com/docs/API_Reference/Web_API_v3/Advanced_Suppression_Manager/index.html
266 | 
267 |   $hdr->setASMGroupID(123);
268 | 
269 | =head2 asJSON
270 | 
271 | Returns the JSON encoded string used to communicate with the SMTP API. It
272 | takes an optional fold paramter specifying the length at which to fold the
273 | header. It is important to fold the header, since most mail servers will
274 | break lines up to keep them shorter than 1,000 characters, which will
275 | introduce spaces into values in the string
276 | 
277 | =head2 addHeader(MIME Entity)
278 | 
279 | Shortcut function for adding the x-smtpapi header into a mime entity
280 | 
281 | =head1 AUTHOR
282 | 
283 | Tim Jenkins <tim@sendgrid.com>
284 | 
285 | =cut
286 | 
287 | 1;
288 | 
289 | 


--------------------------------------------------------------------------------
/lib/Email/SendGrid/Transport/REST.pm:
--------------------------------------------------------------------------------
  1 | # Copyright (c) 2010 SendGrid
  2 | 
  3 | package Email::SendGrid::Transport::REST;
  4 | 
  5 | use strict;
  6 | use vars qw($VERSION);
  7 | 
  8 | $VERSION = '1.3';
  9 | 
 10 | use LWP::UserAgent;
 11 | use Mail::Address;
 12 | use Sys::Hostname;
 13 | use URI::Escape;
 14 | use JSON;
 15 | use Encode;
 16 | use Carp;
 17 | use English qw( -no_match_vars ); 
 18 | use Data::Dumper qw(Dumper);
 19 | 
 20 | sub new
 21 | {
 22 |   my $class = shift;
 23 | 
 24 |   my $self = bless { server => 'api.sendgrid.com',
 25 |                      path => '/api/mail.send.json',
 26 |                      timeout => 30,
 27 |                      @_,
 28 |                     }, $class;
 29 | 
 30 |   if ( defined($self->{username}) && defined($self->{api_key}) )
 31 |   {
 32 |     die "Must only specify username/password or api key, not both";
 33 |   }
 34 | 
 35 |   if ( !(defined($self->{username}) && defined($self->{password})) && !defined($self->{api_key}) )
 36 |   {
 37 |     die "Must speicfy username/password or api key";
 38 |   }
 39 | 
 40 |   return $self;
 41 | }
 42 | 
 43 | sub deliver
 44 | {
 45 |   my $self = shift;
 46 |   my $sg = shift;
 47 | 
 48 |   # Get the character set for encoding
 49 |   my $charset = $sg->get('charset');
 50 | 
 51 |   # Get the from fields
 52 |   my $from = $sg->get('from');
 53 | 
 54 |   my ($addr) = Mail::Address->parse($from);
 55 | 
 56 |   my $fromName = $addr->name();
 57 |   $fromName = encode($charset, $fromName) if ( utf8::is_utf8($fromName) );
 58 | 
 59 |   my $fromAddr = $addr->address();
 60 | 
 61 |   # Get the To fields.
 62 |   my ($toAddr, $toName) = $self->splitAddresses($sg->get('to'));
 63 | 
 64 |   # Do a sanity check on the argument lengths
 65 |   if ( scalar(@$toName) && scalar(@$toName) != scalar(@$toAddr) )
 66 |   {
 67 |     croak "There are an inconsistant number of recipients in the to field" .
 68 |           "that have names, which is incompatible with the REST API";
 69 |   }
 70 | 
 71 |   my $subject = $sg->get('subject', encode => 1);
 72 |   my $text = $sg->get('text', encode => 1);
 73 |   my $html = $sg->get('html', encode => 1);
 74 |   my $date = $sg->get('date', encode => 1);
 75 |   my $messageId = $sg->get('message-id', encode => 0);
 76 |   my $reply = $sg->get('reply-to', encode => 1);
 77 |   my $attachments = $sg->get('attachments', encode => 0);
 78 | 
 79 |   # Build the query
 80 | 
 81 |   my $query = 'https://' . $self->{server} . $self->{path} . "?";
 82 |   if ( defined($self->{username}) )
 83 |   {
 84 |     $query .= "api_user=" . uri_escape($self->{username}) . "&api_key=" . uri_escape($self->{password});
 85 |   }
 86 | 
 87 |   # Add recipients
 88 |   foreach my $i ( 0..(scalar(@$toAddr)-1) )
 89 |   {
 90 |     $query .= "&to[]=$toAddr->[$i]";
 91 |     my $name = $toName->[$i];
 92 |     $name = encode($charset, $name) if ( utf8::is_utf8($name) );
 93 |     $query .= "&toname[]=" . uri_escape($name) if ( $name );
 94 |   }
 95 | 
 96 |   # Add the from
 97 |   $query .= "&from=$fromAddr";
 98 |   $query .= "&fromname=" . uri_escape($fromName) if ( defined($fromName) );
 99 | 
100 |   # Add the subject
101 |   $query .= "&subject=" . uri_escape($subject);
102 | 
103 |   # Add the reply to
104 |   $query .= "&replyto=" . uri_escape($reply) if ( defined($reply) );
105 | 
106 |   # Date
107 |   $query .= "&date=" . uri_escape($date) if ( defined($date) );
108 | 
109 |   # smtp api header
110 |   my $hdr = $sg->header()->asJSON();
111 |   $hdr = encode($charset, $hdr) if ( utf8::is_utf8($hdr) );
112 | 
113 |   $query .= "&x-smtpapi=" . uri_escape($hdr) if ( $hdr ne "{}" );
114 | 
115 |   # Text
116 |   $query .= "&text=" . uri_escape($text) if ( defined($text) );
117 | 
118 |   # html
119 |   $query .= "&html=" . uri_escape($html) if ( defined($html) );
120 | 
121 |   my $i = 0;
122 |   # Attachments
123 |   foreach my $attach ( @$attachments )
124 |   {
125 |     my $filename = "attachment" . ++$i;
126 |     my $data = $attach->{data};
127 |     my %params;
128 | 
129 |     if ( -f $data )
130 |     {
131 |       $filename = $data;
132 |       $data = q{}; 
133 |       { 
134 |          local $RS = undef; # this makes it just read the whole thing,
135 |          my $fh; 
136 |          croak "Can't open $filename: $!\n" if not open $fh, '<', $filename;
137 |          $data = <$fh>; 
138 |          croak 'Some Error During Close :/ ' if not close $fh;
139 |       }
140 |     }
141 |     my @path = split('/', $filename);
142 |     my $file = $path[$#path];
143 |     $query .= "&files[" . uri_escape(encode('utf8', $file)) . "]=" . uri_escape(encode('utf8', $data));
144 |   }
145 | 
146 |   # Other headers (currently just message-id)
147 |   my $additionalHeaders = {};
148 | 
149 |   $additionalHeaders->{'message-id'} = $messageId if ( defined($messageId) );
150 | 
151 |   $query .= "&headers=" . uri_escape(to_json($additionalHeaders, { ascii => 1})) if ( keys(%$additionalHeaders) );
152 |   my $resp = $self->send($query);
153 | 
154 |   return undef if ( $resp->{message} eq "success" );
155 | 
156 |   return $resp->{errors}->[0];
157 | }
158 | 
159 | sub send
160 | {
161 |   my $self = shift;
162 |   my $query = shift;
163 | 
164 |   my $ua = LWP::UserAgent->new( timeout => $self->{timeout}, agent => 'sendgrid/' . $VERSION . ';perl' );
165 | 
166 |   if ( defined($self->{api_key}) )
167 |   {
168 |     $ua->default_header('Authorization' => "Bearer $self->{api_key}");
169 |   } 
170 |   my $response = $ua->get($query);
171 | 
172 |   return { errors => [ $response->status_line() ] } if ( !$response->is_success );
173 | 
174 |   my $content = $response->decoded_content();
175 | 
176 |   my $resp;
177 | 
178 |   eval {
179 |     $resp = from_json($content);
180 |   };
181 |   if ( $@ )
182 |   {
183 |     croak "malformed json response: $@";
184 |   }
185 | 
186 |   return $resp;
187 | }
188 | 
189 | sub splitAddresses
190 | {
191 |   my $self = shift;
192 |   my $field = shift;
193 | 
194 |   my $str = $field;
195 | 
196 |   my @ad;
197 |   my @name;
198 | 
199 |   if ( ref($field) eq "ARRAY" )
200 |   {
201 |     $str = '';
202 |     foreach my $addr (@$field)
203 |     {
204 |       $str .= "$addr, ";
205 |     }
206 |     # Remove the trailing , on the last entry
207 |     chop($str);
208 |     chop($str);
209 |   }
210 | 
211 |   my @addrs = Mail::Address->parse($str);
212 |   foreach my $addr ( @addrs )
213 |   {
214 |     push(@ad, $addr->address());
215 |     push(@name, $addr->name()) if ( $addr->name() );
216 |   }
217 | 
218 |   return (\@ad, \@name);
219 | }
220 | 
221 | 
222 | =head1 NAME
223 | 
224 | Email::SendGrid::Transport::REST - REST Transport class to SendGrid
225 | 
226 | =head1 SYNOPSIS
227 | 
228 |   use Email::SendGrid::Transport::REST;
229 |   use Email::SendGrid;
230 | 
231 |   my $sg = Email::SendGrid->new();
232 |   ...
233 |   my $trans = Email::SendGrid::Transport::REST->new( username => 'mysuername',
234 |                                                     password => 'mypassword' );
235 | 
236 |   my $error = $trans->deliver($sg);
237 |   die $error if ( $error );
238 | 
239 | =head1 DESCRIPTION
240 | 
241 | This is a transport module for sending messages through the SendGrid email
242 | distribution system via a REST API. After you have completed building your
243 | Email::SendGrid object, use this class to make a connection to SendGrid's
244 | web servers and deliver the message.
245 | 
246 | =head1 CLASS METHODS
247 | 
248 | =head2 new[ARGS]
249 | 
250 | Creates the instance of the class. At a minimum you must specify the username
251 | and password used to connect.
252 | 
253 | Parameters are:
254 | 
255 | =over
256 | 
257 | =item username
258 | 
259 | Your SendGrid username
260 | 
261 | =item password
262 | 
263 | Your SendGrid password
264 | 
265 | =item api_key
266 | 
267 | Your SendGrid API key
268 | 
269 | =item server
270 | 
271 | The server to connect to (default is sendgrid.com)
272 | 
273 | =item path
274 | 
275 | The path portion of the url (default is /api/mail.send.json)
276 | 
277 | =item timeout
278 | 
279 | Connection timeout, in seconds (default is 30)
280 | 
281 | =back
282 | 
283 | =head2 deliver(object)
284 | 
285 | Delivers the Email::SendGrid object specified. This will return undef on
286 | success, and the failure reason on error
287 | 
288 | =head1 AUTHOR
289 | 
290 | Tim Jenkins <tim@sendgrid.com>
291 | 
292 | =head1 COPYRIGHT
293 | 
294 | Copyright (c) 2010 SendGrid. All rights reserved.
295 | This program is free software; you can redistribute it and/or modify
296 | it under the same terms as Perl itself.
297 | 
298 | =cut
299 | 
300 | 1;
301 | 


--------------------------------------------------------------------------------
/lib/Email/SendGrid/Transport/SMTP.pm:
--------------------------------------------------------------------------------
  1 | # Copyright (c) 2010 SendGrid
  2 | 
  3 | package Email::SendGrid::Transport::SMTP;
  4 | 
  5 | use strict;
  6 | use warnings;
  7 | use vars qw($VERSION);
  8 | 
  9 | $VERSION = '1.3';
 10 | 
 11 | use Net::SMTP::TLS;
 12 | use Sys::Hostname;
 13 | use Carp;
 14 | 
 15 | sub new
 16 | {
 17 |   my $class = shift;
 18 | 
 19 |   my $self = bless { server => 'smtp.sendgrid.net',
 20 |                      timeout => 30,
 21 |                      port => 587,
 22 |                      tls => 1,
 23 |                      smtp_class => 'Net::SMTP::TLS',
 24 |                      @_ }, $class;
 25 | 
 26 |   if ( !defined($self->{domain}) )
 27 |   {
 28 |     $self->{domain} = hostname();
 29 |   }
 30 | 
 31 |   croak "TLS is required for port 587" if ( !$self->{tls} && $self->{port} == 587 );
 32 | 
 33 |   if ( defined($self->{username}) && defined($self->{api_key}) )
 34 |   {
 35 |     die "Must only specify username/password or api key, not both";
 36 |   }
 37 | 
 38 |   if ( !(defined($self->{username}) && defined($self->{password})) && !defined($self->{api_key}) )
 39 |   {
 40 |     die "Must speicfy username/password or api key";
 41 |   }
 42 | 
 43 |   if ( defined($self->{api_key}) )
 44 |   {
 45 |     $self->{username} = "apikey";
 46 |     $self->{password} = delete $self->{api_key};
 47 |   }  
 48 |   return $self;
 49 | }
 50 | 
 51 | sub deliver
 52 | {
 53 |   my $self = shift;
 54 |   my $sg = shift;
 55 | 
 56 |   my $mime = $sg->createMimeMessage();
 57 |   my $msg = $mime->stringify();
 58 |   my @rcpts = $sg->getRecipients();
 59 |   my $from = $sg->getMailFrom();
 60 | 
 61 |   croak "Must specify a from address" if ( !defined($from) );
 62 |   croak "Must specify at least one recipient" if ( scalar(@rcpts) == 0 );
 63 | 
 64 |   eval {
 65 | 
 66 |   my $smtp = $self->{smtp_class}->new($self->{server},
 67 |                                       Port => $self->{port},
 68 |                                       NoTLS => !$self->{tls},
 69 |                                       Debug => 0,
 70 |                                       Timeout => $self->{timeout},
 71 |                                       User => $self->{username},
 72 |                                       Password => $self->{password},
 73 |                                       Hello => $self->{domain},
 74 |                                       %{$self->{smtp_params}});
 75 | 
 76 |     $smtp->mail($from);
 77 |     foreach my $rcpt ( @rcpts )
 78 |     {
 79 |       $smtp->to($rcpt);
 80 |     }
 81 | 
 82 |     $smtp->data();
 83 |     $smtp->datasend($msg);
 84 |     $smtp->dataend();
 85 |     # We'll try to be nice and shutdown the correct way, but if there is an error ignore it
 86 |     eval {
 87 |       $smtp->quit();
 88 |     }
 89 |   };
 90 |   if ( $@ )
 91 |   {
 92 |     return ($@);
 93 |   }
 94 | 
 95 |   return undef;
 96 | }
 97 | 
 98 | =head1 NAME
 99 | 
100 | Email::SendGrid::Transport::SMTP - SMTP Transport class to SendGrid
101 | 
102 | =head1 SYNOPSIS
103 | 
104 |   use Email::SendGrid::Transport::SMTP;
105 |   use Email::SendGrid;
106 | 
107 |   my $sg = Email::SendGrid->new();
108 |   ...
109 |   my $trans = Email::SendGrid::Transport::SMTP->new( username => 'mysuername',
110 |                                                     password => 'mypassword' );
111 | 
112 |   my $error = $trans->deliver($sg);
113 |   die $error if ( $error );
114 | 
115 | =head1 DESCRIPTION
116 | 
117 | This is a transport module for sending messages through the SendGrid email
118 | distribution system via SMTP. After you have completed building your
119 | Email::SendGrid object, use this class to make a connection to SendGrid's
120 | SMTP servers and deliver the message.
121 | 
122 | =head1 CLASS METHODS
123 | 
124 | =head2 new[ARGS]
125 | 
126 | Creates the instance of the class. At a minimum you must specify the username
127 | and password used to connect.
128 | 
129 | Parameters are:
130 | 
131 | =over
132 | 
133 | =item username
134 | 
135 | Your SendGrid username
136 | 
137 | =item password
138 | 
139 | Your SendGrid password
140 | 
141 | =item api_key
142 | 
143 | Your SendGrid API key
144 | 
145 | =item server
146 | 
147 | The server to connect to (default is smtp.sendgrid.net)
148 | 
149 | =item port
150 | 
151 | The port to connect to (default is 587)
152 | 
153 | =item tls
154 | 
155 | If you want to use TLS encyption. Default is 1. If you do not want to use
156 | encyption, you should specify the port as 25.
157 | 
158 | =item timeout
159 | 
160 | Connection timeout, in seconds (default is 30)
161 | 
162 | =item domain
163 | 
164 | The domain to use during the HELO portion of the SMTP protocol. Default is
165 | to use the local system hostname
166 | 
167 | =back
168 | 
169 | =head2 deliver(object)
170 | 
171 | Delivers the Email::SendGrid object specified. This will return undef on
172 | success, and the failure reason on error
173 | 
174 | =head1 AUTHOR
175 | 
176 | Tim Jenkins <tim@sendgrid.com>
177 | 
178 | =head1 COPYRIGHT
179 | 
180 | Copyright (c) 2010 SendGrid. All rights reserved.
181 | This program is free software; you can redistribute it and/or modify
182 | it under the same terms as Perl itself.
183 | =cut
184 | 
185 | 1;
186 | 


--------------------------------------------------------------------------------
/lib/Email/SendGrid/Transport/Sendmail.pm:
--------------------------------------------------------------------------------
  1 | # Copyright (c) 2010 SendGrid
  2 | 
  3 | package Email::SendGrid::Transport::Sendmail;
  4 | 
  5 | use strict;
  6 | use vars qw($VERSION);
  7 | 
  8 | $VERSION = '1.3';
  9 | 
 10 | use Sys::Hostname;
 11 | use Carp;
 12 | 
 13 | sub new
 14 | {
 15 |   my $class = shift;
 16 | 
 17 |   my $self = bless { 'sendmail' => 'sendmail',
 18 |                       @_
 19 |                    }, $class;
 20 | 
 21 |   return $self;
 22 | }
 23 | 
 24 | sub deliver
 25 | {
 26 |   my $self = shift;
 27 |   my $sg = shift;
 28 | 
 29 |   my $mime = $sg->createMimeMessage();
 30 |   my $msg = $mime->stringify();
 31 | 
 32 |   my $fh;
 33 |   eval {
 34 |     $fh = $self->openSendmail($sg);
 35 |   };
 36 |   return $@ if ( $@ );
 37 | 
 38 |   print $fh $msg;
 39 | 
 40 |   close($fh);
 41 | 
 42 |   return undef;
 43 | }
 44 | 
 45 | sub openSendmail
 46 | {
 47 |   my $self = shift;
 48 |   my $sg = shift;
 49 | 
 50 |   my @rcpts = $sg->getRecipients();
 51 |   my $from = $sg->getMailFrom();
 52 | 
 53 |   open(my $fh, "|$self->{sendmail} -oi -f $from @rcpts") || die "Could not open sendmail: $!";
 54 | 
 55 |   return $fh;
 56 | }
 57 | 
 58 | 
 59 | =head1 NAME
 60 | 
 61 | Email::SendGrid::Transport::Sendmail - Transport class for SendGrid using local sendmail
 62 | 
 63 | =head1 SYNOPSIS
 64 | 
 65 |   use Email::SendGrid::Transport::Sendmail;
 66 |   use Email::SendGrid;
 67 | 
 68 |   my $sg = Email::SendGrid->new();
 69 |   ...
 70 |   my $trans = Email::SendGrid::Transport::Sendmail' );
 71 | 
 72 |   my $error = $trans->deliver($sg);
 73 |   die $error if ( $error );
 74 | 
 75 | =head1 DESCRIPTION
 76 | 
 77 | This is a transport module for sending messages through the SendGrid email
 78 | distribution system via your local sendmail application. After you have
 79 | completed building your Email::SendGrid object, use this class to queue
 80 | the message to your local system, which should be set up to relay mail
 81 | through SendGrid's servers
 82 | 
 83 | Using a local queueing mechanism like this is the preferred method to
 84 | use SendGrid, since it allows for network issues to be handled while
 85 | not complicating your application
 86 | 
 87 | Note that despite the name Sendmail, this will work with any MTA that has
 88 | a sendmail binary, such as Postfix
 89 | 
 90 | =head1 CLASS METHODS
 91 | 
 92 | =head2 new[ARGS]
 93 | 
 94 | Creates the instance of the class.
 95 | 
 96 | If for some reason sendmail is not in your path, you can specify the sendmail
 97 | as the sendmail paramter
 98 | 
 99 | =head2 deliver(object)
100 | 
101 | Delivers the Email::SendGrid object specified. This will return undef on
102 | success, and the failure reason on error
103 | 
104 | =head1 AUTHOR
105 | 
106 | Tim Jenkins <tim@sendgrid.com>
107 | 
108 | =head1 COPYRIGHT
109 | 
110 | Copyright (c) 2010 SendGrid. All rights reserved.
111 | This program is free software; you can redistribute it and/or modify
112 | it under the same terms as Perl itself.
113 | =cut
114 | 


--------------------------------------------------------------------------------
/t/lib/Email/SendGrid/Header/Test.pm:
--------------------------------------------------------------------------------
  1 | package Email::SendGrid::Header::Test;
  2 | 
  3 | use strict;
  4 | use base qw(Test::Class);
  5 | use Test::More;
  6 | use Test::Deep;
  7 | 
  8 | use Email::SendGrid::Header;
  9 | use JSON;
 10 | use Encode;
 11 | use Data::Dumper qw(Dumper);
 12 | 
 13 | sub uniqueAgs : Test(2)
 14 | {
 15 |   my $hdr = Email::SendGrid::Header->new();
 16 | 
 17 |   $hdr->addUniqueIdentifier( foo => 'bar' );
 18 | 
 19 |   ok(scalar(keys(%{$hdr->{data}->{unique_args}})) == 1 &&
 20 |      $hdr->{data}->{unique_args}->{foo} eq 'bar', "set unique args");
 21 | 
 22 |   $hdr->addUniqueIdentifier( { bar => 'foo' } );
 23 |   ok(scalar(keys(%{$hdr->{data}->{unique_args}})) == 2 &&
 24 |      $hdr->{data}->{unique_args}->{bar} eq 'foo', "set unique args with hash");
 25 | 
 26 | }
 27 | 
 28 | sub category : Test
 29 | {
 30 |   my $category = "foo";
 31 | 
 32 |   my $hdr = Email::SendGrid::Header->new();
 33 | 
 34 |   $hdr->setCategory($category);
 35 | 
 36 |   is($hdr->{data}->{category}, $category, "set category");
 37 | }
 38 | 
 39 | sub filterSettings : Test(7)
 40 | {
 41 |   my $hdr = Email::SendGrid::Header->new();
 42 | 
 43 |   $hdr->addFilterSetting('clicktrack', 'enable', 1);
 44 | 
 45 |   is($hdr->{data}->{filters}->{clicktrack}->{settings}->{enable}, 1, "create filter setting");
 46 | 
 47 |   $hdr->addFilterSetting('clicktrack', 'enable_text', 1);
 48 | 
 49 |   is($hdr->{data}->{filters}->{clicktrack}->{settings}->{enable_text}, 1, "add filter setting");
 50 | 
 51 |   # Deep filter settings
 52 |   $hdr->addFilterSetting('myf', 'a', 'b', 'c', 1);
 53 |   $hdr->addFilterSetting('myf', 'a', 'b', 'd', 2);
 54 | 
 55 |   is($hdr->{data}->{filters}->{myf}->{settings}->{a}->{b}->{c}, 1, "deep filter setting");
 56 |   is($hdr->{data}->{filters}->{myf}->{settings}->{a}->{b}->{d}, 2, "deep filter setting addition");
 57 | 
 58 |   # Try to add a setting for something deep
 59 |   eval {
 60 |     $hdr->addFilterSetting('myf', 'a', 2);
 61 |   };
 62 |   ok($@ =~ 'overwrite hash', "attempt to overwrite setting hash");
 63 | 
 64 |   # Try to add a hash over a setting
 65 |   eval {
 66 |     $hdr->addFilterSetting('clicktrack', 'enable', 'a', 1);
 67 |   };
 68 |   ok($@ =~ 'overwrite setting', "attempt to overwrite hash with setting");
 69 | 
 70 | }
 71 | 
 72 | sub mailmerge : Test(2)
 73 | {
 74 |   my $to = 'tim@sendgrid.com';
 75 |   my $tag = 'name';
 76 |   my $val = 'Tim Jenkins';
 77 | 
 78 |   my $hdr = Email::SendGrid::Header->new();
 79 | 
 80 |   $hdr->addTo($to);
 81 | 
 82 |   is($hdr->{data}->{to}->[0], $to, 'set to address');
 83 | 
 84 |   $hdr->addSubVal($tag, $val);
 85 | 
 86 |   is($hdr->{data}->{'sub'}->{$tag}->[0], $val, "set substitution value");
 87 | }
 88 | 
 89 | sub enabledisable : Test(2)
 90 | {
 91 |   my $hdr = Email::SendGrid::Header->new();
 92 | 
 93 |   $hdr->enable('clicktrack');
 94 | 
 95 |   is($hdr->{data}->{filters}->{clicktrack}->{settings}->{enable}, 1, "enable filter");
 96 | 
 97 |   $hdr->disable('clicktrack');
 98 | 
 99 |   is($hdr->{data}->{filters}->{clicktrack}->{settings}->{enable}, 0, "disable filter");
100 | }
101 | 
102 | sub json : Test(2)
103 | {
104 |   my $filt = { filters =>
105 |               { 'a' => { 'settings' => {'a' => 1}},
106 |                'b' => { 'settings' => {'b' => 2, 'a' => 'foobarrrrr'}},
107 |                'c' => { 'settings' => {'str' => 'thisisaverylongstringthatdoesnothaveanyspacesinit'}},
108 |                'u' => "Some unicode \x{f441}",
109 |               }
110 |   };
111 | 
112 |   my $filtJson = to_json($filt);
113 | 
114 |   my $hdr = Email::SendGrid::Header->new( data => $filt);
115 | 
116 |   my $length = 30;
117 | 
118 |   my $json = $hdr->asJSON( fold => $length );
119 | 
120 |   # Convert back to an object to compare
121 |   my $jsonCopy = $json;
122 |   $jsonCopy =~ s/\n//g;
123 |   my $obj = from_json($jsonCopy);
124 |   cmp_deeply($obj, $filt, "decodes to same object");
125 |   is($json, encode('utf8', $json), "json has no special characters");
126 | 
127 |   my @lines = split('\n', $json);
128 | 
129 |   my $properFold = 1;
130 | 
131 |   foreach my $line ( @lines )
132 |   {
133 |     $properFold = 0 if ( !(length($line) < $length+3 ||
134 |                            $line =~ $filt->{filters}->{c}->{settings}->{str}) );
135 |   }
136 | 
137 |   is($properFold, 1, "proper folding");
138 | }
139 | 
140 | sub asmGroupId : Test
141 | {
142 |   my $asmGroupId = 123;
143 | 
144 |   my $hdr = Email::SendGrid::Header->new();
145 | 
146 |   $hdr->setASMGroupID($asmGroupId);
147 | 
148 |   is($hdr->{data}->{asm_group_id}, $asmGroupId, "set ASM Group ID");
149 | }
150 | 
151 | 
152 | 
153 | 1;
154 | 
155 | 


--------------------------------------------------------------------------------
/t/lib/Email/SendGrid/Test.pm:
--------------------------------------------------------------------------------
  1 | package Email::SendGrid::Test;
  2 | 
  3 | use strict;
  4 | use base qw(Test::Class);
  5 | use Test::More;
  6 | 
  7 | use Email::SendGrid;
  8 | use Encode;
  9 | 
 10 | use Data::Dumper qw(Dumper);
 11 | 
 12 | sub addresses : Test(12)
 13 | {
 14 |   my $fromAddr = 'tim@sendgrid.net';
 15 |   my $toAddr = 'tim@sendgrid.com';
 16 |   my $from = "Tim Jenkisn <$fromAddr>";
 17 |   my $to =  "Tim Jenkins <$toAddr>";
 18 |   my $text = 'Some text';
 19 |   my $html = '<html><body>Some html</body></html>';
 20 |   my $encoding = 'base64';
 21 |   my $charset = 'utf-8';
 22 | 
 23 |   my $sg = Email::SendGrid->new( from => $from,
 24 |                                 to => $to,
 25 |                                 encoding => $encoding,
 26 |                                 charset => $charset,
 27 |                                 text => $text,
 28 |                                 html => $html,
 29 |                               );
 30 | 
 31 |   my $mime = $sg->createMimeMessage();
 32 | 
 33 |   my $mailFrom = $sg->getMailFrom();
 34 |   is($mailFrom, $fromAddr, 'mail from');
 35 | 
 36 |   # Check to address
 37 |   my @rcpts = $sg->getRecipients();
 38 |   ok(scalar(@rcpts) == 1 && $rcpts[0] eq $toAddr, "to address from string");
 39 | 
 40 |   $sg = Email::SendGrid->new( to => [ $to, $from ] );
 41 | 
 42 |   @rcpts = $sg->getRecipients();
 43 |   ok(scalar(@rcpts) == 2 && $rcpts[0] eq $toAddr && $rcpts[1] eq $fromAddr, "to address as array ref");
 44 | 
 45 |   # Check cc address
 46 |   $sg = Email::SendGrid->new( cc => "$to, $from" );
 47 | 
 48 |   @rcpts = $sg->getRecipients();
 49 |   ok(scalar(@rcpts) == 2 && $rcpts[0] eq $toAddr && $rcpts[1] eq $fromAddr, "cc address as string");
 50 | 
 51 | 
 52 |   $sg = Email::SendGrid->new( cc => [ $to, $from ] );
 53 | 
 54 |   @rcpts = $sg->getRecipients();
 55 |   ok(scalar(@rcpts) == 2 && $rcpts[0] eq $toAddr && $rcpts[1] eq $fromAddr, "cc address as array ref");
 56 | 
 57 |   # Check bcc address
 58 |   $sg = Email::SendGrid->new( bcc => "$to, $from" );
 59 | 
 60 |   @rcpts = $sg->getRecipients();
 61 |   ok(scalar(@rcpts) == 2 && $rcpts[0] eq $toAddr && $rcpts[1] eq $fromAddr, "bcc address as string");
 62 | 
 63 | 
 64 |   $sg = Email::SendGrid->new( bcc => [ $to, $from ] );
 65 | 
 66 |   @rcpts = $sg->getRecipients();
 67 |   ok(scalar(@rcpts) == 2 && $rcpts[0] eq $toAddr && $rcpts[1] eq $fromAddr, "bcc address as array ref");
 68 | 
 69 |   # Check with all addresses in place
 70 |   my $toa = [ $to, $from ];
 71 |   my $toad = [ $toAddr, $fromAddr ];
 72 |   my $cca = [ $from, $to ];
 73 |   my $ccad = [ $fromAddr, $toAddr ];
 74 |   my $bcca = [ $to, $from ];
 75 |   my $bccad = [ $toAddr, $fromAddr ];
 76 | 
 77 |   my @realrcpts = @$toad;
 78 |   push(@realrcpts, @$ccad, @$bccad);
 79 | 
 80 |   $sg = Email::SendGrid->new( to => $toa, cc => $cca, bcc => $bcca,
 81 |                              from => $from,
 82 |                              text => $text,
 83 |                              html => $html,
 84 |    );
 85 | 
 86 |   @rcpts = $sg->getRecipients();
 87 |   my $match = 0;
 88 | 
 89 |   foreach my $i (0..$#rcpts)
 90 |   {
 91 |     $match++ if ( $rcpts[$i] eq $realrcpts[$i] );
 92 |   }
 93 | 
 94 |   is($match, scalar(@realrcpts), "to, cc, and bcc address merges");
 95 | 
 96 |   # Now check that the mime entity is created properly from this
 97 |   $mime = $sg->createMimeMessage();
 98 | 
 99 |   my $mimeFrom = $mime->head->get('from');
100 |   my $mimeTo = $mime->head->get('to');
101 |   my $mimeCc = $mime->head->get('cc');
102 |   my $mimeBcc = $mime->head->get('bcc');
103 | 
104 |   chomp($mimeFrom);
105 |   chomp($mimeTo);
106 |   chomp($mimeCc);
107 | 
108 |   is($mimeFrom, $from, 'mime from field');
109 |   is($mimeTo, "$to, $from", 'mime to field');
110 |   is($mimeCc, "$from, $to", 'mime cc field');
111 |   is($mimeBcc, undef, 'mime bcc field undefined');
112 | }
113 | 
114 | sub multipart : Test(4)
115 | {
116 |   my $fromAddr = 'tim@sendgrid.net';
117 |   my $toAddr = 'tim@sendgrid.com';
118 |   my $from = "Tim Jenkisn <$fromAddr>";
119 |   my $to =  "Tim Jenkins <$toAddr>";
120 |   my $text = 'Some text';
121 |   my $html = '<html><body>Some html</body></html>';
122 |   my $encoding = 'base64';
123 |   my $charset = 'utf-8';
124 | 
125 |   my $sg = Email::SendGrid->new( from => $from,
126 |                                 to => $to,
127 |                                 encoding => $encoding,
128 |                                 charset => $charset,
129 |                                 text => $text,
130 |                                 html => $html,
131 |                               );
132 | 
133 |   my $mime = $sg->createMimeMessage();
134 |   my @parts = $mime->parts();
135 | 
136 |   ok($parts[0]->bodyhandle->as_string() eq $text && $parts[0]->mime_type eq 'text/plain', 'multipart text portion correct content');
137 |   ok($parts[1]->bodyhandle->as_string() eq $html && $parts[1]->mime_type eq 'text/html', 'multipart html portion correct content');
138 |   ok($parts[0]->head->mime_attr("content-type.charset") eq $charset &&
139 |      $parts[1]->head->mime_attr("content-type.charset") eq $charset, 'multipart correct charset');
140 |   ok($parts[0]->head->mime_encoding() eq $encoding &&
141 |      $parts[1]->head->mime_encoding() eq $encoding, 'multipart correct encoding');
142 | }
143 | 
144 | sub textonly : Test(3)
145 | {
146 |   my $fromAddr = 'tim@sendgrid.net';
147 |   my $toAddr = 'tim@sendgrid.com';
148 |   my $from = "Tim Jenkisn <$fromAddr>";
149 |   my $to =  "Tim Jenkins <$toAddr>";
150 |   my $text = 'Some text';
151 |   my $html = '<html><body>Some html</body></html>';
152 |   my $encoding = 'base64';
153 |   my $charset = 'utf-8';
154 | 
155 |   my $sg = Email::SendGrid->new( from => $from,
156 |                                 to => $to,
157 |                                 encoding => $encoding,
158 |                                 charset => $charset,
159 |                                 text => $text,
160 |                               );
161 | 
162 |   my $mime = $sg->createMimeMessage();
163 |   my @parts = $mime->parts();
164 | 
165 |   ok($mime->bodyhandle->as_string() eq $text && $mime->mime_type eq 'text/plain', 'text only correct content');
166 |   is($mime->head->mime_attr("content-type.charset"), $charset, 'text only correct charset');
167 |   is($mime->head->mime_encoding(), $encoding, 'text only correct encoding');
168 | }
169 | 
170 | sub htmlonly : Test(3)
171 | {
172 |   my $fromAddr = 'tim@sendgrid.net';
173 |   my $toAddr = 'tim@sendgrid.com';
174 |   my $from = "Tim Jenkisn <$fromAddr>";
175 |   my $to =  "Tim Jenkins <$toAddr>";
176 |   my $text = 'Some text';
177 |   my $html = '<html><body>Some html</body></html>';
178 |   my $encoding = 'base64';
179 |   my $charset = 'utf-8';
180 | 
181 |   my $sg = Email::SendGrid->new( from => $from,
182 |                                 to => $to,
183 |                                 encoding => $encoding,
184 |                                 charset => $charset,
185 |                                 html => $html,
186 |                               );
187 | 
188 |   my $mime = $sg->createMimeMessage();
189 |   my @parts = $mime->parts();
190 | 
191 |   ok($mime->bodyhandle->as_string() eq $html && $mime->mime_type eq 'text/html', 'html only correct content');
192 |   is($mime->head->mime_attr("content-type.charset"), $charset, 'html only correct charset');
193 |   is($mime->head->mime_encoding(), $encoding, 'html only correct encoding');
194 | }
195 | 
196 | sub headers : Test(4)
197 | {
198 |   my $subject = "subject test";
199 |   my $date = 'now';
200 |   my $msgId = 'msg-id';
201 |   my $text = "some text";
202 | 
203 |   my $sg = Email::SendGrid->new( subject => $subject,
204 |                                 date => $date,
205 |                                 'message-id' => $msgId,
206 |                                 text => $text );
207 | 
208 |   my $mime = $sg->createMimeMessage();
209 |   my $s = $mime->head->get('subject');
210 |   chomp($s);
211 |   is($s, $subject, "subject as parameter");
212 | 
213 |   my $d = $mime->head->get('date');
214 |   chomp($d);
215 |   is($d, $date, 'date as parameter');
216 | 
217 |   my $m = $mime->head->get('message-id');
218 |   chomp($m);
219 |   is($m, $msgId, 'message id as paramter');
220 | 
221 |   # Test subject set method
222 |   $sg = Email::SendGrid->new( text => $text );
223 |   $sg->set('subject', $subject);
224 | 
225 |   $mime = $sg->createMimeMessage();
226 |   $s = $mime->head->get('subject');
227 |   chomp($s);
228 |   is($s, $subject, "subject set with function");
229 | }
230 | 
231 | sub unicode : Test(7)
232 | {
233 |   my $fromAddr = 'tim@sendgrid.net';
234 |   my $toAddr = 'tim@sendgrid.com';
235 |   my $from = "Tim\x{311} Jenkisn <$fromAddr>";
236 |   my $to =  "Tim\x{312} Jenkins <$toAddr>";
237 |   my $text = "Some unicode\x{587} text";
238 |   my $html = "<html><body>Some unicode \x{465} html</body></html>";
239 |   my $encoding = 'base64';
240 |   my $charset = 'utf-8';
241 |   my $subject = "subject \x{f441}";
242 |   my $reply = "some reply \x{411}";
243 | 
244 |   my $sg = Email::SendGrid->new( from => $from,
245 |                                 to => $to,
246 |                                 subject => $subject,
247 |                                 encoding => $encoding,
248 |                                 charset => $charset,
249 |                                 'reply-to' => $reply,
250 |                                 text => $text,
251 |                                 html => $html,
252 |                               );
253 | 
254 |   my $mime = $sg->createMimeMessage();
255 |   my @parts = $mime->parts();
256 | 
257 |   my $mText = $parts[0]->bodyhandle->as_string();
258 |   my $mHtml = $parts[1]->bodyhandle->as_string();
259 | 
260 |   ok( $mText ne $text && decode($charset, $mText) eq $text, 'unicode text portion correctly enocded');
261 |   ok( $mHtml ne $html && decode($charset, $mHtml) eq $html, 'unicode html portion correctly encoded');
262 | 
263 |   # Test unicode headers
264 |   my $s = $mime->head->get('subject');
265 |   chomp($s);
266 | 
267 |   my $sd = decode('MIME-Header', $s);
268 | 
269 |   ok($s =~ /\?Q\?/ && $sd eq $subject, "unicode headers, qp encoded");
270 | 
271 |   # Base64 encoding
272 |   my $subj = "subject2 \x{f441}\x{443}\x{3423}\x{4322}\x{4333}\x{111}\x{465}";
273 |   $sg->set('subject', $subj);
274 | 
275 |   $mime = $sg->createMimeMessage();
276 | 
277 |   $s = $mime->head->get('subject');
278 |   chomp($s);
279 | 
280 |   $sd = decode('MIME-Header', $s);
281 | 
282 |   ok($s =~ /\?B\?/ && $sd eq $subj, "unicode headers, base64 encoded");
283 | 
284 |   # Check the other headers to be sure of proper encoding
285 |   my $h = 'to';
286 |   my $mh = $mime->head->get($h);
287 |   chomp($mh);
288 |   ok($mh =~ /\?Q\?/, "unicode $h encoded");
289 | 
290 |   $h = 'from';
291 |   $mh = $mime->head->get($h);
292 |   chomp($mh);
293 |   ok($mh =~ /\?Q\?/, "unicode $h encoded");
294 | 
295 |   $h = 'reply-to';
296 |   $mh = $mime->head->get($h);
297 |   chomp($mh);
298 |   ok($mh =~ /\?Q\?/, "unicode $h encoded");
299 | 
300 | }
301 | 
302 | 
303 | sub attachments : Test(no_plan)
304 | {
305 |   my $fromAddr = 'tim@sendgrid.net';
306 |   my $toAddr = 'tim@sendgrid.com';
307 |   my $from = "Tim Jenkisn <$fromAddr>";
308 |   my $to =  "Tim Jenkins <$toAddr>";
309 |   my $text = 'Some text';
310 |   my $html = '<html><body>Some html</body></html>';
311 |   my $encoding = 'quoted-printable';
312 |   my $charset = 'utf-8';
313 | 
314 |   my $sg = Email::SendGrid->new( from => $from,
315 |                                 to => $to,
316 |                                 encoding => $encoding,
317 |                                 charset => $charset,
318 |                                 html => $html,
319 |                               );
320 | 
321 |   my $attachEncoding = 'binary';
322 |   my $attachType = 'application/pdf';
323 | 
324 |   $sg->addAttachment( $text, encoding => $attachEncoding, type => $attachType );
325 | 
326 |   my $mime = $sg->createMimeMessage();
327 |   my @parts = $mime->parts();
328 |   is(scalar(@parts), 2, "Attachment");
329 | 
330 |   is($parts[1]->bodyhandle->as_string(), $text, "attachment correct content");
331 |   is($parts[1]->head->mime_type(), $attachType, "attachment correct type");
332 |   is($parts[1]->head->mime_encoding(), $attachEncoding, "attachment correct encoding");
333 | }
334 | 
335 | sub filterShortcuts : Test(no_plan)
336 | {
337 |   my $sg = Email::SendGrid->new();
338 | 
339 |   # click tracking
340 |   $sg->enableClickTracking( text => 1 );
341 |   is($sg->header->{data}->{filters}->{clicktrack}->{settings}->{enable}, 1, 'enable click tracking');
342 |   is($sg->header->{data}->{filters}->{clicktrack}->{settings}->{enable_text}, 1, 'enable text click tracking');
343 | 
344 |   $sg->disableClickTracking();
345 |   is($sg->header->{data}->{filters}->{clicktrack}->{settings}->{enable}, 0, 'disable click tracking');
346 | 
347 |   # Open tracking
348 |   $sg->enableOpenTracking();
349 |   is($sg->header->{data}->{filters}->{opentrack}->{settings}->{enable}, 1, 'enable open tracking');
350 | 
351 |   $sg->disableOpenTracking();
352 |   is($sg->header->{data}->{filters}->{opentrack}->{settings}->{enable}, 0, 'disable open tracking');
353 | 
354 |   # Spam check
355 |   $sg->enableSpamCheck( score => 4, url => 'foo' );
356 |   is($sg->header->{data}->{filters}->{spamcheck}->{settings}->{enable}, 1, 'enable spam check');
357 |   is($sg->header->{data}->{filters}->{spamcheck}->{settings}->{maxscore}, 4, 'set spam check score');
358 |   is($sg->header->{data}->{filters}->{spamcheck}->{settings}->{url}, 'foo', 'set spam check url');
359 | 
360 |   $sg->disableSpamCheck();
361 |   is($sg->header->{data}->{filters}->{spamcheck}->{settings}->{enable}, 0, 'disable spam check');
362 | 
363 |   # Gravatar
364 |   $sg->enableGravatar();
365 |   is($sg->header->{data}->{filters}->{gravatar}->{settings}->{enable}, 1, 'enable gravatar');
366 | 
367 |   $sg->disableGravatar();
368 |   is($sg->header->{data}->{filters}->{gravatar}->{settings}->{enable}, 0, 'disable gravatar');
369 | 
370 |   # Subscription tracking
371 |   $sg->enableUnsubscribe( text => '<% %>',
372 |                           html => '<% here %>',
373 |                           replace => 'foo',
374 |                           );
375 | 
376 |   is($sg->header->{data}->{filters}->{subscriptiontrack}->{settings}->{enable}, 1,
377 |       'enable subscription tracking');
378 |   is($sg->header->{data}->{filters}->{subscriptiontrack}->{settings}->{'text/plain'}, '<% %>',
379 |       'subscription text replacement');
380 |   is($sg->header->{data}->{filters}->{subscriptiontrack}->{settings}->{'text/html'}, '<% here %>',
381 |       'subscription html replacement');
382 |   is($sg->header->{data}->{filters}->{subscriptiontrack}->{settings}->{replace}, 'foo',
383 |       'subscription tag replacement');
384 | 
385 |   eval {
386 |     $sg->enableUnsubscribe( text => 'unsubscribe' );
387 |   };
388 |   ok ( $@ =~ /tag in text/, "subscription text checking" );
389 | 
390 |   eval {
391 |     $sg->enableUnsubscribe( html => '<% %>' );
392 |   };
393 |   ok ( $@ =~ /tag in html/, 'subscription html checking' );
394 | 
395 |   $sg->disableUnsubscribe();
396 |   is($sg->header->{data}->{filters}->{subscriptiontrack}->{settings}->{enable}, 0,
397 |       'disable subscription tracking');
398 | 
399 |   # Footer
400 |   $sg->enableFooter( text => 'text', html => 'html' );
401 |   is($sg->header->{data}->{filters}->{footer}->{settings}->{enable}, 1, 'enable footer');
402 |   is($sg->header->{data}->{filters}->{footer}->{settings}->{'text/plain'}, "text", 'footer text setting');
403 |   is($sg->header->{data}->{filters}->{footer}->{settings}->{'text/html'}, "html", 'footer html setting');
404 | 
405 |   $sg->disableFooter();
406 |   is($sg->header->{data}->{filters}->{footer}->{settings}->{enable}, 0, 'disable footer');
407 | 
408 |   # Google Analytics
409 |   $sg->enableGoogleAnalytics( source => 'source',
410 |                               medium => 'medium',
411 |                               term => 'term',
412 |                               content => 'content',
413 |                               campaign => 'campaign' );
414 | 
415 |   is($sg->header->{data}->{filters}->{ganalytics}->{settings}->{enable}, 1, 'enable ganalytics');
416 |   foreach my $field ( qw(source medium term content campaign) )
417 |   {
418 |     is($sg->header->{data}->{filters}->{ganalytics}->{settings}->{"utm_$field"}, $field,
419 |       "ganalytics $field");
420 |   }
421 | 
422 |   $sg->disableGoogleAnalytics();
423 |   is($sg->header->{data}->{filters}->{ganalytics}->{settings}->{enable}, 0, 'disable ganalytics');
424 | 
425 |   # Domain Keys
426 |   $sg->enableDomainKeys( domain => 'domain', sender => 1 );
427 |   is($sg->header->{data}->{filters}->{domainkeys}->{settings}->{enable}, 1, 'enable domainkeys');
428 |   is($sg->header->{data}->{filters}->{domainkeys}->{settings}->{domain}, 'domain', 'domainkeys domain');
429 |   is($sg->header->{data}->{filters}->{domainkeys}->{settings}->{sender}, 1, 'domainkeys sender');
430 | 
431 |   $sg->disableDomainKeys();
432 |   is($sg->header->{data}->{filters}->{domainkeys}->{settings}->{enable}, 0, 'disable domainkeys');
433 | 
434 |   # Template
435 |   $sg = Email::SendGrid->new();
436 |   $sg->enableTemplate( html => 'html<% %>' );
437 |   is($sg->header->{data}->{filters}->{template}->{settings}->{enable}, 1, 'enable template');
438 |   is($sg->header->{data}->{filters}->{template}->{settings}->{'text/html'}, 'html<% %>', 'template html');
439 | 
440 |   $sg->disableTemplate();
441 |   is($sg->header->{data}->{filters}->{template}->{settings}->{enable}, 0, 'disable template');
442 | 
443 |   # Template argument validation
444 |   eval { $sg->enableTemplate() };
445 |   ok($@ =~ /Missing html/, 'template html tag required');
446 | 
447 |   eval { $sg->enableTemplate( html => 'foo' ) };
448 |   ok($@ =~ /Missing body/, 'template html tag validation');
449 | 
450 |   # Twitter
451 |   $sg = Email::SendGrid->new();
452 |   $sg->enableTwitter( username => 'user', password => 'pass' );
453 |   is($sg->header->{data}->{filters}->{twitter}->{settings}->{enable}, 1, 'enable twitter');
454 |   is($sg->header->{data}->{filters}->{twitter}->{settings}->{username}, 'user', 'twitter username');
455 |   is($sg->header->{data}->{filters}->{twitter}->{settings}->{password}, 'pass', 'twitter password');
456 | 
457 |   # Twitter argument validation
458 |   eval { $sg->enableTwitter( password => 'foo' ) };
459 |   ok($@ =~ /username/, 'twitter username required');
460 | 
461 |   eval { $sg->enableTwitter( username => 'foo' ) };
462 |   ok($@ =~ /password/, 'twitter password required');
463 | 
464 |   $sg->disableTwitter();
465 |   is($sg->header->{data}->{filters}->{twitter}->{settings}->{enable}, 0, 'disable twitter');
466 | 
467 |   # BCC
468 |   $sg = Email::SendGrid->new();
469 |   $sg->enableBcc( email => 'email' );
470 |   is($sg->header->{data}->{filters}->{bcc}->{settings}->{enable}, 1, 'enable bcc');
471 |   is($sg->header->{data}->{filters}->{bcc}->{settings}->{email}, 'email', 'bcc email');
472 | 
473 |   # BCC argument validation
474 |   eval { $sg->enableBcc() };
475 |   ok($@ =~ /email/, 'bcc email validation');
476 | 
477 |   # Bypass list management
478 |   $sg = Email::SendGrid->new();
479 |   $sg->enableBypassListManagement();
480 |   is($sg->header->{data}->{filters}->{bypass_list_management}->{settings}->{enable}, 1,
481 |     'enable bypass list management');
482 | }
483 | 
484 | 
485 | 1;
486 | 


--------------------------------------------------------------------------------
/t/lib/Email/SendGrid/Transport/REST/Test.pm:
--------------------------------------------------------------------------------
  1 | package Email::SendGrid::Transport::REST::Test;
  2 | 
  3 | use strict;
  4 | use base qw(Test::Class);
  5 | use Test::More;
  6 | use Test::Deep;
  7 | 
  8 | use MIME::Entity;
  9 | use Email::SendGrid;
 10 | use Email::SendGrid::Transport::REST;
 11 | use Test::MockObject::Extends;
 12 | use Test::MockModule;
 13 | use URI::Escape;
 14 | use Encode;
 15 | use JSON;
 16 | use Data::Dumper qw(Dumper);
 17 | 
 18 | sub getTransport
 19 | {
 20 |   my %args = @_;
 21 | 
 22 |   my $obj = Email::SendGrid::Transport::REST->new( username => 'u',
 23 |                                                   password => 'p' );
 24 | 
 25 |   my $mock = Test::MockObject::Extends->new($obj);
 26 | 
 27 |   foreach my $arg ( keys(%args) )
 28 |   {
 29 |     $mock->mock($arg, $args{$arg});
 30 |   }
 31 | 
 32 |   return $mock;
 33 | }
 34 | 
 35 | my $fromAddr = 'tim@sendgrid.net';
 36 | my $fromName = 'Tim Jenkins';
 37 | my $toAddr = 'tim@sendgrid.com';
 38 | my $toName = 'Tim Jenkins';
 39 | my $from = "$fromName <$fromAddr>";
 40 | my $to =  "$toName <$toAddr>";
 41 | my $text = 'Some text';
 42 | my $html = '<html><body>Some html</body></html>';
 43 | my $subject = 'subject';
 44 | my $encoding = 'base64';
 45 | my $charset = 'utf-8';
 46 | my $date = '2010 08 18';
 47 | my $messageId = "1234";
 48 | 
 49 | sub getSGObject
 50 | {
 51 |   my %args = @_;
 52 | 
 53 |   my $extra;
 54 | 
 55 |   $extra = $args{unicode} if ( $args{unicode} );
 56 | 
 57 |   my $sg = Email::SendGrid->new( from => "$extra$from",
 58 |                                 to => "$extra$to",
 59 |                                 subject => "$extra$subject",
 60 |                                 encoding => $encoding,
 61 |                                 charset => $charset,
 62 |                                 text => "$extra$text",
 63 |                                 html => "$extra$html",
 64 |                                 'reply-to' => "$extra$to",
 65 |                                 "message-id" => $messageId,
 66 |                                 date => $date,
 67 |                               );
 68 | 
 69 |   return $sg;
 70 | }
 71 | 
 72 | sub create : Test(no_plan)
 73 | {
 74 |   eval {
 75 |     my $trans = Email::SendGrid::Transport::REST->new( username => 'u' );
 76 |   };
 77 |   ok($@ =~ /Must speicfy username\/password or api key at/, "only providing username generated error");
 78 | 
 79 |   eval {
 80 |     my $trans = Email::SendGrid::Transport::REST->new( password => 'u' );
 81 |   };
 82 |   ok($@ =~ /Must speicfy username\/password or api key at/, "only providing password generated error");
 83 | 
 84 |   eval {
 85 |     my $trans = Email::SendGrid::Transport::REST->new( username => 'u', api_key => 'k' );
 86 |   };
 87 |   ok($@ =~ /Must only specify username\/password or api key, not both at/, "providing username and api key generated error");
 88 | 
 89 | }
 90 | 
 91 | sub deliver : Test(no_plan)
 92 | {
 93 |   my $deliv;
 94 |   my $sg;
 95 |   my $attachData = "my attachment";
 96 |   $deliv = getTransport( 'send' => sub {
 97 |     my $self = shift;
 98 |     my $query = shift;
 99 | 
100 |     my ($url, $str) = $query =~ /^([^\?]+)\?(.*)$/;
101 | 
102 |     my @params = split('&', $str);
103 |     my $p = {};
104 | 
105 |     foreach my $param (@params)
106 |     {
107 |       my ($key, $value) = split('=', $param);
108 |       $p->{$key} = uri_unescape($value);
109 |     }
110 | 
111 |     is($p->{api_user}, $deliv->{username}, "username set");
112 |     is($p->{api_key}, $deliv->{password}, "password set");
113 |     is($p->{subject}, $sg->get('subject'), "subject set");
114 |     is($p->{fromname}, $fromName, "from name set");
115 |     is($p->{from}, $fromAddr, "from addr set");
116 |     is($p->{'x-smtpapi'}, $sg->header->asJSON(), "smtp api header set");
117 |     is($p->{html}, $sg->get('html'), "html set");
118 |     is($p->{text}, $sg->get('text'), "text set");
119 |     is($p->{'to[]'}, $toAddr, "to addr set");
120 |     is($p->{'toname[]'}, $toName, "to name set");
121 | 
122 |     my $hdrs = from_json($p->{headers});
123 |     cmp_deeply($hdrs, { "message-id" => $messageId }, "headers are included");
124 |     is($p->{"files[attachment1]"}, $attachData, "attachment included");
125 |     return { "message" => "success" };
126 |   });
127 | 
128 |   $sg = getSGObject();
129 |   $sg->addAttachment($attachData);
130 |   $sg->enableClickTracking();
131 | 
132 |   my $res = $deliv->deliver($sg);
133 | 
134 |   is($res, undef, 'normal delivery');
135 | }
136 | 
137 | sub unicode : Test(8)
138 | {
139 |   my $deliv;
140 |   my $sg;
141 | 
142 |   my $u = "\x{587}";
143 | 
144 |   $deliv = getTransport( 'send' => sub {
145 |     my $self = shift;
146 |     my $query = shift;
147 | 
148 |     my ($url, $str) = $query =~ /^([^\?]+)\?(.*)$/;
149 | 
150 |     my @params = split('&', $str);
151 |     my $p = {};
152 | 
153 |     foreach my $param (@params)
154 |     {
155 |       my ($key, $value) = split('=', $param);
156 |       $p->{$key} = uri_unescape($value);
157 |     }
158 | 
159 |     is($p->{subject}, $sg->get('subject', encode => 1), "unicode subject set");
160 |     is($p->{fromname}, encode('utf-8', "$u$fromName"), "unicode from name set");
161 |     is($p->{from}, $fromAddr, "unicode from addr set");
162 |     is($p->{'x-smtpapi'}, encode('utf-8', $sg->header->asJSON()), "unicode smtp api header set");
163 |     is($p->{html}, $sg->get('html', encode => 1), "unicode html set");
164 |     is($p->{text}, $sg->get('text', encode => 1), "unicode text set");
165 |     is($p->{'to[]'}, $toAddr, "unicode to addr set");
166 |     is($p->{'toname[]'}, encode('utf-8', "$u$toName"), "unicode to name set");
167 | 
168 |     return { "message" => "success" };
169 |   });
170 | 
171 |   $sg = getSGObject(unicode => $u);
172 | 
173 |   $sg->header->setCategory("$u");
174 | 
175 |   my $res = $deliv->deliver($sg);
176 | }
177 | 
178 | sub deliveryError : Test
179 | {
180 |   my $deliv = getTransport( 'send' => sub {
181 |     return { message => "error",
182 |              errors => [ "errormsg" ] };
183 |   });
184 | 
185 |   my $sg = getSGObject();
186 | 
187 |   $sg->enableClickTracking();
188 | 
189 |   my $res = $deliv->deliver($sg);
190 | 
191 |   is($res, "errormsg", 'error handling');
192 | }
193 | 
194 | sub send_up : Test(no_plan)
195 | {
196 |   my $deliv = Test::MockObject::Extends->new(Email::SendGrid::Transport::REST->new(username => 'u', password => 'p'));
197 |   my $content = { value => 1 };
198 |   my $response = HTTP::Response->new('200', "ok", [], to_json($content));
199 |   my $mm = Test::MockModule->new('LWP::UserAgent');
200 |   my $obj;
201 |   $mm->mock('new' => sub {
202 |     $obj = Test::MockObject->new();
203 |     $obj->set_always('default_header' => 1);
204 |     $obj->mock('get' => sub { return $response } );
205 |     return $obj;
206 |     });
207 | 
208 |   my $query = "query";
209 |   my $resp = $deliv->send($query);
210 | 
211 |   cmp_deeply($resp, $content, "sent");
212 |   my ($func, $args) = $obj->next_call();
213 |   is($func, 'get', "made call to get");
214 |   shift(@$args);
215 |   cmp_deeply($args, [$query], " with proper args");
216 |   
217 |   ($func, $args) = $obj->next_call();
218 |   is($func, undef, "all lwp calls accounted for");
219 | 
220 |   $response = HTTP::Response->new('403', 'bad error');
221 |   $resp = $deliv->send($query);
222 |   cmp_deeply($resp, {errors => ['403 bad error']}, "error returned" );
223 | 
224 |   ($func, $args) = $obj->next_call();
225 |   is($func, 'get', "made call to get");
226 |   shift(@$args);
227 |   cmp_deeply($args, [$query], " with proper args");
228 |   
229 |   ($func, $args) = $obj->next_call();
230 |   is($func, undef, "all lwp calls accounted for");
231 | 
232 | }
233 | 
234 | sub send_apikey : Test(no_plan)
235 | {
236 |   my $deliv = Test::MockObject::Extends->new(Email::SendGrid::Transport::REST->new(api_key => 'k'));
237 |   my $content = { value => 1 };
238 |   my $response = HTTP::Response->new('200', "ok", [], to_json($content));
239 |   my $mm = Test::MockModule->new('LWP::UserAgent');
240 |   my $obj;
241 |   $mm->mock('new' => sub {
242 |     $obj = Test::MockObject->new();
243 |     $obj->set_always('default_header' => 1);
244 |     $obj->mock('get' => sub { return $response } );
245 |     return $obj;
246 |     });
247 | 
248 |   my $query = "query";
249 |   my $resp = $deliv->send($query);
250 | 
251 |   cmp_deeply($resp, $content, "sent");
252 |   my ($func, $args) = $obj->next_call();
253 |   is($func, 'default_header', "made call to set header");
254 |   shift(@$args);
255 |   cmp_deeply($args,['Authorization','Bearer k'], " with proper api key header");
256 | 
257 |   ($func, $args) = $obj->next_call();  
258 |   is($func, 'get', "made call to get");
259 |   shift(@$args);
260 |   cmp_deeply($args, [$query], " with proper args");
261 |   
262 |   ($func, $args) = $obj->next_call();
263 |   is($func, undef, "all lwp calls accounted for");
264 | 
265 |   $response = HTTP::Response->new('403', 'bad error');
266 |   $resp = $deliv->send($query);
267 |   cmp_deeply($resp, {errors => ['403 bad error']}, "error returned" );
268 | 
269 |   ($func, $args) = $obj->next_call();
270 |   is($func, 'default_header', "made call to set header");
271 |   shift(@$args);
272 |   cmp_deeply($args,['Authorization','Bearer k'], " with proper api key header");
273 | 
274 |   ($func, $args) = $obj->next_call();
275 |   is($func, 'get', "made call to get");
276 |   shift(@$args);
277 |   cmp_deeply($args, [$query], " with proper args");
278 |   
279 |   ($func, $args) = $obj->next_call();
280 |   is($func, undef, "all lwp calls accounted for");
281 | 
282 | }
283 | 1;
284 | 


--------------------------------------------------------------------------------
/t/lib/Email/SendGrid/Transport/SMTP/Test.pm:
--------------------------------------------------------------------------------
  1 | package Email::SendGrid::Transport::SMTP::Test;
  2 | 
  3 | use strict;
  4 | use base qw(Test::Class);
  5 | use Test::More;
  6 | 
  7 | use MIME::Entity;
  8 | use Email::SendGrid;
  9 | use Email::SendGrid::Transport::SMTP;
 10 | 
 11 | sub getSGObject
 12 | {
 13 |   my $fromAddr = 'tim@sendgrid.net';
 14 |   my $toAddr = 'tim@sendgrid.com';
 15 |   my $from = "Tim Jenkins <$fromAddr>";
 16 |   my $to =  "Tim Jenkins <$toAddr>";
 17 |   my $text = 'Some text';
 18 |   my $html = '<html><body>Some html</body></html>';
 19 |   my $encoding = 'base64';
 20 |   my $charset = 'utf-8';
 21 | 
 22 |   my $sg = Email::SendGrid->new( from => $from,
 23 |                                 to => $to,
 24 |                                 encoding => $encoding,
 25 |                                 charset => $charset,
 26 |                                 text => $text,
 27 |                                 html => $html,
 28 |                               );
 29 | 
 30 |   return $sg;
 31 | }
 32 | 
 33 | sub delivery : Test()
 34 | {
 35 |   my $smtp = Mock::Net::SMTP::TLS->create();
 36 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
 37 |                                              'password' => 'testing',
 38 |                                              'smtp_class' => $smtp
 39 |                                              );
 40 | 
 41 | 
 42 |   my $sg = getSGObject();
 43 | 
 44 |   my $res = $deliv->deliver($sg);
 45 | 
 46 |   is($res, undef, 'normal delivery');
 47 | }
 48 | 
 49 | sub create : Test(no_plan)
 50 | {
 51 |   eval {
 52 |     my $trans = Email::SendGrid::Transport::SMTP->new( username => 'u' );
 53 |   };
 54 |   ok($@ =~ /Must speicfy username\/password or api key at/, "only providing username generated error");
 55 | 
 56 |   eval {
 57 |     my $trans = Email::SendGrid::Transport::SMTP->new( password => 'u' );
 58 |   };
 59 |   ok($@ =~ /Must speicfy username\/password or api key at/, "only providing password generated error");
 60 | 
 61 |   eval {
 62 |     my $trans = Email::SendGrid::Transport::SMTP->new( username => 'u', api_key => 'k' );
 63 |   };
 64 |   ok($@ =~ /Must only specify username\/password or api key, not both at/, "providing username and api key generated error");
 65 | 
 66 |   my $trans = Email::SendGrid::Transport::SMTP->new( api_key => 'k' );
 67 |   is($trans->{username}, 'apikey', "username set to apikey");
 68 |   is($trans->{password}, 'k', 'password set to apikey value')
 69 | }
 70 | ###################################################################################################
 71 | # Tests for the SMTP transaction
 72 | sub connection_refused : Test()
 73 | {
 74 |   my $smtp = Mock::Net::SMTP::TLS->create( 'new' =>
 75 |       sub { die "Connect failed :IO::Socket::INET: connect: Connection refused"; }
 76 |       );
 77 | 
 78 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
 79 |                                              'password' => 'testing',
 80 |                                              'smtp_class' => $smtp
 81 |                                              );
 82 | 
 83 |   my $sg = getSGObject();
 84 | 
 85 |   my $error = $deliv->deliver($sg);
 86 | 
 87 |   ok($error =~ /refused/, 'connection refused');
 88 | }
 89 | 
 90 | sub unknown_host : Test
 91 | {
 92 |   my $smtp = Mock::Net::SMTP::TLS->create( 'new' =>
 93 |       sub { die "Connect failed :IO::Socket::INET: Bad hostname '$_[1]'"; }
 94 |       );
 95 | 
 96 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
 97 |                                              'password' => 'testing',
 98 |                                              'smtp_class' => $smtp
 99 |                                              );
100 | 
101 |   my $sg = getSGObject();
102 | 
103 |   my $error = $deliv->deliver($sg);
104 | 
105 |   ok($error =~ /Bad hostname/, 'unknown host');
106 | }
107 | 
108 | sub failed_authentication : Test
109 | {
110 |   my $smtp = Mock::Net::SMTP::TLS->create( 'new' =>
111 |       sub { die "Auth failed: 535 5.7.8 Error: authentication failed: authentication failure"; }
112 |       );
113 | 
114 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
115 |                                              'password' => 'testing',
116 |                                              'smtp_class' => $smtp
117 |                                              );
118 | 
119 |   my $sg = getSGObject();
120 | 
121 |   my $error = $deliv->deliver($sg);
122 | 
123 |   ok($error =~ /Auth failed/, 'failed authentication');
124 | }
125 | 
126 | sub from_rejection : Test
127 | {
128 |   my $smtp = Mock::Net::SMTP::TLS->create( 'mail' => sub {
129 |     my $self = shift;
130 |     my $from = shift;
131 |     die "Couldn't send MAIL <$from> 5.7.1 Relay denied"; }
132 |       );
133 | 
134 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
135 |                                              'password' => 'testing',
136 |                                              'smtp_class' => $smtp
137 |                                              );
138 | 
139 |   my $sg = getSGObject();
140 | 
141 |   my $error = $deliv->deliver($sg);
142 | 
143 |   ok($error =~ /send MAIL.*tim\@sendgrid.net/, 'mail command rejected');
144 | }
145 | 
146 | sub to_rejection : Test
147 | {
148 |   my $smtp = Mock::Net::SMTP::TLS->create( 'to' => sub {
149 |     my $self = shift;
150 |     my $to = shift;
151 |     die "Couldn't send TO <$to>: 554 5.7.1 <unknown[10.8.49.102]>: Client host rejected: Access denied";
152 |   });
153 | 
154 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
155 |                                              'password' => 'testing',
156 |                                              'smtp_class' => $smtp
157 |                                              );
158 | 
159 |   my $sg = getSGObject();
160 | 
161 |   my $error = $deliv->deliver($sg);
162 | 
163 |   ok($error =~ /send TO.*tim\@sendgrid.com/, 'to command rejected');
164 | }
165 | 
166 | sub data_error : Test
167 | {
168 |   my $smtp = Mock::Net::SMTP::TLS->create( data => sub {
169 |     die "An error occurred during DATA";
170 |   });
171 | 
172 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
173 |                                              'password' => 'testing',
174 |                                              'smtp_class' => $smtp
175 |                                              );
176 | 
177 |   my $sg = getSGObject();
178 | 
179 |   my $error = $deliv->deliver($sg);
180 | 
181 |   ok($error =~ /during DATA\W/, 'data error');
182 | }
183 | 
184 | sub datasend_error : Test
185 | {
186 |   my $smtp = Mock::Net::SMTP::TLS->create( datasend => sub {
187 |     die "An error occurred during datasend";
188 |   });
189 | 
190 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
191 |                                              'password' => 'testing',
192 |                                              'smtp_class' => $smtp
193 |                                              );
194 | 
195 |   my $sg = getSGObject();
196 | 
197 |   my $error = $deliv->deliver($sg);
198 | 
199 |   ok($error =~ /during datasend\W/, 'datasend error');
200 | }
201 | 
202 | sub dataend_error : Test
203 | {
204 |   my $smtp = Mock::Net::SMTP::TLS->create( dataend => sub {
205 |     die "An error occurred during dataend";
206 |   });
207 | 
208 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
209 |                                              'password' => 'testing',
210 |                                              'smtp_class' => $smtp
211 |                                              );
212 | 
213 |   my $sg = getSGObject();
214 | 
215 |   my $error = $deliv->deliver($sg);
216 | 
217 |   ok($error =~ /during dataend\W/, 'dataend error');
218 | }
219 | 
220 | # Errors on quit should be ignored
221 | sub quit_error : Test
222 | {
223 |   my $smtp = Mock::Net::SMTP::TLS->create( quit => sub {
224 |     die "An error occurred disconnecting from the mail server";
225 |   });
226 | 
227 |   my $deliv = Email::SendGrid::Transport::SMTP->new( 'username' => 'tim@sendgrid.net',
228 |                                              'password' => 'testing',
229 |                                              'smtp_class' => $smtp
230 |                                              );
231 | 
232 |   my $sg = getSGObject();
233 | 
234 |   my $error = $deliv->deliver($sg);
235 | 
236 |   is($error, undef, 'handling of error on quit');
237 | }
238 | 
239 | 1;
240 | 


--------------------------------------------------------------------------------
/t/lib/Mock/Net/SMTP/TLS.pm:
--------------------------------------------------------------------------------
 1 | package Mock::Net::SMTP::TLS;
 2 | 
 3 | use strict;
 4 | use Data::Dumper qw(Dumper);
 5 | use Carp;
 6 | 
 7 | our $AUTOLOAD;
 8 | 
 9 | sub create
10 | {
11 |   my $this = shift;
12 |   my $class = ref($this) || $this;
13 | 
14 |   my $self = bless{
15 |                     new => sub { return $_[0]; },
16 |                     mail => sub { return 1; },
17 |                     to => sub { return 1; },
18 |                     data => sub { return 1; },
19 |                     datasend => sub { return 1; },
20 |                     dataend => sub { return 1; },
21 |                     quit => sub { return 1; },
22 |                     @_ }, $class;
23 | 
24 |     return $self;
25 | }
26 | 
27 | # Autload functions for all the methods we have objects for
28 | sub AUTOLOAD
29 | {
30 |    my $self = shift;
31 | 
32 |    my $type = ref ($self) || croak "$self is not an object";
33 |    my $field = $AUTOLOAD;
34 |    $field =~ s/.*://;
35 | 
36 |    unless (exists $self->{$field})
37 |    {
38 |       croak "$field does not exist in object/class $type";
39 |    }
40 | 
41 |    return $self->{$field}($self, @_);
42 | }
43 | 
44 | # Keep autoload from pissing things off
45 | sub DESTROY
46 | {
47 | }
48 | 1;
49 | 
50 | 


--------------------------------------------------------------------------------
/t/test.t:
--------------------------------------------------------------------------------
1 | #! /usr/bin/perl
2 | use Test::Class::Load '.';
3 | 
4 | $ENV{TEST_METHOD} = $ARGV[0] if defined($ARGV[0]);
5 | 
6 | # run all the test methods in the libraries we've loaded
7 | Test::Class->runtests;
8 | 


--------------------------------------------------------------------------------