Email-Sender-1.300010000755000766000024 012264314106 13427 5ustar00rjbsstaff000000000000README100644000766000024 56112264314106 14352 0ustar00rjbsstaff000000000000Email-Sender-1.300010 This archive contains the distribution Email-Sender, version 1.300010: a library for sending email This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v5.010. Changes100644000766000024 1523512264314106 15031 0ustar00rjbsstaff000000000000Email-Sender-1.300010Revision history for Email-Sender 1.300010 2014-01-11 14:15:13-05:00 America/New_York - the SMTP transport now has a "debug" option 1.300009 2013-09-01 12:03:06 America/New_York see also 1.300008! switch to automatic determination of prereqs to improve accuracy 1.300008 2013-09-01 09:39:13 America/New_York [THIS MIGHT BREAK YOUR CODE] at long last, Sendmail and Maildir transports replaces CRLF with CR before piping [BUG FIXES] fixes a bug where recipients beginning with a - would not work with the Sendmail transport [rt.perl.org #66246] require Email-Abstract 3.006, to get Email-Simple 1.998, to get Email::Simple->new(\$str), resolving [rt.perl.org #85926] 1.300007 2013-03-19 14:58:27 America/New_York when sending over SMTP, send DATA in hunks of 1 mebibyte or smaller 1.300006 2013-03-17 17:23:21 America/New_York re-fix the problem with attribute accessors and role methods clashing, previously fixed in 0.102360 1.300005 2013-02-14 11:37:09 America/New_York add missing prereq, Sub::Exporter; thanks for report, Esteban Manchado Velázquez 1.300004 2013-02-09 10:09:02 America/New_York bump required version of MooX::Types::MooseLike 1.300003 2013-02-06 15:56:53 America/New_York make Wrapper transports proxy is_simple and allow_partial_success to the wrapped transport allow Wrapper transports to construct their own targets; useful for configuring entire wrapper chain from the environment 1.300002 2013-02-06 14:06:24 America/New_York THIS IS A BIG DEAL: see v1.300000 this is the first non-trial release using Moo instead of Moose increase version of Moo to interoperate with ancient Mouse.pm 1.300001 2013-01-07 21:38:31 America/New_York increase required versions of Throwable and Moo 1.300000 2013-01-02 22:42:58 America/New_York THIS IS A BIG DEAL: use Moo instead of Moose (thanks to Justin Hunter and Christian Walde!) 0.120002 2012-09-11 14:43:07 America/New_York added shift_deliveries to the Test transport, for treating the sent messages like a queue of things to inspect 0.120001 2012-07-19 16:28:01 America/Los_Angeles no changes from 0.120000, just marked as stable release 0.120000 2012-05-08 20:53:43 America/New_York THIS IS A BIG DEAL: This release deprecates the scalar context behavior of: * Failure->recipients * Failure::Multi->failures * Failure::Multi->recipients * Transport::Test->deliveries * Transport::Failable->failure_conditions Until now, these methods returned a list in list context and an array reference in scalar context. This still works, but scalar context calls will now generate a warning. In one year (2013-05), they will be become fatal. 0.110005 2012-03-05 21:37:35 America/New_York binmode output handle to avoid line ending munging in Mbox and Maildir; thanks, Christian Walde! 0.110004 2012-02-21 17:47:35 America/New_York import the "Bcc" page from the (otherwise empty) github wiki; this adds some information to the QuickStart page about why Bcc support isn't there and why this isn't a bug 0.110003 2012-02-01 15:09:52 America/New_York add the add_lines_header and add_envelope_headers attributes to Maildir transports 0.110002 2012-01-31 17:02:35 America/New_York Maildir deliveries now have a ->filename method to tell you just where the mail was delivered 0.110001 2011-04-03 16:32:15 America/New_York prevent Test::MinimumVersion test from causing a requirement on T::MV and, thus, PPI! Thanks for the report, Matt S. Trout! 0.110000 2011-03-17 21:40:36 America/New_York provide a much clearer and more fatal error when SASL authentication has failed because Authen::SASL or MIME::Base64 is not available 0.102370 2010-08-25 08:37:22 America/New_York remove spurious prereq on Sys::Hostname::Long (thanks ABH) tweak some tests for truth/definedness in SMTP transport 0.102360 2010-08-24 07:47:24 America/New_York avoid the need to use "excludes" in role application; this silences warnings with Moose 1.10 0.101760 2010-06-25 08:18:26 America/New_York fix sendmail.t with latest Capture::Tiny (Justin Hunter) 0.100460 2010-02-15 12:58:18 America/New_York avoid using AutoPrereq, as it brings in build_requires as requires 0.100450 2010-02-14 17:55:48 America/New_York allow timeout option to SMTP transport 0.100110 2010-01-11 10:43:57 America/New_York Email::Sender::Failure is now a Throwable::Error now uses Try::Tiny for internal exception handling 0.093380 2009-12-04 12:29:55 America/New_York bump Moose prereq to 0.70 based on feedback from ANDK 0.093110 2009-11-07 allow uppercase env vars to set transport attributes (charsbar) add "message" attribute to successes returned by SMTP transports 0.092840 2009-10-10 fix packaging error 0.092820 2009-10-09 improve reliability of t/sendmail.t (thanks, Mark Grimes) 0.091940 2009-07-12 packaging fixes (EU:MM version for LICENSE param) rt #47817 0.091930 2009-07-12 add some more common sendmail locations to default search 0.091870 2009-07-06 exclude unwanted methods from Email::Sender::Transport to suppress a new warning from Moose role composition 0.091740 2009-06-23 no code changes remove prereq of Test::More 0.88; weird things happened 0.091661 2009-06-15 THIS RELEASE MAY BREAK YOUR CODE... but probably not Email::Sender::Simple has been added, along with a manual Email::Sender is now a role Email::Sender::Transport is now a role, too; subclasses will break 0.004 2009-03-24 require perl5 version 8 move to Moose; let's not mess around, the Moose/Mouse stuff is not worth the minor savings 0.003 2009-03-12 Sendmail transport now uses 2-arg open on Win32 so it can work at all Win32-friendly tests added for Sendmail by the ever-awesome DAGOLDEN 0.002 2009-01-31 fix minor documentation errors 0.001 2009-01-02 SQLite transport split into its own dist, removed from this QUIT when ending a transmission in non-persist SMTP 0.000 2008-12-10 first CPAN demo release; It Probably Works! LICENSE100644000766000024 4366112264314106 14547 0ustar00rjbsstaff000000000000Email-Sender-1.300010This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2014 by Ricardo Signes. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2014 by Ricardo Signes. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644000766000024 101212264314106 15146 0ustar00rjbsstaff000000000000Email-Sender-1.300010name = Email-Sender author = Ricardo Signes license = Perl_5 copyright_holder = Ricardo Signes [@RJBS] [Prereqs] Moo = 1.000008 ; bugfixes related to old Mouse installs MooX::Types::MooseLike = 0.15 ; InstanceOf uses ->isa Throwable::Error = 0.200003 ; with $obj->throw and ->throw($str) and Moo [Prereqs / DevelopRequires] Sub::Override = 0 Test::MockObject = 0 [RemovePrereqs] remove = JSON remove = Test::MockObject remove = Net::SMTP::SSL remove = Sub::Override t000755000766000024 012264314106 13613 5ustar00rjbsstaff000000000000Email-Sender-1.300010fail.t100644000766000024 117612264314106 15060 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More tests => 5; use Email::Sender::Failure; { my $fail = Email::Sender::Failure->new("message"); isa_ok($fail, 'Email::Sender::Failure'); is($fail->message, 'message', 'string alone -> message'); } { eval { my $fail = Email::Sender::Failure->new(undef); }; like($@, qr/Missing required arguments: message/, '->new(undef) -> fail'); } { eval { my $fail = Email::Sender::Failure->new(''); }; like($@, qr/must be a hash ref/i, '->new("") -> fail'); } { eval { my $fail = Email::Sender::Failure->new(message => ''); }; like($@, qr/message/i, '->new(message=>"") -> fail'); } mbox.t100644000766000024 147212264314106 15111 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use lib 't/lib'; use Test::Email::Sender::Util; use File::Spec (); use File::Temp (); use Test::More tests => 4; my $tempdir = File::Temp::tempdir(CLEANUP => 1); my $mbox = File::Spec->catfile($tempdir, 'mbox'); use Email::Sender::Transport::Mbox; my $message = readfile('t/messages/simple.msg'); my $sender = Email::Sender::Transport::Mbox->new({ filename => $mbox }); for (1..2) { my $result = $sender->send( join('', @$message), { to => [ 'rjbs@example.com' ], from => 'rjbs@example.biz', }, ); isa_ok($result, 'Email::Sender::Success', "delivery result"); } ok(-f $mbox, "$mbox exists now"); open my $fh, '<', $mbox or die "couldn't open $mbox to read: $!"; my $line = <$fh>; like( $line, qr/^From rjbs\@example\.biz/, "added a From_ line" ); test.t100644000766000024 1405512264314106 15144 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More tests => 45; use Email::Sender::Transport::Test; use Email::Sender::Transport::Failable; my $sender = Email::Sender::Transport::Test->new; ok($sender->does('Email::Sender::Transport')); isa_ok($sender, 'Email::Sender::Transport::Test'); is($sender->delivery_count, 0, "no deliveries so far"); my $message = <<'END_MESSAGE'; From: sender@test.example.com To: recipient@nowhere.example.net Subject: this message is going nowhere fast Dear Recipient, You will never receive this. -- sender END_MESSAGE ok($sender->is_simple, "we can use standard Test for Simple"); ok(! $sender->allow_partial_success, "std Test doesn't allow partial succ"); { my $result = $sender->send( $message, { to => [ qw(recipient@nowhere.example.net) ] } ); ok($result, 'success'); } is($sender->delivery_count, 1, "we've done one delivery so far"); { my $result = $sender->send( $message, { to => [ qw(secret-bcc@nowhere.example.net) ] } ); ok($result, 'success'); } is($sender->delivery_count, 2, "we've done two deliveries so far"); my @deliveries = $sender->deliveries; is_deeply( $deliveries[0]{successes}, [ qw(recipient@nowhere.example.net)], "first message delivered to 'recipient'", ); is_deeply( $deliveries[1]{successes}, [ qw(secret-bcc@nowhere.example.net)], "second message delivered to 'secret-bcc'", ); ok($sender->shift_deliveries, "we have one delivery (shifted)..."); ok($sender->shift_deliveries, "...then two (shifted)..."); ok(! $sender->shift_deliveries, "...then no more"); #### { package Email::Sender::Transport::TestFail; use Moo; extends 'Email::Sender::Transport::Test'; sub delivery_failure { my ($self, $email, $env) = @_; return Email::Sender::Failure->new('bad sender') if $env->{from} =~ /^reject@/; return; } sub recipient_failure { my ($self, $rcpt) = @_; if ($rcpt =~ /^fault@/) { return Email::Sender::Failure->new({ message => 'fault', recipients => [ $rcpt ], }); } if ($rcpt =~ /^tempfail@/) { return Email::Sender::Failure::Temporary->new({ message => 'tempfail', recipients => [ $rcpt ], }); } if ($rcpt =~ /^permfail@/) { return Email::Sender::Failure::Permanent->new({ message => 'permfail', recipients => [ $rcpt ], }); } return; } no Moo; } my $fail_test = Email::Sender::Transport::TestFail->new; sub test_fail { my ($env, $succ_cb, $fail_cb) = @_; my $ok = eval { $fail_test->send($message, $env); }; my $error = $@; $succ_cb ? $succ_cb->($ok) : ok(! $ok, 'we expected to fail'); $fail_cb ? $fail_cb->($error) : ok(! $error, 'we expected to succeed'); } test_fail( { to => 'ok@example.com', from => 'sender@example.com', }, sub { ok(ref $_[0] eq 'Email::Sender::Success', 'correct success class'); }, undef, ); test_fail( { to => 'ok@example.com', from => 'reject@example.com', }, undef, sub { my ($fail) = @_; isa_ok($fail, 'Email::Sender::Failure'); is($fail->message, 'bad sender', 'got expected failure message'); is_deeply( [ $fail->recipients ], [ 'ok@example.com' ], 'correct recipients on failure notice', ); }, ); test_fail( { to => 'tempfail@example.com', from => 'sender@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure::Temporary'); }, ); test_fail( { to => 'permfail@example.com', from => 'sender@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure::Permanent'); }, ); test_fail( { to => 'fault@example.com', from => 'sender@example.com', }, undef, sub { is(ref $_[0], 'Email::Sender::Failure', 'exact class on fault'); }, ); test_fail( { to => [ 'permfail@example.com', 'ok@example.com' ], from => 'sender@example.com', }, undef, sub { my $fail = shift; isa_ok($fail, 'Email::Sender::Failure', 'we got a failure'); isa_ok($fail, 'Email::Sender::Failure::Multi', "it's a multifailure"); my @failures = $fail->failures; is(@failures, 1, "there is only 1 failure in our multi"); is_deeply( [ $fail->recipients ], [ 'permfail@example.com' ], 'failing addrs are correct', ); ok( $fail->isa('Email::Sender::Failure::Permanent'), "even though it is a Multi, we report isa Permanent since it's uniform", ); }, ); $fail_test = Email::Sender::Transport::TestFail->new({ allow_partial_success => 1, }); ok(! $fail_test->is_simple, "partial success capable Test ! simple"); ok($fail_test->allow_partial_success, "...because it allows partial success"); test_fail( { to => [ 'permfail@example.com', 'ok@example.com' ], from => 'sender@example.com', }, sub { my $succ = shift; isa_ok($succ, 'Email::Sender::Success', 'we got a success'); isa_ok($succ, 'Email::Sender::Success::Partial', "it's partial"); my $failure = $succ->failure; isa_ok($failure, 'Email::Sender::Failure::Multi', 'the failure is multi'); my @failures = $failure->failures; is(@failures, 1, "there is only 1 failure in our partial"); is_deeply( [ $succ->failure->recipients ], [ 'permfail@example.com' ], 'failing addrs are correct', ); ok( ! $succ->isa('Email::Sender::Failure::Permanent'), "we do not crazily report the success ->isa permfail", ); }, undef, ); #### my $failer = Email::Sender::Transport::Failable->new({ transport => $sender }); $failer->transport->clear_deliveries; my $i = 0; $failer->fail_if(sub { return "failing half of all mail to test" if $i++ % 2; return; }); { my $result = eval { $failer->send($message, { to => [ qw(ok@ok.ok) ] }) }; ok($result, 'success'); } is( $failer->transport->delivery_count, 1, "first post-fail_if delivery is OK" ); { eval { my $result = $failer->send($message, { to => [ qw(ok@ok.ok) ] }) }; isa_ok($@, 'Email::Sender::Failure', "we died"); } is( $failer->transport->delivery_count, 1, "second post-fail_if delivery fails" ); META.yml100644000766000024 2230012264314106 14776 0ustar00rjbsstaff000000000000Email-Sender-1.300010--- abstract: 'a library for sending email' author: - 'Ricardo Signes ' build_requires: Capture::Tiny: 0.08 Cwd: 0 Exporter: 0 File::Temp: 0 Test::More: 0.96 lib: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 5.010, CPAN::Meta::Converter version 2.133380' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Email-Sender requires: Carp: 0 Email::Abstract: 3.006 Email::Address: 0 Email::Simple: 1.998 Fcntl: 0 File::Basename: 0 File::Path: 0 File::Spec: 0 IO::File: 0 IO::Handle: 0 List::MoreUtils: 0 Module::Runtime: 0 Moo: 1.000008 Moo::Role: 0 MooX::Types::MooseLike: 0.15 MooX::Types::MooseLike::Base: 0 Net::SMTP: 0 Scalar::Util: 0 Sub::Exporter: 0 Sub::Exporter::Util: 0 Sys::Hostname: 0 Throwable::Error: 0.200003 Try::Tiny: 0 strict: 0 warnings: 0 resources: bugtracker: https://github.com/rjbs/Email-Sender/issues homepage: https://github.com/rjbs/Email-Sender repository: https://github.com/rjbs/Email-Sender.git version: 1.300010 x_Dist_Zilla: perl: version: 5.018002 plugins: - class: Dist::Zilla::Plugin::Git::GatherDir name: '@RJBS/Git::GatherDir' version: 2.019 - class: Dist::Zilla::Plugin::CheckPrereqsIndexed name: '@RJBS/CheckPrereqsIndexed' version: 0.010 - class: Dist::Zilla::Plugin::CheckExtraTests name: '@RJBS/CheckExtraTests' version: 0.016 - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 0 check_all_prereqs: 0 modules: - Dist::Zilla::PluginBundle::RJBS phase: build skip: [] name: '@RJBS/RJBS-Outdated' version: 0.015 - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 1 check_all_prereqs: 0 modules: [] phase: release skip: [] name: '@RJBS/CPAN-Outdated' version: 0.015 - class: Dist::Zilla::Plugin::PruneCruft name: '@RJBS/@Filter/PruneCruft' version: 5.010 - class: Dist::Zilla::Plugin::ManifestSkip name: '@RJBS/@Filter/ManifestSkip' version: 5.010 - class: Dist::Zilla::Plugin::MetaYAML name: '@RJBS/@Filter/MetaYAML' version: 5.010 - class: Dist::Zilla::Plugin::License name: '@RJBS/@Filter/License' version: 5.010 - class: Dist::Zilla::Plugin::Readme name: '@RJBS/@Filter/Readme' version: 5.010 - class: Dist::Zilla::Plugin::ExecDir name: '@RJBS/@Filter/ExecDir' version: 5.010 - class: Dist::Zilla::Plugin::ShareDir name: '@RJBS/@Filter/ShareDir' version: 5.010 - class: Dist::Zilla::Plugin::MakeMaker name: '@RJBS/@Filter/MakeMaker' version: 5.010 - class: Dist::Zilla::Plugin::Manifest name: '@RJBS/@Filter/Manifest' version: 5.010 - class: Dist::Zilla::Plugin::TestRelease name: '@RJBS/@Filter/TestRelease' version: 5.010 - class: Dist::Zilla::Plugin::ConfirmRelease name: '@RJBS/@Filter/ConfirmRelease' version: 5.010 - class: Dist::Zilla::Plugin::UploadToCPAN name: '@RJBS/@Filter/UploadToCPAN' version: 5.010 - class: Dist::Zilla::Plugin::AutoPrereqs name: '@RJBS/AutoPrereqs' version: 5.010 - class: Dist::Zilla::Plugin::Git::NextVersion name: '@RJBS/Git::NextVersion' version: 2.019 - class: Dist::Zilla::Plugin::PkgVersion name: '@RJBS/PkgVersion' version: 5.010 - class: Dist::Zilla::Plugin::MetaConfig name: '@RJBS/MetaConfig' version: 5.010 - class: Dist::Zilla::Plugin::MetaJSON name: '@RJBS/MetaJSON' version: 5.010 - class: Dist::Zilla::Plugin::NextRelease name: '@RJBS/NextRelease' version: 5.010 - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: '@RJBS/Test::ChangesHasContent' version: 0.006 - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@RJBS/PodSyntaxTests' version: 5.010 - class: Dist::Zilla::Plugin::ReportVersions::Tiny name: '@RJBS/ReportVersions::Tiny' version: 1.10 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: '@RJBS/TestMoreWithSubtests' version: 5.010 - class: Dist::Zilla::Plugin::PodWeaver config: Dist::Zilla::Plugin::PodWeaver: config_plugins: - '@RJBS' finder: - ':InstallModules' - ':ExecFiles' plugins: - class: Pod::Weaver::Plugin::EnsurePod5 name: '@CorePrep/EnsurePod5' version: 4.006 - class: Pod::Weaver::Plugin::H1Nester name: '@CorePrep/H1Nester' version: 4.006 - class: Pod::Weaver::Plugin::SingleEncoding name: '@RJBS/SingleEncoding' version: 4.006 - class: Pod::Weaver::Section::Name name: '@RJBS/Name' version: 4.006 - class: Pod::Weaver::Section::Version name: '@RJBS/Version' version: 4.006 - class: Pod::Weaver::Section::Region name: '@RJBS/Prelude' version: 4.006 - class: Pod::Weaver::Section::Generic name: '@RJBS/Synopsis' version: 4.006 - class: Pod::Weaver::Section::Generic name: '@RJBS/Description' version: 4.006 - class: Pod::Weaver::Section::Generic name: '@RJBS/Overview' version: 4.006 - class: Pod::Weaver::Section::Generic name: '@RJBS/Stability' version: 4.006 - class: Pod::Weaver::Section::Collect name: Attributes version: 4.006 - class: Pod::Weaver::Section::Collect name: Methods version: 4.006 - class: Pod::Weaver::Section::Collect name: Functions version: 4.006 - class: Pod::Weaver::Section::Leftovers name: '@RJBS/Leftovers' version: 4.006 - class: Pod::Weaver::Section::Region name: '@RJBS/postlude' version: 4.006 - class: Pod::Weaver::Section::Authors name: '@RJBS/Authors' version: 4.006 - class: Pod::Weaver::Section::Legal name: '@RJBS/Legal' version: 4.006 - class: Pod::Weaver::Plugin::Transformer name: '@RJBS/List' version: 4.006 name: '@RJBS/PodWeaver' version: 4.005 - class: Dist::Zilla::Plugin::GithubMeta name: '@RJBS/GithubMeta' version: 0.42 - class: Dist::Zilla::Plugin::Git::Check name: '@RJBS/@Git/Check' version: 2.019 - class: Dist::Zilla::Plugin::Git::Commit name: '@RJBS/@Git/Commit' version: 2.019 - class: Dist::Zilla::Plugin::Git::Tag name: '@RJBS/@Git/Tag' version: 2.019 - class: Dist::Zilla::Plugin::Git::Push name: '@RJBS/@Git/Push' version: 2.019 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: requires name: Prereqs version: 5.010 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: DevelopRequires version: 5.010 - class: Dist::Zilla::Plugin::RemovePrereqs config: Dist::Zilla::Plugin::RemovePrereqs: modules_to_remove: - JSON - Test::MockObject - Net::SMTP::SSL - Sub::Override name: RemovePrereqs version: 5.010 - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: 5.010 - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: 5.010 - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: 5.010 - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: 5.010 - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: 5.010 - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: 5.010 - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: 5.010 - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: 5.010 zilla: class: Dist::Zilla::Dist::Builder config: is_trial: 0 version: 5.010 MANIFEST100644000766000024 300012264314106 14632 0ustar00rjbsstaff000000000000Email-Sender-1.300010# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.010. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/Email/Sender.pm lib/Email/Sender/Failure.pm lib/Email/Sender/Failure/Multi.pm lib/Email/Sender/Failure/Permanent.pm lib/Email/Sender/Failure/Temporary.pm lib/Email/Sender/Manual.pm lib/Email/Sender/Manual/QuickStart.pm lib/Email/Sender/Role/CommonSending.pm lib/Email/Sender/Role/HasMessage.pm lib/Email/Sender/Simple.pm lib/Email/Sender/Success.pm lib/Email/Sender/Success/Partial.pm lib/Email/Sender/Transport.pm lib/Email/Sender/Transport/DevNull.pm lib/Email/Sender/Transport/Failable.pm lib/Email/Sender/Transport/Maildir.pm lib/Email/Sender/Transport/Mbox.pm lib/Email/Sender/Transport/Print.pm lib/Email/Sender/Transport/SMTP.pm lib/Email/Sender/Transport/SMTP/Persistent.pm lib/Email/Sender/Transport/Sendmail.pm lib/Email/Sender/Transport/Test.pm lib/Email/Sender/Transport/Wrapper.pm lib/Email/Sender/Util.pm misc/smtp.t t/00-load.t t/000-report-versions-tiny.t t/devnull.t t/fail-multi.t t/fail.t t/lib/Test/Email/SMTPRig.pm t/lib/Test/Email/Sender/Transport/FailEvery.pm t/lib/Test/Email/Sender/Util.pm t/maildir.t t/mbox.t t/messages/simple.msg t/pobox-rig.json t/print.t t/sendmail.t t/simple-simple.t t/simple-wrapper.t t/smtp-via-mock.t t/smtp-via-rig.t t/test.t t/trans-prep-email.t t/util-env.t t/util-fail.t util/executable util/not-executable util/sendmail util/sendmail.bat xt/release/a-perl-minver.t xt/release/changes_has_content.t xt/release/pod-syntax.t print.t100644000766000024 213112264314106 15271 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More tests => 4; use Email::Sender; use Email::Sender::Transport::Print; { package CP; sub new { bless { str => '' } => $_[0] } sub print { shift->{str} .= join '', @_ } sub printf { shift->{str} .= sprintf shift, @_ } sub isa { return 1 if $_[1] eq 'IO::Handle' } } my $xport = Email::Sender::Transport::Print->new({ fh => CP->new }); ok($xport->does('Email::Sender::Transport')); isa_ok($xport, 'Email::Sender::Transport::Print'); my $message = <<'END_MESSAGE'; From: from@test.example.com To: to@nowhere.example.net Subject: this message is going nowhere fast Dear Recipient, You will never receive this. -- sender END_MESSAGE my $want = <<"END_WANT"; ENVELOPE TO : rcpt\@nowhere.example.net ENVELOPE FROM: sender\@test.example.com ---------- begin message $message---------- end message END_WANT my $result = $xport->send( $message, { to => [ 'rcpt@nowhere.example.net' ], from => 'sender@test.example.com', }, ); isa_ok($result, 'Email::Sender::Success'); is($xport->fh->{str}, $want, 'what we expected got printed'); META.json100644000766000024 3536112264314106 15161 0ustar00rjbsstaff000000000000Email-Sender-1.300010{ "abstract" : "a library for sending email", "author" : [ "Ricardo Signes " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.010, CPAN::Meta::Converter version 2.133380", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Email-Sender", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Test::Pod" : "1.41", "version" : "0.9901" } }, "runtime" : { "requires" : { "Carp" : "0", "Email::Abstract" : "3.006", "Email::Address" : "0", "Email::Simple" : "1.998", "Fcntl" : "0", "File::Basename" : "0", "File::Path" : "0", "File::Spec" : "0", "IO::File" : "0", "IO::Handle" : "0", "List::MoreUtils" : "0", "Module::Runtime" : "0", "Moo" : "1.000008", "Moo::Role" : "0", "MooX::Types::MooseLike" : "0.15", "MooX::Types::MooseLike::Base" : "0", "Net::SMTP" : "0", "Scalar::Util" : "0", "Sub::Exporter" : "0", "Sub::Exporter::Util" : "0", "Sys::Hostname" : "0", "Throwable::Error" : "0.200003", "Try::Tiny" : "0", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Capture::Tiny" : "0.08", "Cwd" : "0", "Exporter" : "0", "File::Temp" : "0", "Test::More" : "0.96", "lib" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/rjbs/Email-Sender/issues" }, "homepage" : "https://github.com/rjbs/Email-Sender", "repository" : { "type" : "git", "url" : "https://github.com/rjbs/Email-Sender.git", "web" : "https://github.com/rjbs/Email-Sender" } }, "version" : "1.300010", "x_Dist_Zilla" : { "perl" : { "version" : "5.018002" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "name" : "@RJBS/Git::GatherDir", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed", "name" : "@RJBS/CheckPrereqsIndexed", "version" : "0.010" }, { "class" : "Dist::Zilla::Plugin::CheckExtraTests", "name" : "@RJBS/CheckExtraTests", "version" : "0.016" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 0, "check_all_prereqs" : 0, "modules" : [ "Dist::Zilla::PluginBundle::RJBS" ], "phase" : "build", "skip" : [] } }, "name" : "@RJBS/RJBS-Outdated", "version" : "0.015" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : "1", "check_all_prereqs" : 0, "modules" : [], "phase" : "release", "skip" : [] } }, "name" : "@RJBS/CPAN-Outdated", "version" : "0.015" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@RJBS/@Filter/PruneCruft", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@RJBS/@Filter/ManifestSkip", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@RJBS/@Filter/MetaYAML", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@RJBS/@Filter/License", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::Readme", "name" : "@RJBS/@Filter/Readme", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@RJBS/@Filter/ExecDir", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@RJBS/@Filter/ShareDir", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "name" : "@RJBS/@Filter/MakeMaker", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@RJBS/@Filter/Manifest", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@RJBS/@Filter/TestRelease", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@RJBS/@Filter/ConfirmRelease", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@RJBS/@Filter/UploadToCPAN", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "@RJBS/AutoPrereqs", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::Git::NextVersion", "name" : "@RJBS/Git::NextVersion", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::PkgVersion", "name" : "@RJBS/PkgVersion", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@RJBS/MetaConfig", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@RJBS/MetaJSON", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@RJBS/NextRelease", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", "name" : "@RJBS/Test::ChangesHasContent", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@RJBS/PodSyntaxTests", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::ReportVersions::Tiny", "name" : "@RJBS/ReportVersions::Tiny", "version" : "1.10" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "@RJBS/TestMoreWithSubtests", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::PodWeaver", "config" : { "Dist::Zilla::Plugin::PodWeaver" : { "config_plugins" : [ "@RJBS" ], "finder" : [ ":InstallModules", ":ExecFiles" ], "plugins" : [ { "class" : "Pod::Weaver::Plugin::EnsurePod5", "name" : "@CorePrep/EnsurePod5", "version" : "4.006" }, { "class" : "Pod::Weaver::Plugin::H1Nester", "name" : "@CorePrep/H1Nester", "version" : "4.006" }, { "class" : "Pod::Weaver::Plugin::SingleEncoding", "name" : "@RJBS/SingleEncoding", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Name", "name" : "@RJBS/Name", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Version", "name" : "@RJBS/Version", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@RJBS/Prelude", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Synopsis", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Description", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Overview", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "@RJBS/Stability", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Attributes", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Methods", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "Functions", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Leftovers", "name" : "@RJBS/Leftovers", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@RJBS/postlude", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Authors", "name" : "@RJBS/Authors", "version" : "4.006" }, { "class" : "Pod::Weaver::Section::Legal", "name" : "@RJBS/Legal", "version" : "4.006" }, { "class" : "Pod::Weaver::Plugin::Transformer", "name" : "@RJBS/List", "version" : "4.006" } ] } }, "name" : "@RJBS/PodWeaver", "version" : "4.005" }, { "class" : "Dist::Zilla::Plugin::GithubMeta", "name" : "@RJBS/GithubMeta", "version" : "0.42" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "name" : "@RJBS/@Git/Check", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "name" : "@RJBS/@Git/Commit", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "name" : "@RJBS/@Git/Tag", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "name" : "@RJBS/@Git/Push", "version" : "2.019" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "requires" } }, "name" : "Prereqs", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "DevelopRequires", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::RemovePrereqs", "config" : { "Dist::Zilla::Plugin::RemovePrereqs" : { "modules_to_remove" : [ "JSON", "Test::MockObject", "Net::SMTP::SSL", "Sub::Override" ] } }, "name" : "RemovePrereqs", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "5.010" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "5.010" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : "0" }, "version" : "5.010" } } } misc000755000766000024 012264314106 14303 5ustar00rjbsstaff000000000000Email-Sender-1.300010smtp.t100644000766000024 141212264314106 15611 0ustar00rjbsstaff000000000000Email-Sender-1.300010/miscuse strict; use warnings; use Data::Dumper; use Email::Sender::Transport::SMTP; use Email::Sender::Transport::SMTP_X; for my $suffix ('', '_X') { my $class = "Email::Sender::Transport::SMTP$suffix"; my $smtp = $class->new({ host => 'mx-all.pobox.com', allow_partial_success => 1, }); my $message = <<'END'; From: RJ To: Rico Subject: test message This is a test. -- rjbs END my $result = eval { $smtp->send( $message, { to => [ 'rjbs+rcpt@pobox.com', 'rsignes@pobox.com' ], from => 'rjbs+from@pobox.com', }, ); }; # my $error = $@; # print "\n\n$class - " . Dumper($result || $error) . "\n\n"; printf "fail: %s\n", $_ for $result->failure->recipients; } 00-load.t100644000766000024 115012264314106 15271 0ustar00rjbsstaff000000000000Email-Sender-1.300010/tuse Test::More 'no_plan'; use_ok('Email::Sender') && use_ok('Email::Sender::Simple') && use_ok('Email::Sender::Transport::DevNull') && use_ok('Email::Sender::Transport::Failable') && use_ok('Email::Sender::Transport::Maildir') && use_ok('Email::Sender::Transport::Mbox') && use_ok('Email::Sender::Transport::Print') && use_ok('Email::Sender::Transport::SMTP') && use_ok('Email::Sender::Transport::SMTP::Persistent') && use_ok('Email::Sender::Transport::Sendmail') && use_ok('Email::Sender::Transport::Test') && use_ok('Email::Sender::Transport::Wrapper') || BAIL_OUT("can't even compile all relevant modules"); devnull.t100644000766000024 106412264314106 15612 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More 'no_plan'; use Email::Sender; use Email::Sender::Transport::DevNull; my $xport = Email::Sender::Transport::DevNull->new; ok($xport->does('Email::Sender::Transport')); isa_ok($xport, 'Email::Sender::Transport::DevNull'); my $message = <<'END_MESSAGE'; From: sender@test.example.com To: recipient@nowhere.example.net Subject: this message is going nowhere fast Dear Recipient, You will never receive this. -- sender END_MESSAGE my $result = $xport->send($message); isa_ok($result, 'Email::Sender::Success'); maildir.t100644000766000024 245612264314106 15570 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use lib 't/lib'; use Test::Email::Sender::Util; use File::Spec (); use File::Temp (); use Test::More tests => 10; use Email::Sender::Transport::Maildir; my $message = readfile('t/messages/simple.msg'); my $maildir = File::Temp::tempdir(CLEANUP => 1); my (undef, $failfile) = File::Temp::tempfile(UNLINK => 1); my $faildir = File::Spec->catdir($failfile, 'Maildir'); my $sender = Email::Sender::Transport::Maildir->new({ dir => $maildir, }); for (1..2) { my $result = $sender->send( join('', @$message), { to => [ 'rjbs@example.com' ], from => 'rjbs@example.biz', }, ); isa_ok($result, 'Email::Sender::Success', "delivery result"); is( index($result->filename, $maildir), 0, "the result filename begins with the maildir", ); ok( -f $result->filename, "...and exists", ); } my $new = File::Spec->catdir($maildir, 'new'); ok(-d $new, "maildir ./new directory exists now"); my @files = grep { $_ !~ /^\./ } <$new/*>; is(@files, 2, "there are now two delivered messages in the Maildir"); my $lines = readfile($files[0]); my $simple = Email::Simple->new(join '', @$lines); is($simple->header('X-Email-Sender-To'), 'rjbs@example.com', 'env info in hdr'); is($simple->header('Lines'), 4, 'we counted lines correctly'); Makefile.PL100644000766000024 467212264314106 15473 0ustar00rjbsstaff000000000000Email-Sender-1.300010 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.010. use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "a library for sending email", "AUTHOR" => "Ricardo Signes ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "Email-Sender", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "Email::Sender", "PREREQ_PM" => { "Carp" => 0, "Email::Abstract" => "3.006", "Email::Address" => 0, "Email::Simple" => "1.998", "Fcntl" => 0, "File::Basename" => 0, "File::Path" => 0, "File::Spec" => 0, "IO::File" => 0, "IO::Handle" => 0, "List::MoreUtils" => 0, "Module::Runtime" => 0, "Moo" => "1.000008", "Moo::Role" => 0, "MooX::Types::MooseLike" => "0.15", "MooX::Types::MooseLike::Base" => 0, "Net::SMTP" => 0, "Scalar::Util" => 0, "Sub::Exporter" => 0, "Sub::Exporter::Util" => 0, "Sys::Hostname" => 0, "Throwable::Error" => "0.200003", "Try::Tiny" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Capture::Tiny" => "0.08", "Cwd" => 0, "Exporter" => 0, "File::Temp" => 0, "Test::More" => "0.96", "lib" => 0 }, "VERSION" => "1.300010", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Capture::Tiny" => "0.08", "Carp" => 0, "Cwd" => 0, "Email::Abstract" => "3.006", "Email::Address" => 0, "Email::Simple" => "1.998", "Exporter" => 0, "Fcntl" => 0, "File::Basename" => 0, "File::Path" => 0, "File::Spec" => 0, "File::Temp" => 0, "IO::File" => 0, "IO::Handle" => 0, "List::MoreUtils" => 0, "Module::Runtime" => 0, "Moo" => "1.000008", "Moo::Role" => 0, "MooX::Types::MooseLike" => "0.15", "MooX::Types::MooseLike::Base" => 0, "Net::SMTP" => 0, "Scalar::Util" => 0, "Sub::Exporter" => 0, "Sub::Exporter::Util" => 0, "Sys::Hostname" => 0, "Test::More" => "0.96", "Throwable::Error" => "0.200003", "Try::Tiny" => 0, "lib" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); sendmail.t100644000766000024 642712264314106 15745 0ustar00rjbsstaff000000000000Email-Sender-1.300010/tuse Test::More tests => 5; use strict; $^W = 1; use Capture::Tiny 0.08 'capture'; use Cwd; use Config; use Email::Sender::Transport::Sendmail; use File::Spec; my $IS_WIN32 = $^O eq 'MSWin32'; my $email = <<'EOF'; To: Casey West From: Casey West Subject: This should never show up in my inbox blah blah blah EOF my @to_unlink; END { unlink @to_unlink } sub get_bin_name { return 'sendmail.bat' if $IS_WIN32; my ($bin_path) = @_; my $input_file = File::Spec->catfile( $bin_path, 'sendmail' ); my $fn = "sendmail-$$-$^T.tmp"; my $output_file = File::Spec->catfile( $bin_path, $fn ); open my $in_fh, '<', $input_file or die "can't read input sendmail: $!"; open my $out_fh, '>', $output_file or die "can't write temp sendmail: $!"; while (<$in_fh>) { s/\A#!perl$/#!$^X/; print $out_fh $_; } push @to_unlink, $output_file; return $fn; } my $bin_path = File::Spec->rel2abs('util'); my $bin_name = get_bin_name($bin_path); my $sendmail_bin = File::Spec->catfile( $bin_path, $bin_name ); local $ENV{PATH} = join( $Config{path_sep}, $bin_path, $ENV{PATH}); SKIP: { chmod 0755, $sendmail_bin; skip "Cannot run unless '$sendmail_bin' is executable", 1 unless -x $sendmail_bin; my $path = eval { Email::Sender::Transport::Sendmail->_find_sendmail($bin_name) }; is( $path, $sendmail_bin, "found (fake) sendmail at '$sendmail_bin'" ); } { my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => File::Spec->catfile(qw/. util not-executable/) }); my $error; capture { # hide errors from cmd.exe on Win32 eval { no warnings; $sender->send( $email, { to => [ 'devnull@example.com' ], from => 'devnull@example.biz', } ); }; $error = $@; }; my $error_re = $IS_WIN32 ? qr/closing pipe/ : qr/open pipe/; like( $error->message, $error_re, 'error message says what we expect', ); } my $has_FileTemp = eval { require File::Temp; }; SKIP: { skip 'Cannot run this test unless current perl is -x', 1 unless -x $^X; my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $sendmail_bin }); my $return = $sender->send( $email, { to => [ 'devnull@example.com' ], from => 'devnull@example.biz', } ); ok( $return, 'send() succeeded with executable $SENDMAIL' ); } SKIP: { skip 'Cannot run this test unless current perl is -x', 2 unless -x $^X; skip 'Cannot run this test without File::Temp', 2 unless $has_FileTemp; my $tempdir = File::Temp::tempdir(CLEANUP => 1); my $logfile = File::Spec->catfile($tempdir, 'sendmail.log'); local $ENV{EMAIL_SENDER_TRANSPORT_SENDMAIL_TEST_LOGDIR} = $tempdir; my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $sendmail_bin }); my $return = eval { $sender->send( $email, { to => [ 'devnull@example.com' ], from => 'devnull@example.biz', } ); }; ok( $return, 'send() succeeded with executable sendmail in path' ); if (-f $logfile) { open my $fh, '<', $logfile or die "Cannot read $logfile: $!"; my $log = join '', <$fh>; like($log, qr/From: Casey West/, 'log contains From header'); } else { fail('cannot check sendmail log contents'); } } util-env.t100644000766000024 154112264314106 15704 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More tests => 2; use Email::Sender::Transport; use Email::Sender::Util; my $message = <<'END'; From: "Ricardo O'Signes" To: dude@example.com, , "I'm Not Your" Cc: another , cc@cc.example.cc Subject: sometimes people do dumb things Cc: like Bcc: bcc@example.biz This is a test message. -- rjbs END my $email = Email::Sender::Transport->prepare_email(\$message); is_deeply( Email::Sender::Util->_sender_from_email($email), 'rjbs@example.com', "we get the sender we expect", ); is_deeply( [ sort @{ Email::Sender::Util->_recipients_from_email($email) } ], [ sort qw(dude@example.com guy@example.com buddy@example.ca cc@cc.example.cc multiple@example.cc bcc@example.biz) ], "we get the rcpts we expect", ); util-fail.t100644000766000024 217112264314106 16027 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More tests => 14; use Email::Sender::Util; { package FakeSMTP; use Moo; has code => (is => 'rw'); has message => (is => 'rw'); no Moo; } sub smtp { FakeSMTP->new({ code => $_[0], message => $_[1] }); } my $i = 0; sub test_fail { my ($error, $smtp, $rest, $class, $message) = @_; $rest ||= {}; my $full_class = 'Email::Sender::Failure'; $full_class .= "::$class" if $class; $i++; my $fail = Email::Sender::Util->_failure($error, $smtp, %$rest); is(ref $fail, $full_class, "class of failure $i is $full_class"); is($fail->message, $message, "failure $i has the right message"); } test_fail('xyzzy', undef, {}, undef, 'xyzzy'); test_fail('xyzzy', smtp(100 => 'fail'), {}, undef, 'xyzzy: fail'); test_fail('xyzzy', smtp(400 => 'fail'), {}, 'Temporary', 'xyzzy: fail'); test_fail('xyzzy', smtp(500 => 'fail'), {}, 'Permanent', 'xyzzy: fail'); test_fail(undef, smtp(100 => 'fail'), {}, undef, 'fail'); test_fail(undef, smtp(400 => 'fail'), {}, 'Temporary', 'fail'); test_fail(undef, smtp(500 => 'fail'), {}, 'Permanent', 'fail'); util000755000766000024 012264314106 14325 5ustar00rjbsstaff000000000000Email-Sender-1.300010sendmail100755000766000024 101612264314106 16205 0ustar00rjbsstaff000000000000Email-Sender-1.300010/util#!perl use strict; use warnings; use File::Spec; use File::Temp; my $dir = $ENV{EMAIL_SENDER_TRANSPORT_SENDMAIL_TEST_LOGDIR} || File::Temp::tempdir( CLEANUP => 1 ); my $logfile = File::Spec->catfile($dir, 'sendmail.log'); my $input = join '', ; open my $fh, '>', $logfile or die "Cannot write to logfile $logfile: $!"; print $fh "CLI args: @ARGV\n"; if (defined $input && length $input) { print $fh "Executed with input on STDIN\n$input"; } else { print $fh "Executed with no input on STDIN\n"; } fail-multi.t100644000766000024 227712264314106 16213 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More tests => 5; use Email::Sender::Failure; use Email::Sender::Failure::Permanent; use Email::Sender::Failure::Temporary; use Email::Sender::Failure::Multi; my $fail = Email::Sender::Failure->new("generic"); my $perm = Email::Sender::Failure::Permanent->new("permanent"); my $temp = Email::Sender::Failure::Temporary->new("temporary"); my $multi_fail = Email::Sender::Failure::Multi->new({ message => 'multifail', failures => [ $fail ], }); isa_ok($multi_fail, 'Email::Sender::Failure', 'multi(Failure)'); ok(! $multi_fail->isa('Nothing::Is::This'), 'isa is not catholic'); my $multi_perm = Email::Sender::Failure::Multi->new({ message => 'multifail', failures => [ $perm ], }); isa_ok($multi_perm, 'Email::Sender::Failure::Permanent', 'multi(Failure::P)'); my $multi_temp = Email::Sender::Failure::Multi->new({ message => 'multifail', failures => [ $temp ], }); isa_ok($multi_temp, 'Email::Sender::Failure::Temporary', 'multi(Failure::T)'); my $multi_mixed = Email::Sender::Failure::Multi->new({ message => 'multifail', failures => [ $fail, $perm, $temp ], }); ok(! $multi_mixed->isa('Email::Sender::Failure::Temporary'), 'mixed <> temp'); executable100755000766000024 7112264314106 16472 0ustar00rjbsstaff000000000000Email-Sender-1.300010/util#!/usr/bin/perl my $input = join '', ; exit 0; pobox-rig.json100644000766000024 31312264314106 16531 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t[ "Test::Email::SMTPRig", { "smtp_host": "mx-all.pobox.com", "smtp_port": 25 }, [ { "from": null, "to" : null, "result_class": "Email::Sender::Success" } ] ] smtp-via-rig.t100644000766000024 433512264314106 16464 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More; my $env_str = $ENV{EMAIL_SENDER_SMTPRIGS} || $ENV{EMAIL_SENDER_SMTPRIGS}; plan skip_all => 'set EMAIL_SENDER_SMTPRIGS to run these tests' if ! $env_str; plan skip_all => 'JSON required to run these tests' unless eval { require JSON; 1 }; use lib 't/lib'; use Test::Email::Sender::Util; use Test::Email::SMTPRig; use Email::Sender::Transport::SMTP; my @rigs = split /\s+/, $env_str; my $tests_per_rig = 3; plan tests => $tests_per_rig * @rigs; my $stock_message = <<'END'; Subject: this message sent by perl module Test::Email::SMTPRig Message-Id: <%s@%s> From: "Test::Email::SMTPRig" To: "Test::Email::SMTPRig Server" This message body is unimportant. The message-id is included in the body to get a unique md5sum: <%s@%s> -- the perl email project END my $message_counter = 0; for my $rig_conf (@rigs) { my $lines = readfile($rig_conf); my $json = join '', @$lines; my $conf = JSON->new->decode($json); my ($class, $args) = @$conf; my $rig = $class->new($args); isa_ok($rig, 'Test::Email::SMTPRig'); my $sender = Email::Sender::Transport::SMTP->new({ host => $rig->smtp_host, port => $rig->smtp_port, ssl => $rig->smtp_ssl, helo => $rig->client_id, }); my $plan = {}; for my $test (@{ $plan->{tests} }) { # XXX: rigs need a way to provide their own messages -- rjbs, 2008-12-05 $message_counter++; my $message = sprintf $stock_message, $message_counter, $rig->client_id, $rig->client_id, $rig->client_id, $message_counter, $rig->client_id, ; my $result = eval { $sender->send($message, { to => $test->{to}, from => $test->{from} }); }; my $error = $@; Carp::croak("should never happen: false result, no exception") unless $result or $error; my $result_class = $result ? ref $result : ref $error; is($result_class, $test->{result_class}, 'got correct result class'); if ($rig->can('get_delivery_reports')) { my @reports = $rig->get_delivery_reports; ok(@reports, 'got delivery reports'); } else { SKIP: { skip('this rig does not support checking delivery status', 1); }; } } } simple-simple.t100644000766000024 322412264314106 16721 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More 'no_plan'; $ENV{EMAIL_SENDER_TRANSPORT} = 'Test'; use Email::Sender::Simple qw(sendmail); my $email = <<'.'; From: V To: II Subject: jolly good show Wot, wot! -- v . my $result = Email::Sender::Simple->send($email); isa_ok($result, 'Email::Sender::Success'); my $env_transport = Email::Sender::Simple->default_transport; my @deliveries = $env_transport->deliveries; is(@deliveries, 1, "we sent one message"); is_deeply( $deliveries[0]->{envelope}, { to => [ 'number.2@green.dome.il' ], from => 'number.5@gov.uk', }, "correct envelope deduced from message", ); { my $new_test = Email::Sender::Transport::Test->new; my $result = Email::Sender::Simple->send( $email, { to => 'devnull@example.com', transport => $new_test }, ); is( $env_transport->delivery_count, 2, "we ignore the passed transport when we're using transport-from-env", ); is_deeply( ($env_transport->deliveries)[1]->{envelope}, { to => [ 'devnull@example.com' ], from => 'number.5@gov.uk', }, "we stored the right message for the second delivery", ); } { my $email = Email::Simple->new("Subject: foo\n\nbar\n"); { my $result = eval { Email::Sender::Simple->send($email); }; isa_ok($@, 'Email::Sender::Failure', "we throw on failure, obj"); is($result, undef, "...meaning there is no return value"); } { my $result = eval { Email::Sender::Simple->try_to_send($email) }; ok(! $@, "no exception when we try_to_send and fail"); ok(! $result, "...but we do get a false value"); } } smtp-via-mock.t100644000766000024 1757712264314106 16670 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More; BEGIN { plan skip_all => 'Test::MockObject required to test SMTP transport by mocking' unless eval { require Test::MockObject }; plan skip_all => 'Sub::Override required to test SMTP transport by mocking' unless eval { require Sub::Override }; } use lib 't/lib'; use Test::Email::Sender::Util; my $mock_smtp; BEGIN { $mock_smtp = Test::MockObject->new; $mock_smtp->fake_module('Net::SMTP'); $mock_smtp->fake_new('Net::SMTP'); Test::Email::Sender::Util->perform_stock_mockery($mock_smtp); $mock_smtp->{pass}{username} = 'password'; $mock_smtp->{failaddr}{'tempfail@example.com'} = [ 401 => 'Temporary FOAD' ]; $mock_smtp->{failaddr}{'permfail@example.com'} = [ 552 => 'Permanent FOAD' ]; $mock_smtp->{failaddr}{'tempfail@example.net'} = [ 447 => 'Temporary STHU' ]; $mock_smtp->{failaddr}{'permfail@example.net'} = [ 519 => 'Permanent STHU' ]; } plan tests => 94; use Email::Sender::Transport::SMTP; use Email::Sender::Transport::SMTP::Persistent; for my $class (qw( Email::Sender::Transport::SMTP Email::Sender::Transport::SMTP::Persistent )) { our $sender = $class->new; our $message = join '', @{ readfile('t/messages/simple.msg') }; our $prefix = $class =~ /Persist/ ? 'pst' : 'std'; our $test = '(unknown test)'; my $ok = Test::Builder->can('ok'); my $override = Sub::Override->new( 'Test::Builder::ok' => sub { my ($self, $t, $name) = @_; $name = '(no desc)' unless defined $name; $name = "$prefix/$test: $name"; @_ = ($self, $t, $name); goto &$ok; } ); sub test_smtp { my ($env, $succ_cb, $fail_cb) = @_; my $ok = eval { $sender->send($message, $env); }; my $error = $@; $succ_cb ? $succ_cb->($ok) : ok(! $ok, "$test: we expected to fail"); $fail_cb ? $fail_cb->($error) : ok(! $error, "$test: we expected to succeed"); } { local $test = 'conn. fail'; my $no_smtp = Sub::Override->new('Net::SMTP::new' => sub { return }); test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure'); like("$_[0]", qr/unable to establish/, "we got a conn. fail"); }, ); } { local $test = 'simple okay'; test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, sub { isa_ok($_[0], 'Email::Sender::Success'); }, undef, ); } { local $test = 'no valid rcpts'; test_smtp( { from => 'okay@example.net', to => [ '', undef ], }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure'); like("$_[0]", qr{no valid address}, "got 0 valid addrs error"); }, ); } { local $test = 'tempfail RCPT'; test_smtp( { from => 'okay@example.net', to => 'tempfail@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure::Temporary'); is($_[0]->code, 401, 'got the right code in the exception'); }, ); } { local $test = 'mixed RCPT results'; test_smtp( { from => 'okay@example.net', to => [ 'tempfail@example.com', 'permfail@example.com', 'okay@example.com', ], }, undef, sub { my $fail = shift; isa_ok($fail, 'Email::Sender::Failure::Multi'); ok(! $fail->isa('Email::Sender::Failure::Permanent'), 'failure <> Perm'); ok(! $fail->isa('Email::Sender::Failure::Temporary'), 'failure <> Temp'); is($fail->code, undef, 'no specific code on multifail'); is_deeply( [ sort $fail->recipients ], [ qw(permfail@example.com tempfail@example.com) ], 'the two failers failed', ); my @failures = # sort { ($a->recipients)[0] cmp ($b->recipients)[0] } $fail->failures; is(@failures, 2, "we got two failures"); isa_ok($failures[0], 'Email::Sender::Failure::Temporary', '1st failure'); isa_ok($failures[1], 'Email::Sender::Failure::Permanent', '2nd failure'); }, ); } { local $test = 'multi tempfail RCPT'; test_smtp( { from => 'okay@example.net', to => [ 'tempfail@example.com', 'tempfail@example.net', ], }, undef, sub { my $fail = shift; isa_ok($fail, 'Email::Sender::Failure::Multi'); isa_ok($fail, 'Email::Sender::Failure::Temporary'); is_deeply( [ sort $fail->recipients ], [ qw(tempfail@example.com tempfail@example.net) ], 'all rcpts failed', ); }, ); } { local $test = 'partial succ'; local $sender = $class->new({ allow_partial_success => 1 }); test_smtp( { from => 'okay@example.net', to => [ 'tempfail@example.com', 'permfail@example.com', 'okay@example.com', ], }, sub { isa_ok($_[0], 'Email::Sender::Success::Partial'); }, undef, ); } { local $test = 'tempfail MAIL'; test_smtp( { from => 'tempfail@example.com', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure::Temporary'); }, ); } { local $test = 'permfail MAIL'; test_smtp( { from => 'permfail@example.com', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure::Permanent'); }, ); } { local $test = 'auth okay'; local $sender = $class->new({ sasl_username => 'username', sasl_password => 'password', }); test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, sub { isa_ok($_[0], 'Email::Sender::Success'); }, undef, ); } { local $test = 'auth badpw'; local $sender = $class->new({ sasl_username => 'username', sasl_password => 'failword', }); test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure'); }, ); } { local $test = 'auth unknown user'; local $sender = $class->new({ sasl_username => 'unknown', sasl_password => 'password', }); test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure'); }, ); } { local $test = 'auth nopw'; local $sender = $class->new({ sasl_username => 'username', }); test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure'); }, ); } { local $test = 'fail @ data start'; local $mock_smtp->{datafail} = 'data'; test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure'); like("$_[0]", qr{DATA start}, 'failed at correct phase'); }, ); } { local $test = 'fail during data'; local $mock_smtp->{datafail} = 'datasend'; test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure'); like("$_[0]", qr{during DATA}, 'failed at correct phase'); }, ); } { local $test = 'fail @ data end'; local $mock_smtp->{datafail} = 'dataend'; test_smtp( { from => 'okay@example.net', to => 'okay@example.com', }, undef, sub { isa_ok($_[0], 'Email::Sender::Failure'); like("$_[0]", qr{after DATA}, 'failed at correct phase'); }, ); } } sendmail.bat100644000766000024 165112264314106 16754 0ustar00rjbsstaff000000000000Email-Sender-1.300010/util@rem = '--*-Perl-*-- @echo off if "%OS%" == "Windows_NT" goto WinNT perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9 goto endofperl :WinNT perl -x -S %0 %* if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl if %errorlevel% == 9009 echo You do not have Perl in your PATH. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul goto endofperl @rem '; #!/usr/bin/perl #line 15 use strict; use warnings; use File::Spec; use File::Temp; my $dir = $ENV{EMAIL_SENDER_TRANSPORT_SENDMAIL_TEST_LOGDIR} || File::Temp::tempdir( CLEANUP => 1 ); my $logfile = File::Spec->catfile($dir, 'sendmail.log'); my $input = join '', ; open my $fh, '>', $logfile or die "Cannot write to logfile $logfile: $!"; print $fh "CLI args: @ARGV\n"; if (defined $input && length $input) { print $fh "Executed with input on STDIN\n$input"; } else { print $fh "Executed with no input on STDIN\n"; } __END__ :endofperl simple-wrapper.t100644000766000024 212312264314106 17105 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More; use lib 't/lib'; $ENV{EMAIL_SENDER_TRANSPORT} = 'Test::Email::Sender::Transport::FailEvery'; $ENV{EMAIL_SENDER_TRANSPORT_transport_class} = 'Test'; $ENV{EMAIL_SENDER_TRANSPORT_fail_every} = 2; use Email::Sender::Simple qw(sendmail); my $email = <<'.'; From: V To: II Subject: jolly good show Wot, wot! -- v . subtest "first send: works" => sub { my $result = Email::Sender::Simple->send($email); isa_ok($result, 'Email::Sender::Success'); my $env_transport = Email::Sender::Simple->default_transport; my @deliveries = $env_transport->transport->deliveries; is(@deliveries, 1, "we sent one message"); is_deeply( $deliveries[0]->{envelope}, { to => [ 'number.2@green.dome.il' ], from => 'number.5@gov.uk', }, "correct envelope deduced from message", ); }; subtest "second one: fails" => sub { my $ok = eval { Email::Sender::Simple->send($email); }; my $error = $@; ok( ! $ok, "it failed"); isa_ok($error, 'Email::Sender::Failure'); }; done_testing; Email000755000766000024 012264314106 15145 5ustar00rjbsstaff000000000000Email-Sender-1.300010/libSender.pm100644000766000024 414412264314106 17066 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Emailpackage Email::Sender; { $Email::Sender::VERSION = '1.300010'; } use Moo::Role; # ABSTRACT: a library for sending email requires 'send'; no Moo::Role; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender - a library for sending email =head1 VERSION version 1.300010 =head1 SYNOPSIS my $message = Email::MIME->create( ... ); # produce an Email::Abstract compatible message object, # e.g. produced by Email::Simple, Email::MIME, Email::Stuff use Email::Sender::Simple qw(sendmail); use Email::Sender::Transport::SMTP qw(); use Try::Tiny; try { sendmail( $message, { from => $SMTP_ENVELOPE_FROM_ADDRESS, transport => Email::Sender::Transport::SMTP->new({ host => $SMTP_HOSTNAME, port => $SMTP_PORT, }) } ); } catch { warn "sending failed: $_"; }; =head1 OVERVIEW Email::Sender replaces the old and sometimes problematic Email::Send library, which did a decent job at handling very simple email sending tasks, but was not suitable for serious use, for a variety of reasons. Most users will be able to use L to send mail. Users with more specific needs should look at the available Email::Sender::Transport classes. Documentation may be found in L, and new users should start with L. =head1 IMPLEMENTING Email::Sender itelf is a Moo role. Any class that implements Email::Sender is required to provide a method called C. This method should accept any input that can be understood by L, followed by a hashref containing C and C arguments to be used as the envelope. The method should return an L object on success or throw an L on failure. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut not-executable100644000766000024 1612264314106 17264 0ustar00rjbsstaff000000000000Email-Sender-1.300010/utilnot executabletrans-prep-email.t100644000766000024 210212264314106 17313 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t#!perl use strict; use warnings; use Test::More tests => 5; use Email::Abstract; use Email::Simple; use Email::Sender::Transport; my $email = <<'EOF'; To: Casey West From: Casey West Subject: This should never show up in my inbox blah blah blah EOF # SIMPLE my $simple = Email::Simple->new($email); my $prep_simple = Email::Sender::Transport->prepare_email($simple); is($prep_simple->as_string, $simple->as_string, 'simple - strings same'); # ABSTRACT my $abstract = Email::Abstract->new($email); my $prep_abstract = Email::Sender::Transport->prepare_email($abstract); is($prep_abstract->as_string, $abstract->as_string, 'abs - strings same'); ok($abstract == $prep_abstract, 'Email::Abstract object is not re-rewrapped'); # STRING my $prep_string = Email::Sender::Transport->prepare_email($email); is($prep_string->as_string, $email, 'string - strings same'); # STRING REF my $copy = $email; my $prep_string_ref = Email::Sender::Transport->prepare_email(\$copy); is($prep_string_ref->as_string, $email, 'stringref - strings same'); messages000755000766000024 012264314106 15422 5ustar00rjbsstaff000000000000Email-Sender-1.300010/tsimple.msg100644000766000024 22312264314106 17540 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t/messagesFrom: nobody@example.com To: somebody@example.net Subject: gorp Gorp is delicious and nutritious. Order some gorp today! -- the gorp syndicate release000755000766000024 012264314106 15423 5ustar00rjbsstaff000000000000Email-Sender-1.300010/xtpod-syntax.t100644000766000024 33212264314106 20034 0ustar00rjbsstaff000000000000Email-Sender-1.300010/xt/release#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Sender000755000766000024 012264314106 16365 5ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/EmailUtil.pm100644000766000024 434212264314106 20003 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Senderuse strict; use warnings; package Email::Sender::Util; { $Email::Sender::Util::VERSION = '1.300010'; } # ABSTRACT: random stuff that makes Email::Sender go use Email::Address; use Email::Sender::Failure; use Email::Sender::Failure::Permanent; use Email::Sender::Failure::Temporary; use List::MoreUtils (); use Module::Runtime qw(require_module); # This code will be used by Email::Sender::Simple. -- rjbs, 2008-12-04 sub _recipients_from_email { my ($self, $email) = @_; my @to = List::MoreUtils::uniq( map { $_->address } map { Email::Address->parse($_) } map { $email->get_header($_) } qw(to cc bcc)); return \@to; } sub _sender_from_email { my ($self, $email) = @_; my ($sender) = map { $_->address } map { Email::Address->parse($_) } scalar $email->get_header('from'); return $sender; } # It's probably reasonable to make this code publicker at some point, but for # now I don't want to deal with making a sane set of args. -- rjbs, 2008-12-09 sub _failure { my ($self, $error, $smtp, @rest) = @_; my $code = $smtp ? $smtp->code : undef; my $error_class = ! $code ? 'Email::Sender::Failure' : $code =~ /^4/ ? 'Email::Sender::Failure::Temporary' : $code =~ /^5/ ? 'Email::Sender::Failure::Permanent' : 'Email::Sender::Failure'; $error_class->new({ message => $smtp ? ($error ? ("$error: " . $smtp->message) : $smtp->message) : $error, code => $code, @rest, }); } sub _easy_transport { my ($self, $transport_class, $arg) = @_; if ($transport_class !~ tr/://) { $transport_class = "Email::Sender::Transport::$transport_class"; } require_module($transport_class); return $transport_class->new($arg); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Util - random stuff that makes Email::Sender go =head1 VERSION version 1.300010 =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Manual.pm100644000766000024 133112264314106 20276 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Senderuse strict; use warnings; package Email::Sender::Manual; { $Email::Sender::Manual::VERSION = '1.300010'; } # ABSTRACT: table of contents for the Email::Sender manual 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Manual - table of contents for the Email::Sender manual =head1 VERSION version 1.300010 =head1 THE MANUAL L tells you just what you need to know to start using Email::Sender. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Simple.pm100644000766000024 1037312264314106 20340 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Senderpackage Email::Sender::Simple; { $Email::Sender::Simple::VERSION = '1.300010'; } use Moo; with 'Email::Sender::Role::CommonSending'; # ABSTRACT: the simple interface for sending mail with Sender use Sub::Exporter::Util (); use Sub::Exporter -setup => { exports => { sendmail => Sub::Exporter::Util::curry_class('send'), try_to_sendmail => Sub::Exporter::Util::curry_class('try_to_send'), }, }; use Email::Address; use Email::Sender::Transport; use Email::Sender::Util; use Try::Tiny; { my $DEFAULT_TRANSPORT; my $DEFAULT_FROM_ENV; sub _default_was_from_env { my ($class) = @_; $class->default_transport; return $DEFAULT_FROM_ENV; } sub transport_from_env { my ($class, $env_base) = @_; $env_base ||= 'EMAIL_SENDER_TRANSPORT'; my $transport_class = $ENV{$env_base}; return unless defined $transport_class and length $transport_class; my %arg; for my $key (grep { /^\Q$env_base\E_[_0-9A-Za-z]+$/ } keys %ENV) { (my $new_key = $key) =~ s/^\Q$env_base\E_//; $arg{lc $new_key} = $ENV{$key}; } return Email::Sender::Util->_easy_transport($transport_class, \%arg); } sub default_transport { return $DEFAULT_TRANSPORT if $DEFAULT_TRANSPORT; my ($class) = @_; my $transport = $class->transport_from_env; if ($transport) { $DEFAULT_FROM_ENV = 1; $DEFAULT_TRANSPORT = $transport; } else { $DEFAULT_FROM_ENV = 0; $DEFAULT_TRANSPORT = $class->build_default_transport; } return $DEFAULT_TRANSPORT; } sub build_default_transport { require Email::Sender::Transport::Sendmail; my $transport = eval { Email::Sender::Transport::Sendmail->new }; return $transport if $transport; require Email::Sender::Transport::SMTP; Email::Sender::Transport::SMTP->new; } sub reset_default_transport { undef $DEFAULT_TRANSPORT; undef $DEFAULT_FROM_ENV; } } # Maybe this should be an around, but I'm just not excited about figuring out # order at the moment. It just has to work. -- rjbs, 2009-06-05 around prepare_envelope => sub { my ($orig, $class, $arg) = @_; $arg ||= {}; my $env = $class->$orig($arg); $env = { %$arg, %$env, }; return $env; }; sub send_email { my ($class, $email, $arg) = @_; my $transport = $class->default_transport; if ($arg->{transport}) { $arg = { %$arg }; # So we can delete transport without ill effects. $transport = delete $arg->{transport} unless $class->_default_was_from_env; } Carp::confess("transport $transport not safe for use with Email::Sender::Simple") unless $transport->is_simple; my ($to, $from) = $class->_get_to_from($email, $arg); Email::Sender::Failure::Permanent->throw("no recipients") if ! @$to; Email::Sender::Failure::Permanent->throw("no sender") if ! defined $from; return $transport->send( $email, { to => $to, from => $from, }, ); } sub try_to_send { my ($class, $email, $arg) = @_; try { return $class->send($email, $arg); } catch { my $error = $_ || 'unknown error'; return if try { $error->isa('Email::Sender::Failure') }; die $error; }; } sub _get_to_from { my ($class, $email, $arg) = @_; my $to = $arg->{to}; unless (@$to) { my @to_addrs = map { $_->address } grep { defined } map { Email::Address->parse($_) } map { $email->get_header($_) } qw(to cc); $to = \@to_addrs; } my $from = $arg->{from}; unless (defined $from) { ($from) = map { $_->address } grep { defined } map { Email::Address->parse($_) } map { $email->get_header($_) } qw(from); } return ($to, $from); } no Moo; "220 OK"; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Simple - the simple interface for sending mail with Sender =head1 VERSION version 1.300010 =head1 SEE INSTEAD For now, the best documentation of this class is in L. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut a-perl-minver.t100644000766000024 52312264314106 20406 0ustar00rjbsstaff000000000000Email-Sender-1.300010/xt/release#!perl use strict; use Test::More; plan skip_all => "this test only runs during release" unless $ENV{RELEASE_TESTING}; eval { require Test::MinimumVersion; Test::MinimumVersion->VERSION(0.003); Test::MinimumVersion->import; }; plan skip_all => "this test requires Test::MinimumVersion" if $@; all_minimum_version_ok(5.008001); Failure.pm100644000766000024 420212264314106 20450 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Senderpackage Email::Sender::Failure; { $Email::Sender::Failure::VERSION = '1.300010'; } use Moo; use MooX::Types::MooseLike::Base qw(ArrayRef); use Carp (); extends 'Throwable::Error'; # ABSTRACT: a report of failure from an email sending transport has code => ( is => 'ro', ); has recipients => ( isa => ArrayRef, default => sub { [] }, writer => '_set_recipients', reader => '__get_recipients', is => 'rw', accessor => undef, ); sub __recipients { @{$_[0]->__get_recipients} } sub recipients { my ($self) = @_; return $self->__recipients if wantarray; return if ! defined wantarray; Carp::carp("recipients in scalar context is deprecated and WILL BE REMOVED"); return $self->__get_recipients; } sub BUILD { my ($self) = @_; Carp::confess("message must contain non-space characters") unless $self->message =~ /\S/; } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Failure - a report of failure from an email sending transport =head1 VERSION version 1.300010 =head1 ATTRIBUTES =head2 message This method returns the failure message, which should describe the failure. Failures stringify to this message. =head2 code This returns the numeric code of the failure, if any. This is mostly useful for network protocol transports like SMTP. This may be undefined. =head2 recipients This returns a list of addresses to which the email could not be sent. =head1 METHODS =head2 throw This method can be used to instantiate and throw an Email::Sender::Failure object at once. Email::Sender::Failure->throw(\%arg); Instead of a hashref of args, you can pass a single string argument which will be used as the C of the new failure. =head1 SEE ALSO =over =item * L =item * L =item * L =back =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Success.pm100644000766000024 136412264314106 20477 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Senderpackage Email::Sender::Success; { $Email::Sender::Success::VERSION = '1.300010'; } use Moo; # ABSTRACT: the result of successfully sending mail no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Success - the result of successfully sending mail =head1 VERSION version 1.300010 =head1 DESCRIPTION An Email::Sender::Success object is just an indicator that an email message was successfully sent. Unless extended, it has no properties of its own. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Email000755000766000024 012264314106 16327 5ustar00rjbsstaff000000000000Email-Sender-1.300010/t/lib/TestSMTPRig.pm100644000766000024 311012264314106 20245 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t/lib/Test/Emailpackage Test::Email::SMTPRig; use Moo; use MooX::Types::MooseLike::Base qw(HashRef Int); has 'smtp_host' => (is => 'ro', required => 1); has 'smtp_ssl' => (is => 'ro', default => sub { 0 }); has 'smtp_port' => ( is => 'ro', isa => Int, lazy => 1, default => sub { return $_[0]->ssl ? 465 : 25; }, ); has '_client_id' => (is => 'rw', init_arg => undef); sub client_id { $_[0]->_client_id } before register_client => sub { my ($self) = @_; if (my $id = $self->client_id) { Carp::confess("can't register client, already registered with id <$id>") } }; sub register_client { my ($self) = @_; $self->_client_id(sprintf('smtprig-%s-%s.%s', $^T, $$, $self->smtp_host)); return $self->_client_id; } sub BUILD { my ($self) = @_; $self->register_client; } # sample plan: # { # senders => { # 'abc@example.org' => [ 557 => 'not welcome here' ], # }, # recipients => { # 'rjbs@example.org' => [ 250 => 'awesometown' ], # 'hdp@example.org' => [ 450 => 'not now dear' ], # 'doneill@example.org' => [ 550 => 'go away' ], # }, # # deliveries => [ # { # message => [ moniker => \%args ], # optional, default msg # to => [ 'abc@example.org' ], # required # from => 'def@example.org', # required # data => [ 250 => 'queued' ], # optional, assume ok # result => { # class => 'Email::Sender::Success', # required # # extra stuff about result here; failures, messages, etc # }, # }, # ], # } has 'plan' => ( is => 'ro', isa => HashRef, required => 1, ); no Moo; 1; 000-report-versions-tiny.t100644000766000024 662712264314106 20612 0ustar00rjbsstaff000000000000Email-Sender-1.300010/tuse strict; use warnings; use Test::More 0.88; # This is a relatively nice way to avoid Test::NoWarnings breaking our # expectations by adding extra tests, without using no_plan. It also helps # avoid any other test module that feels introducing random tests, or even # test plans, is a nice idea. our $success = 0; END { $success && done_testing; } # List our own version used to generate this my $v = "\nGenerated by Dist::Zilla::Plugin::ReportVersions::Tiny v1.10\n"; eval { # no excuses! # report our Perl details my $want = "any version"; $v .= "perl: $] (wanted $want) on $^O from $^X\n\n"; }; defined($@) and diag("$@"); # Now, our module version dependencies: sub pmver { my ($module, $wanted) = @_; $wanted = " (want $wanted)"; my $pmver; eval "require $module;"; if ($@) { if ($@ =~ m/Can't locate .* in \@INC/) { $pmver = 'module not found.'; } else { diag("${module}: $@"); $pmver = 'died during require.'; } } else { my $version; eval { $version = $module->VERSION; }; if ($@) { diag("${module}: $@"); $pmver = 'died during VERSION check.'; } elsif (defined $version) { $pmver = "$version"; } else { $pmver = ''; } } # So, we should be good, right? return sprintf('%-45s => %-10s%-15s%s', $module, $pmver, $wanted, "\n"); } eval { $v .= pmver('Capture::Tiny','0.08') }; eval { $v .= pmver('Carp','any version') }; eval { $v .= pmver('Cwd','any version') }; eval { $v .= pmver('Email::Abstract','3.006') }; eval { $v .= pmver('Email::Address','any version') }; eval { $v .= pmver('Email::Simple','1.998') }; eval { $v .= pmver('Exporter','any version') }; eval { $v .= pmver('ExtUtils::MakeMaker','6.30') }; eval { $v .= pmver('Fcntl','any version') }; eval { $v .= pmver('File::Basename','any version') }; eval { $v .= pmver('File::Path','any version') }; eval { $v .= pmver('File::Spec','any version') }; eval { $v .= pmver('File::Temp','any version') }; eval { $v .= pmver('IO::File','any version') }; eval { $v .= pmver('IO::Handle','any version') }; eval { $v .= pmver('List::MoreUtils','any version') }; eval { $v .= pmver('Module::Runtime','any version') }; eval { $v .= pmver('Moo','1.000008') }; eval { $v .= pmver('Moo::Role','any version') }; eval { $v .= pmver('MooX::Types::MooseLike','0.15') }; eval { $v .= pmver('MooX::Types::MooseLike::Base','any version') }; eval { $v .= pmver('Net::SMTP','any version') }; eval { $v .= pmver('Scalar::Util','any version') }; eval { $v .= pmver('Sub::Exporter','any version') }; eval { $v .= pmver('Sub::Exporter::Util','any version') }; eval { $v .= pmver('Sys::Hostname','any version') }; eval { $v .= pmver('Test::More','0.96') }; eval { $v .= pmver('Throwable::Error','0.200003') }; eval { $v .= pmver('Try::Tiny','any version') }; eval { $v .= pmver('lib','any version') }; eval { $v .= pmver('strict','any version') }; eval { $v .= pmver('warnings','any version') }; # All done. $v .= <<'EOT'; Thanks for using my code. I hope it works for you. If not, please try and include this output in the bug report. That will help me reproduce the issue and solve your problem. EOT diag($v); ok(1, "we really didn't test anything, just reporting data"); $success = 1; # Work around another nasty module on CPAN. :/ no warnings 'once'; $Template::Test::NO_FLUSH = 1; exit 0; Transport.pm100644000766000024 337012264314106 21062 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Senderpackage Email::Sender::Transport; { $Email::Sender::Transport::VERSION = '1.300010'; } use Moo::Role; # ABSTRACT: a role for email transports with 'Email::Sender::Role::CommonSending'; sub is_simple { my ($self) = @_; return if $self->allow_partial_success; return 1; } sub allow_partial_success { 0 } no Moo::Role; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport - a role for email transports =head1 VERSION version 1.300010 =head1 DESCRIPTION Email::Sender::Transport is a Moo role to aid in writing classes used to send mail. For the most part, its behavior comes entirely from the role L, which it includes. The important difference is that Transports are often intended to be used by L, and they provide two methods related to that purpose. =for Pod::Coverage is_simple allow_partial_success First, they provide an C method which returns true or false to indicate whether the transport will ever signal partial success. Second, they provide an C method, which returns true if the transport is suitable for use with Email::Sender::Simple. By default, this method returns the inverse of C. It is B that these methods be accurate to prevent Email::Sender::Simple users from sending partially successful transmissions. Partial success is a complex case that almost all users will wish to avoid at all times. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Sender000755000766000024 012264314106 17547 5ustar00rjbsstaff000000000000Email-Sender-1.300010/t/lib/Test/EmailUtil.pm100644000766000024 325612264314106 21170 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t/lib/Test/Email/Senderuse strict; use warnings; package Test::Email::Sender::Util; use Exporter; BEGIN { our @ISA = qw(Exporter) } our @EXPORT = qw(readfile); sub readfile { my ($name) = @_; open my $msg_file, "<$name" or die "coudn't read $name: $!"; my @lines = <$msg_file>; close $msg_file; return \@lines; } sub perform_stock_mockery { my ($self, $mock_smtp) = @_; for (qw(code message)) { $mock_smtp->set_bound($_ => \($mock_smtp->{$_})); } $mock_smtp->mock(fail => sub { my ($self, $code, $msg) = @_; $self->{code} = $code; $self->{message} = $msg; return; }); $mock_smtp->mock(succ => sub { my ($self, $code, $msg) = @_; $self->{code} = $code || 200; $self->{message} = $msg || 'Ok'; return 1; }); $mock_smtp->mock(ok => sub { my $code = shift->code; return 0 < $code && $code < 400; }); $mock_smtp->mock(reset => sub { $_[0]->succ }); $mock_smtp->mock(quit => sub { $_[0]->succ }); $mock_smtp->mock(auth => sub { my ($self, $user, $pass) = @_; return $self->fail(400 => 'fail') unless $self->{pass}{$user}; return $self->succ if $self->{pass}{$user} eq $pass; return $self->fail(400 => 'fail'); }); for my $method (qw(mail to)) { $mock_smtp->mock($method => sub { my ($self, $addr) = @_; if (my $fail = $self->{failaddr}{$addr}) { return $self->fail(@$fail); } return $self->succ; }); } $mock_smtp->{datafail} = ''; for my $part (qw(data datasend dataend)) { $mock_smtp->mock($part => sub { # main::diag(">> $_[1] <<") if $part eq 'datasend'; return $_[0]->fail(300 => 'NFI') if $_[0]->{datafail} eq $part; return $_[0]->succ; }); } } 1; changes_has_content.t100644000766000024 201412264314106 21742 0ustar00rjbsstaff000000000000Email-Sender-1.300010/xt/release#!perl use Test::More tests => 2; note 'Checking Changes'; my $changes_file = 'Changes'; my $newver = '1.300010'; my $trial_token = '-TRIAL'; SKIP: { ok(-e $changes_file, "$changes_file file exists") or skip 'Changes is missing', 1; ok(_get_changes($newver), "$changes_file has content for $newver"); } done_testing; # _get_changes copied and adapted from Dist::Zilla::Plugin::Git::Commit # by Jerome Quelin sub _get_changes { my $newver = shift; # parse changelog to find commit message open(my $fh, '<', $changes_file) or die "cannot open $changes_file: $!"; my $changelog = join('', <$fh>); close $fh; my @content = grep { /^$newver(?:$trial_token)?(?:\s+|$)/ ... /^\S/ } # from newver to un-indented split /\n/, $changelog; shift @content; # drop the version line # drop unindented last line and trailing blank lines pop @content while ( @content && $content[-1] =~ /^(?:\S|\s*$)/ ); # return number of non-blank lines return scalar @content; } Failure000755000766000024 012264314106 17754 5ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/SenderMulti.pm100644000766000024 404412264314106 21546 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Failurepackage Email::Sender::Failure::Multi; { $Email::Sender::Failure::Multi::VERSION = '1.300010'; } use Moo; use MooX::Types::MooseLike::Base qw(ArrayRef); extends 'Email::Sender::Failure'; # ABSTRACT: an aggregate of multiple failures has failures => ( is => 'ro', isa => ArrayRef, required => 1, reader => '__get_failures', ); sub __failures { @{$_[0]->__get_failures} } sub failures { my ($self) = @_; return $self->__failures if wantarray; return if ! defined wantarray; Carp::carp("failures in scalar context is deprecated and WILL BE REMOVED"); return $self->__get_failures; } sub recipients { my ($self) = @_; my @rcpts = map { $_->recipients } $self->failures; return @rcpts if wantarray; return if ! defined wantarray; Carp::carp("recipients in scalar context is deprecated and WILL BE REMOVED"); return \@rcpts; } sub isa { my ($self, $class) = @_; if ( $class eq 'Email::Sender::Failure::Permanent' or $class eq 'Email::Sender::Failure::Temporary' ) { my @failures = $self->failures; return 1 if @failures == grep { $_->isa($class) } @failures; } return $self->SUPER::isa($class); } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Failure::Multi - an aggregate of multiple failures =head1 VERSION version 1.300010 =head1 DESCRIPTION A multiple failure report is raised when more than one failure is encountered when sending a single message, or when mixed states were encountered. =head1 ATTRIBUTES =head2 failures This method returns a list of other Email::Sender::Failure objects represented by this multi. =head1 METHODS =head2 isa A multiple failure will report that it is a Permanent or Temporary if all of its contained failures are failures of that type. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Transport000755000766000024 012264314106 20361 5ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/SenderMbox.pm100644000766000024 605512264314106 21772 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::Mbox; { $Email::Sender::Transport::Mbox::VERSION = '1.300010'; } use Moo; with 'Email::Sender::Transport'; # ABSTRACT: deliver mail to an mbox on disk use Carp; use File::Path; use File::Basename; use IO::File; use Email::Simple 1.998; # needed for ->header_obj use Fcntl ':flock'; has 'filename' => (is => 'ro', default => sub { 'mbox' }, required => 1); sub send_email { my ($self, $email, $env) = @_; my $filename = $self->filename; my $fh = $self->_open_fh($filename); my $ok = eval { if ($fh->tell > 0) { $fh->print("\n") or Carp::confess("couldn't write to $filename: $!"); } $fh->print($self->_from_line($email, $env)) or Carp::confess("couldn't write to $filename: $!"); $fh->print($self->_escape_from_body($email)) or Carp::confess("couldn't write to $filename: $!"); # This will make streaming a bit more annoying. -- rjbs, 2007-05-25 $fh->print("\n") or Carp::confess("couldn't write to $filename: $!") unless $email->as_string =~ /\n$/; $self->_close_fh($fh) or Carp::confess "couldn't close file $filename: $!"; 1; }; die unless $ok; # Email::Sender::Failure->throw($@ || 'unknown error') unless $ok; return $self->success; } sub _open_fh { my ($class, $file) = @_; my $dir = dirname($file); Carp::confess "couldn't make path $dir: $!" if not -d $dir or mkpath($dir); my $fh = IO::File->new($file, '>>') or Carp::confess "couldn't open $file for appending: $!"; $fh->binmode(':raw'); $class->_getlock($fh, $file); $fh->seek(0, 2); return $fh; } sub _close_fh { my ($class, $fh, $file) = @_; $class->_unlock($fh); return $fh->close; } sub _escape_from_body { my ($class, $email) = @_; my $body = $email->get_body; $body =~ s/^(From )/>$1/gm; my $simple = $email->cast('Email::Simple'); return $simple->header_obj->as_string . $simple->crlf . $body; } sub _from_line { my ($class, $email, $envelope) = @_; my $fromtime = localtime; $fromtime =~ s/(:\d\d) \S+ (\d{4})$/$1 $2/; # strip timezone. return "From $envelope->{from} $fromtime\n"; } sub _getlock { my ($class, $fh, $fn) = @_; for (1 .. 10) { return 1 if flock($fh, LOCK_EX | LOCK_NB); sleep $_; } Carp::confess "couldn't lock file $fn"; } sub _unlock { my ($class, $fh) = @_; flock($fh, LOCK_UN); } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::Mbox - deliver mail to an mbox on disk =head1 VERSION version 1.300010 =head1 DESCRIPTION This transport delivers into an mbox. The mbox file may be given by the F argument to the constructor, and defaults to F. The transport I assumes that the mbox is in F format, but this may change or be configurable in the future. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SMTP.pm100644000766000024 1645612264314106 21676 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::SMTP; { $Email::Sender::Transport::SMTP::VERSION = '1.300010'; } use Moo; use MooX::Types::MooseLike::Base qw(Bool Int Str); # ABSTRACT: send email over SMTP use Email::Sender::Failure::Multi; use Email::Sender::Success::Partial; use Email::Sender::Role::HasMessage (); use Email::Sender::Util; has host => (is => 'ro', isa => Str, default => sub { 'localhost' }); has ssl => (is => 'ro', isa => Bool, default => sub { 0 }); has port => ( is => 'ro', isa => Int, lazy => 1, default => sub { return $_[0]->ssl ? 465 : 25; }, ); has timeout => (is => 'ro', isa => Int, default => sub { 120 }); has sasl_username => (is => 'ro', isa => Str); has sasl_password => (is => 'ro', isa => Str); has allow_partial_success => (is => 'ro', isa => Bool, default => sub { 0 }); has helo => (is => 'ro', isa => Str); has localaddr => (is => 'ro'); has localport => (is => 'ro', isa => Int); has debug => (is => 'ro', isa => Bool, default => sub { 0 }); # I am basically -sure- that this is wrong, but sending hundreds of millions of # messages has shown that it is right enough. I will try to make it textbook # later. -- rjbs, 2008-12-05 sub _quoteaddr { my $addr = shift; my @localparts = split /\@/, $addr; my $domain = pop @localparts; my $localpart = join q{@}, @localparts; # this is probably a little too paranoid return $addr unless $localpart =~ /[^\w.+-]/ or $localpart =~ /^\./; return join q{@}, qq("$localpart"), $domain; } sub _smtp_client { my ($self) = @_; my $class = "Net::SMTP"; if ($self->ssl) { require Net::SMTP::SSL; $class = "Net::SMTP::SSL"; } else { require Net::SMTP; } my $smtp = $class->new( $self->_net_smtp_args ); $self->_throw("unable to establish SMTP connection") unless $smtp; if ($self->sasl_username) { $self->_throw("sasl_username but no sasl_password") unless defined $self->sasl_password; unless ($smtp->auth($self->sasl_username, $self->sasl_password)) { if ($smtp->message =~ /MIME::Base64|Authen::SASL/) { Carp::confess("SMTP auth requires MIME::Base64 and Authen::SASL"); } $self->_throw('failed AUTH', $smtp); } } return $smtp; } sub _net_smtp_args { my ($self) = @_; return ( $self->host, Port => $self->port, Timeout => $self->timeout, Debug => $self->debug, defined $self->helo ? (Hello => $self->helo) : (), defined $self->localaddr ? (LocalAddr => $self->localaddr) : (), defined $self->localport ? (LocalPort => $self->localport) : (), ); } sub _throw { my ($self, @rest) = @_; Email::Sender::Util->_failure(@rest)->throw; } sub send_email { my ($self, $email, $env) = @_; Email::Sender::Failure->throw("no valid addresses in recipient list") unless my @to = grep { defined and length } @{ $env->{to} }; my $smtp = $self->_smtp_client; my $FAULT = sub { $self->_throw($_[0], $smtp); }; $smtp->mail(_quoteaddr($env->{from})) or $FAULT->("$env->{from} failed after MAIL FROM:"); my @failures; my @ok_rcpts; for my $addr (@to) { if ($smtp->to(_quoteaddr($addr))) { push @ok_rcpts, $addr; } else { # my ($self, $error, $smtp, $error_class, @rest) = @_; push @failures, Email::Sender::Util->_failure( undef, $smtp, recipients => [ $addr ], ); } } # This logic used to include: or (@ok_rcpts == 1 and $ok_rcpts[0] eq '0') # because if called without SkipBad, $smtp->to can return 1 or 0. This # should not happen because we now always pass SkipBad and do the counting # ourselves. Still, I've put this comment here (a) in memory of the # suffering it caused to have to find that problem and (b) in case the # original problem is more insidious than I thought! -- rjbs, 2008-12-05 if ( @failures and ((@ok_rcpts == 0) or (! $self->allow_partial_success)) ) { $failures[0]->throw if @failures == 1; my $message = sprintf '%s recipients were rejected during RCPT', @ok_rcpts ? 'some' : 'all'; Email::Sender::Failure::Multi->throw( message => $message, failures => \@failures, ); } # restore Pobox's support for streaming, code-based messages, and arrays here # -- rjbs, 2008-12-04 $smtp->data or $FAULT->("error at DATA start"); my $msg_string = $email->as_string; my $hunk_size = $self->_hunk_size; while (length $msg_string) { my $next_hunk = substr $msg_string, 0, $hunk_size, ''; $smtp->datasend($next_hunk) or $FAULT->("error at during DATA"); } $smtp->dataend or $FAULT->("error at after DATA"); my $message = $smtp->message; $self->_message_complete($smtp); # We must report partial success (failures) if applicable. return $self->success({ message => $message }) unless @failures; return $self->partial_success({ message => $message, failure => Email::Sender::Failure::Multi->new({ message => 'some recipients were rejected during RCPT', failures => \@failures }), }); } sub _hunk_size { 2**20 } # send messages to DATA in hunks of 1 mebibyte sub success { my $self = shift; my $success = Moo::Role->create_class_with_roles('Email::Sender::Success', 'Email::Sender::Role::HasMessage')->new(@_); } sub partial_success { my $self = shift; my $partial_success = Moo::Role->create_class_with_roles('Email::Sender::Success::Partial', 'Email::Sender::Role::HasMessage')->new(@_); } sub _message_complete { $_[1]->quit; } with 'Email::Sender::Transport'; no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::SMTP - send email over SMTP =head1 VERSION version 1.300010 =head1 DESCRIPTION This transport is used to send email over SMTP, either with or without secure sockets (SSL). It is one of the most complex transports available, capable of partial success. For a potentially more efficient version of this transport, see L. =head1 ATTRIBUTES The following attributes may be passed to the constructor: =over 4 =item C: the name of the host to connect to; defaults to C =item C: if true, connect via SSL; defaults to false =item C: port to connect to; defaults to 25 for non-SSL, 465 for SSL =item C: maximum time in secs to wait for server; default is 120 =item C: the username to use for auth; optional =item C: the password to use for auth; required if C is provided =item C: if true, will send data even if some recipients were rejected; defaults to false =item C: what to say when saying HELO; no default =item C: local address from which to connect =item C: local port from which to connect =item C: if true, put the L object in debug mode =back =head1 PARTIAL SUCCESS If C was set when creating the transport, the transport may return L objects. Consult that module's documentation. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Test.pm100644000766000024 751712264314106 22010 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::Test; { $Email::Sender::Transport::Test::VERSION = '1.300010'; } use Moo; use MooX::Types::MooseLike::Base qw(ArrayRef Bool); # ABSTRACT: deliver mail in memory for testing use Email::Sender::Failure::Multi; use Email::Sender::Success::Partial; has allow_partial_success => (is => 'ro', isa => Bool, default => sub { 0 }); sub recipient_failure { } sub delivery_failure { } has deliveries => ( isa => ArrayRef, init_arg => undef, default => sub { [] }, is => 'ro', reader => '_deliveries', ); sub delivery_count { scalar @{ $_[0]->_deliveries } } sub record_delivery { push @{ shift->_deliveries }, @_ } sub deliveries { @{ $_[0]->_deliveries } } sub shift_deliveries { shift @{ $_[0]->_deliveries } } sub clear_deliveries { @{ $_[0]->_deliveries } = () } sub send_email { my ($self, $email, $envelope) = @_; my @failures; my @ok_rcpts; if (my $failure = $self->delivery_failure($email, $envelope)) { $failure->throw; } for my $to (@{ $envelope->{to} }) { if (my $failure = $self->recipient_failure($to)) { push @failures, $failure; } else { push @ok_rcpts, $to; } } if ( @failures and ((@ok_rcpts == 0) or (! $self->allow_partial_success)) ) { $failures[0]->throw if @failures == 1 and @ok_rcpts == 0; my $message = sprintf '%s recipients were rejected', @ok_rcpts ? 'some' : 'all'; Email::Sender::Failure::Multi->throw( message => $message, failures => \@failures, ); } $self->record_delivery({ email => $email, envelope => $envelope, successes => \@ok_rcpts, failures => \@failures, }); # XXX: We must report partial success (failures) if applicable. return $self->success unless @failures; return Email::Sender::Success::Partial->new({ failure => Email::Sender::Failure::Multi->new({ message => 'some recipients were rejected', failures => \@failures }), }); } with 'Email::Sender::Transport'; no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::Test - deliver mail in memory for testing =head1 VERSION version 1.300010 =head1 DESCRIPTION This transport is meant for testing email deliveries in memory. It will store a record of any delivery made so that they can be inspected afterward. =head1 ATTRIBUTES =head2 deliveries =for Pod::Coverage recipient_failure delivery_failure By default, the Test transport will not allow partial success and will always succeed. It can be made to fail predictably, however, if it is extended and its C or C methods are overridden. These methods are called as follows: $self->delivery_failure($email, $envelope); $self->recipient_failure($to); If they return true, the sending will fail. If the transport was created with a true C attribute, recipient failures can cause partial success to be returned. For more flexible failure modes, you can override more aggressively or can use L. =for Pod::Coverage clear_deliveries This attribute stores an arrayref of all the deliveries made via the transport. Each delivery is a hashref, in the following format: { email => $email, envelope => $envelope, successes => \@ok_rcpts, failures => \@failures, } Both successful and failed deliveries are stored. A number of methods related to this attribute are provided: =over 4 =item * delivery_count =item * clear_deliveries =item * shift_deliveries =back =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Role000755000766000024 012264314106 17266 5ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/SenderHasMessage.pm100644000766000024 135712264314106 22012 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Rolepackage Email::Sender::Role::HasMessage; { $Email::Sender::Role::HasMessage::VERSION = '1.300010'; } use Moo::Role; # ABSTRACT: an object that has a message has message => ( is => 'ro', required => 1, ); no Moo::Role; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Role::HasMessage - an object that has a message =head1 VERSION version 1.300010 =head1 ATTRIBUTES =head2 message This attribute is a message associated with the object. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Success000755000766000024 012264314106 17775 5ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/SenderPartial.pm100644000766000024 210712264314106 22067 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Successpackage Email::Sender::Success::Partial; { $Email::Sender::Success::Partial::VERSION = '1.300010'; } use Moo; extends 'Email::Sender::Success'; use MooX::Types::MooseLike::Base qw(InstanceOf); # ABSTRACT: a report of partial success when delivering use Email::Sender::Failure::Multi; has failure => ( is => 'ro', isa => InstanceOf['Email::Sender::Failure::Multi'], required => 1, ); no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Success::Partial - a report of partial success when delivering =head1 VERSION version 1.300010 =head1 DESCRIPTION These objects indicate that some deliver was accepted for some recipients and not others. The success object's C attribute will return a L describing which parts of the delivery failed. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Print.pm100644000766000024 267712264314106 22167 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::Print; { $Email::Sender::Transport::Print::VERSION = '1.300010'; } use Moo; with 'Email::Sender::Transport'; # ABSTRACT: print email to a filehandle (like stdout) use IO::Handle; use MooX::Types::MooseLike::Base qw(InstanceOf); has 'fh' => ( is => 'ro', isa => InstanceOf['IO::Handle'], required => 1, default => sub { IO::Handle->new_from_fd(fileno(STDOUT), 'w') }, ); sub send_email { my ($self, $email, $env) = @_; my $fh = $self->fh; $fh->printf("ENVELOPE TO : %s\n", join(q{, }, @{ $env->{to} }) || '-'); $fh->printf("ENVELOPE FROM: %s\n", defined $env->{from} ? $env->{from} : '-'); $fh->print(q{-} x 10 . " begin message\n"); $fh->print( $email->as_string ); $fh->print(q{-} x 10 . " end message\n"); return $self->success; } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::Print - print email to a filehandle (like stdout) =head1 VERSION version 1.300010 =head1 DESCRIPTION When this transport is handed mail, it prints it to a filehandle. By default, it will print to STDOUT, but it can be given any L object to print to as its C attribute. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Permanent.pm100644000766000024 115712264314106 22407 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Failurepackage Email::Sender::Failure::Permanent; { $Email::Sender::Failure::Permanent::VERSION = '1.300010'; } use Moo; extends 'Email::Sender::Failure'; # ABSTRACT: a permanent delivery failure no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Failure::Permanent - a permanent delivery failure =head1 VERSION version 1.300010 =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Temporary.pm100644000766000024 115712264314106 22440 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Failurepackage Email::Sender::Failure::Temporary; { $Email::Sender::Failure::Temporary::VERSION = '1.300010'; } use Moo; extends 'Email::Sender::Failure'; # ABSTRACT: a temporary delivery failure no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Failure::Temporary - a temporary delivery failure =head1 VERSION version 1.300010 =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Manual000755000766000024 012264314106 17602 5ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/SenderQuickStart.pm100644000766000024 2566512264314106 22430 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Manualuse strict; use warnings; package Email::Sender::Manual::QuickStart; { $Email::Sender::Manual::QuickStart::VERSION = '1.300010'; } # ABSTRACT: how to start using Email::Sender right now 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Manual::QuickStart - how to start using Email::Sender right now =head1 VERSION version 1.300010 =head1 QUICK START =head2 Let's Send Some Mail! No messing around, let's just send some mail. use strict; use Email::Sender::Simple qw(sendmail); use Email::Simple; use Email::Simple::Creator; my $email = Email::Simple->create( header => [ To => '"Xavier Q. Ample" ', From => '"Bob Fishman" ', Subject => "don't forget to *enjoy the sauce*", ], body => "This message is short, but at least it's cheap.\n", ); sendmail($email); That's it. Your message goes out into the internet and tries to get delivered to C. In the example above, C<$email> could be an Email::Simple object, a MIME::Entity, a string containing an email message, or one of several other types of input. If C can understand a value, it can be passed to Email::Sender::Simple. Email::Sender::Simple tries to make a good guess about how to send the message. It will usually try to use the F program on unix-like systems and to use SMTP on Windows. You can specify a transport, if you need to, but normally that shouldn't be an issue. (See L, though, for more information.) Also note that we imported and used a C routine in the example above. This is exactly the same as saying: Email::Sender::Simple->send($email); ...but it's a lot easier to type. You can use either one. =head3 envelope information We didn't have to tell Email::Sender::Simple where to send the message. If you don't specify recipients, it will use all the email addresses it can find in the F and F headers by default. It will use L to parse those fields. Similarly, if no sender is specified, it will use the first address found in the F header. In most email transmission systems, though, the headers are not by necessity tied to the addresses used as the sender and recipients. For example, your message header might say "From: mailing-list@example.com" while your SMTP client says "MAIL FROM:Everp-1234@lists.example.comE". This is a powerful feature, and is necessary for many email application. Being able to set those distinctly is important, and Email::Sender::Simple lets you do this: sendmail($email, { to => [ $to_1, $to_2 ], from => $sender }); =head3 in case of error When the message is sent successfully (at least on to its next hop), C will return a true value -- specifically, an L object. This object only rarely has much use. What's more useful is what happens if the message can't be sent. If there is an error sending the message, an exception will be thrown. It will be an object belonging to the class L. This object will have a C attribute describing the nature of the failure. There are several specialized forms of failure, like L, which is thrown when more than one error is encountered when trying to send. You don't need to know about these to use Email::Sender::Simple, though. All you need to know is that C returns true on success and dies on failure. If you'd rather not have to catch exceptions for failure to send mail, you can use the C method, which can be imported as C. This method will return just false on failure to send mail. For example: Email::Sender::Simple->try_to_send($email, { ... }); use Email::Sender::Simple qw(try_to_sendmail); try_to_sendmail($email, { ... }); Some Email::Sender transports can signal success if some, but not all, recipients could be reached. Email::Sender::Simple does its best to ensure that this never happens. When you are using Email::Sender::Simple, mail should either be sent or not. Partial success should never occur. =head2 Picking a Transport =head3 passing in your own transport If Email::Sender::Simple doesn't pick the transport you want, or if you have more specific needs, you can specify a transport in several ways. The simplest is to build a transport object and pass it in. You can read more about transports elsewhere. For now, we'll just assume that you need to send mail via SMTP on an unusual port. You can send mail like this: my $transport = Email::Sender::Transport::SMTP->new({ host => 'smtp.example.com', port => 2525, }); sendmail($email, { transport => $transport }); Now, instead of guessing at what transport to use, Email::Sender::Simple will use the one you provided. This transport will have to be specified for each call to C, so you might want to look at other options, which follow. =head3 specifying transport in the environment If you have a program that makes several calls to Email::Sender::Simple, and you need to run this program using a different mailserver, you can set environment variables to change the default. For example: $ export EMAIL_SENDER_TRANSPORT=SMTP $ export EMAIL_SENDER_TRANSPORT_host=smtp.example.com $ export EMAIL_SENDER_TRANSPORT_port=2525 $ perl your-program It is important to note that if you have set the default transport by using the environment, I<< no subsequent C args to C will be respected >>. If you set the default transport via the environment, that's it. Everything will use that transport. (Also, note that while we gave the host and port arguments above in lower case, the casing of arguments in the environment is flattened to support systems where environment variables are of a fixed case. So, C would also work. This is extremely valuable behavior, as it allows you to audit every message that would be sent by a program by running something like this: $ export EMAIL_SENDER_TRANSPORT=Maildir $ perl your-program In that example, any message sent via Email::Sender::Simple would be delivered to a maildir in the current directory. =head3 subclassing to change the default transport If you want to use a library that will behave like Email::Sender::Simple but with a different default transport, you can subclass Email::Sender::Simple and replace the C method. =head2 Testing Email::Sender::Simple makes it very, very easy to test code that sends email. The simplest way is to do something like this: use Test::More; BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} = 'Test' } use YourCode; YourCode->run; my @deliveries = Email::Sender::Simple->default_transport->deliveries; Now you've got an array containing every delivery performed through Email::Sender::Simple, in order. Because you set the transport via the environment, no other code will be able to force a different transport. When testing code that forks, L can be used to allow every child process to deliver to a single, easy to inspect destination database. =head2 Hey, where's my Bcc support? A common question is "Why doesn't Email::Sender::Simple automatically respect my Bcc header?" This is often combined with, "Here is a patch to 'fix' it." This is not a bug or oversight. Bcc is being ignored intentionally for now because simply adding the Bcc addresses to the message recipients would not produce the usually-desired behavior. For example, here is a set of headers: From: sender@example.com To: to_rcpt@example.com Cc: cc_rcpt@example.com Bcc: the_boss@example.com In this case, we'd expect the message to be delivered to three people: to_rcpt, cc_rcpt, and the_boss. This is why it's often suggested that the Bcc header should be a source for envelope recipients. In fact, though, a message with a Bcc header should probably be delivered I to the Bcc recipients. The "B" in Bcc means "blind." The other recipients should not see who has been Bcc'd. This means you want to send I messages: one to to_rcpt and cc_rcpt, with no Bcc header present; and another to the_boss only, with the Bcc header. B Email::Sender::Simple promises to send messages atomically. That is: it won't deliver to only some of the recipients, and not to others. That means it can't automatically detect the Bcc header and make two deliveries. There would be a possibility for the second to fail after the first succeeded, which would break the promise of a pure failure or success. The other strategy for dealing with Bcc is to remove the Bcc header from the message and then inject the message with an envelope including the Bcc addresses. The envelope information will not be visible to the final recipients, so this is safe. Unfortunately, this requires modifying the message, and Email::Sender::Simple should not be altering the mutable email object passed to it. There is no C method on Email::Abstract, so it cannot just build a clone and modify that, either. When such a method exists, Bcc handling may be possible. =head3 Example Bcc Handling If you want to support the Bcc header now, it is up to you to deal with how you want to munge the mail and inject the (possibly) munged copies into your outbound mailflow. It is not reasonable to suggest that Email::Sender::Simple do this job. =head4 Example 1: Explicitly set the envelope recipients for Bcc recipients Create the email without a Bcc header, send it to the Bcc users explicitly and then send it to the To/Cc users implicitly. my $message = create_email_mime_msg; # <- whatever you do to get the message $message->delete_header('bcc'); # delete the Bcc header before sending sendmail($message, { to => $rcpt' }); # send to explicit Bcc address sendmail($message); # and then send as normal =head4 Example 2: Explicitly set the envelope recipients for all recipients You can make a single call to C by pulling all the recipient addresses from the headers yourself and specifying all the envelope recipients once. Again, delete the Bcc header before the message is sent. =head1 SEE ALSO =head2 This is awesome! Where can I learn more? Have a look at L, where all the manual's documents are listed. You can also look at the documentation for L and the various Email::Sender::Transport classes. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DevNull.pm100644000766000024 145612264314106 22436 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::DevNull; { $Email::Sender::Transport::DevNull::VERSION = '1.300010'; } use Moo; with 'Email::Sender::Transport'; # ABSTRACT: happily throw away your mail sub send_email { return $_[0]->success } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::DevNull - happily throw away your mail =head1 VERSION version 1.300010 =head1 DESCRIPTION This class implements L. Any mail sent through a DevNull transport will be silently discarded. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Maildir.pm100644000766000024 1073212264314106 22463 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::Maildir; { $Email::Sender::Transport::Maildir::VERSION = '1.300010'; } use Moo; with 'Email::Sender::Transport'; # ABSTRACT: deliver mail to a maildir on disk use Errno (); use Fcntl; use File::Path; use File::Spec; use Sys::Hostname; use MooX::Types::MooseLike::Base qw(Bool); { package Email::Sender::Success::MaildirSuccess; use Moo; use MooX::Types::MooseLike::Base qw(Str); extends 'Email::Sender::Success'; has filename => ( is => 'ro', isa => Str, required => 1, ); no Moo; } my $HOSTNAME; BEGIN { ($HOSTNAME = hostname) =~ s/\..*//; } sub _hostname { $HOSTNAME } my $MAILDIR_TIME = 0; my $MAILDIR_COUNTER = 0; has [ qw(add_lines_header add_envelope_headers) ] => ( is => 'ro', isa => Bool, default => sub { 1 }, ); has dir => ( is => 'ro', required => 1, default => sub { File::Spec->catdir(File::Spec->curdir, 'Maildir') }, ); sub send_email { my ($self, $email, $env) = @_; my $dupe = Email::Abstract->new(\do { $email->as_string }); if ($self->add_envelope_headers) { $dupe->set_header('X-Email-Sender-From' => $env->{from}); $dupe->set_header('X-Email-Sender-To' => @{ $env->{to} }); } $self->_ensure_maildir_exists; $self->_add_lines_header($dupe) if $self->add_lines_header; $self->_update_time; my $fn = $self->_deliver_email($dupe); return Email::Sender::Success::MaildirSuccess->new({ filename => $fn, }); } sub _ensure_maildir_exists { my ($self) = @_; for my $dir (qw(cur tmp new)) { my $subdir = File::Spec->catdir($self->dir, $dir); next if -d $subdir; Email::Sender::Failure->throw("couldn't create $subdir: $!") unless File::Path::mkpath($subdir); } } sub _add_lines_header { my ($class, $email) = @_; return if $email->get_header("Lines"); my $lines = $email->get_body =~ tr/\n/\n/; $email->set_header("Lines", $lines); } sub _update_time { my $time = time; if ($MAILDIR_TIME != $time) { $MAILDIR_TIME = $time; $MAILDIR_COUNTER = 0; } else { $MAILDIR_COUNTER++; } } sub _deliver_email { my ($self, $email) = @_; my ($tmp_filename, $tmp_fh) = $self->_delivery_fh; # if (eval { $email->can('stream_to') }) { # eval { $mail->stream_to($fh); 1 } or return; #} else { my $string = $email->as_string; $string =~ s/\x0D\x0A/\x0A/g unless $^O eq 'MSWin32'; print $tmp_fh $string or Email::Sender::Failure->throw("could not write to $tmp_filename: $!"); close $tmp_fh or Email::Sender::Failure->throw("error closing $tmp_filename: $!"); my $target_name = File::Spec->catfile($self->dir, 'new', $tmp_filename); my $ok = rename( File::Spec->catfile($self->dir, 'tmp', $tmp_filename), $target_name, ); Email::Sender::Failure->throw("could not move $tmp_filename from tmp to new") unless $ok; return $target_name; } sub _delivery_fh { my ($self) = @_; my $hostname = $self->_hostname; my ($filename, $fh); until ($fh) { $filename = join q{.}, $MAILDIR_TIME, $$, ++$MAILDIR_COUNTER, $hostname; my $filespec = File::Spec->catfile($self->dir, 'tmp', $filename); sysopen $fh, $filespec, O_CREAT|O_EXCL|O_WRONLY; binmode $fh; Email::Sender::Failure->throw("cannot create $filespec for delivery: $!") unless $fh or $!{EEXIST}; } return ($filename, $fh); } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::Maildir - deliver mail to a maildir on disk =head1 VERSION version 1.300010 =head1 DESCRIPTION This transport delivers into a maildir. The maildir's location may be given as the F argument to the constructor, and defaults to F in the current directory (at the time of transport initialization). If the directory does not exist, it will be created. By default, three headers will be added: * X-Email-Sender-From - the envelope sender * X-Email-Sender-To - the envelope recipients (one header per rcpt) * Lines - the number of lines in the body These can be controlled with the C and C constructor arguments. The L object returned on success has a C method that returns the filename to which the message was delivered. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Wrapper.pm100644000766000024 323212264314106 22477 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::Wrapper; { $Email::Sender::Transport::Wrapper::VERSION = '1.300010'; } use Moo; with 'Email::Sender::Transport'; # ABSTRACT: a mailer to wrap a mailer for mailing mail use Email::Sender::Util; has transport => ( is => 'ro', does => 'Email::Sender::Transport', required => 1, ); sub send_email { my $self = shift; $self->transport->send_email(@_); } sub is_simple { return $_[0]->transport->is_simple; } sub allow_partial_success { return $_[0]->transport->allow_partial_success; } sub BUILDARGS { my $self = shift; my $href = $self->SUPER::BUILDARGS(@_); if (my $class = delete $href->{transport_class}) { Carp::confess("given both a transport and transport_class") if $href->{transport}; my %arg; for my $key (map {; /^transport_arg_(.+)$/ ? "$1" : () } keys %$href) { $arg{$key} = delete $href->{"transport_arg_$key"}; } $href->{transport} = Email::Sender::Util->_easy_transport($class, \%arg); } return $href; } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::Wrapper - a mailer to wrap a mailer for mailing mail =head1 VERSION version 1.300010 =head1 DESCRIPTION Email::Sender::Transport::Wrapper wraps a transport, provided as the C argument to the constructor. It is provided as a simple way to use method modifiers to create wrapping classes. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CommonSending.pm100644000766000024 711212264314106 22525 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Rolepackage Email::Sender::Role::CommonSending; { $Email::Sender::Role::CommonSending::VERSION = '1.300010'; } use Moo::Role; # ABSTRACT: the common sending tasks most Email::Sender classes will need use Carp (); use Email::Abstract 3.006; use Email::Sender::Success; use Email::Sender::Failure::Temporary; use Email::Sender::Failure::Permanent; use Scalar::Util (); use Try::Tiny; with 'Email::Sender'; requires 'send_email'; sub send { my ($self, $message, $env, @rest) = @_; my $email = $self->prepare_email($message); my $envelope = $self->prepare_envelope($env); try { return $self->send_email($email, $envelope, @rest); } catch { Carp::confess('unknown error') unless my $err = $_; if ( try { $err->isa('Email::Sender::Failure') } and ! (my @tmp = $err->recipients) ) { $err->_set_recipients([ @{ $envelope->{to} } ]); } die $err; } } sub prepare_email { my ($self, $msg) = @_; Carp::confess("no email passed in to sender") unless defined $msg; # We check blessed because if someone would pass in a large message, in some # perls calling isa on the string would create a package with the string as # the name. If the message was (say) two megs, now you'd have a two meg hash # key in the stash. Oops! -- rjbs, 2008-12-04 return $msg if Scalar::Util::blessed($msg) and eval { $msg->isa('Email::Abstract') }; return Email::Abstract->new($msg); } sub prepare_envelope { my ($self, $env) = @_; my %new_env; $new_env{to} = ref $env->{to} ? $env->{to} : [ grep {defined} $env->{to} ]; $new_env{from} = $env->{from}; return \%new_env; } sub success { my $self = shift; my $success = Email::Sender::Success->new(@_); } no Moo::Role; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Role::CommonSending - the common sending tasks most Email::Sender classes will need =head1 VERSION version 1.300010 =head1 DESCRIPTION Email::Sender::Role::CommonSending provides a number of features that should ease writing new classes that perform the L role. Instead of writing a C method, implementors will need to write a smaller C method, which will be passed an L object and envelope containing C and C entries. The C entry will be guaranteed to be an array reference. A C method will also be provided as a shortcut for calling: Email::Sender::Success->new(...); A few other minor details are handled by CommonSending; for more information, consult the source. The methods documented here may be overridden to alter the behavior of the CommonSending role. =head1 METHODS =head2 prepare_email This method is passed a scalar and is expected to return an Email::Abstract object. You probably shouldn't override it in most cases. =head2 prepare_envelope This method is passed a hashref and returns a new hashref that should be used as the envelope passed to the C method. This method is responsible for ensuring that the F entry is an array. =head2 success ... return $self->success; This method returns a new Email::Sender::Success object. Arguments passed to this method are passed along to the Success's constructor. This is provided as a convenience for returning success from subclasses' C methods. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Failable.pm100644000766000024 377612264314106 22573 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::Failable; { $Email::Sender::Transport::Failable::VERSION = '1.300010'; } use Moo; use MooX::Types::MooseLike::Base qw(ArrayRef); extends 'Email::Sender::Transport::Wrapper'; # ABSTRACT: a wrapper to makes things fail predictably has 'failure_conditions' => ( isa => ArrayRef, default => sub { [] }, is => 'ro', reader => '_failure_conditions', ); sub failure_conditions { @{$_[0]->_failure_conditions} } sub fail_if { push @{shift->_failure_conditions}, @_ } sub clear_failure_conditions { @{$_[0]->{failure_conditions}} = () } around send_email => sub { my ($orig, $self, $email, $env, @rest) = @_; for my $cond ($self->failure_conditions) { my $reason = $cond->($self, $email, $env, \@rest); next unless $reason; die (ref $reason ? $reason : Email::Sender::Failure->new($reason)); } return $self->$orig($email, $env, @rest); }; no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::Failable - a wrapper to makes things fail predictably =head1 VERSION version 1.300010 =head1 DESCRIPTION This transport extends L, meaning that it must be created with a C attribute of another Email::Sender::Transport. It will proxy all email sending to that transport, but only after first deciding if it should fail. It does this by calling each coderef in its C attribute, which must be an arrayref of code references. Each coderef will be called and will be passed the Failable transport, the Email::Abstract object, the envelope, and a reference to an array containing the rest of the arguments to C. If any coderef returns a true value, the value will be used to signal failure. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Sendmail.pm100644000766000024 603412264314106 22616 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transportpackage Email::Sender::Transport::Sendmail; { $Email::Sender::Transport::Sendmail::VERSION = '1.300010'; } use Moo; use MooX::Types::MooseLike::Base qw(Str); with 'Email::Sender::Transport'; # ABSTRACT: send mail via sendmail(1) use File::Spec (); has 'sendmail' => ( is => 'ro', isa => Str, required => 1, lazy => 1, default => sub { # This should not have to be lazy, but Moose has a bug(?) that prevents the # instance or partial-instance from being passed in to the default sub. # Laziness doesn't hurt much, though, because (ugh) of the BUILD below. # -- rjbs, 2008-12-04 # return $ENV{PERL_SENDMAIL_PATH} if $ENV{PERL_SENDMAIL_PATH}; # ??? return $_[0]->_find_sendmail('sendmail'); }, ); sub BUILD { $_[0]->sendmail; # force population -- rjbs, 2009-06-08 } sub _find_sendmail { my ($self, $program_name) = @_; $program_name ||= 'sendmail'; my @path = File::Spec->path; if ($program_name eq 'sendmail') { # for 'real' sendmail we will look in common locations -- rjbs, 2009-07-12 push @path, ( File::Spec->catfile('', qw(usr sbin)), File::Spec->catfile('', qw(usr lib)), ); } for my $dir (@path) { my $sendmail = File::Spec->catfile($dir, $program_name); return $sendmail if ($^O eq 'MSWin32') ? -f $sendmail : -x $sendmail; } Carp::confess("couldn't find a sendmail executable"); } sub _sendmail_pipe { my ($self, $envelope) = @_; my $prog = $self->sendmail; my ($first, @args) = $^O eq 'MSWin32' ? qq(| "$prog" -f $envelope->{from} @{$envelope->{to}}) : (q{|-}, $prog, '-f', $envelope->{from}, '--', @{$envelope->{to}}); no warnings 'exec'; ## no critic my $pipe; Email::Sender::Failure->throw("couldn't open pipe to sendmail ($prog): $!") unless open($pipe, $first, @args); return $pipe; } sub send_email { my ($self, $email, $envelope) = @_; my $pipe = $self->_sendmail_pipe($envelope); my $string = $email->as_string; $string =~ s/\x0D\x0A/\x0A/g unless $^O eq 'MSWin32'; print $pipe $email->as_string or Email::Sender::Failure->throw("couldn't send message to sendmail: $!"); close $pipe or Email::Sender::Failure->throw("error when closing pipe to sendmail: $!"); return $self->success; } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::Sendmail - send mail via sendmail(1) =head1 VERSION version 1.300010 =head2 DESCRIPTION This transport sends mail by piping it to the F command. If the location of the F command is not provided in the constructor (see below) then the library will look for an executable file called F in the path. To specify the location of sendmail: my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $path }); =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SMTP000755000766000024 012264314106 21144 5ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/TransportPersistent.pm100644000766000024 312212264314106 24000 0ustar00rjbsstaff000000000000Email-Sender-1.300010/lib/Email/Sender/Transport/SMTPpackage Email::Sender::Transport::SMTP::Persistent; { $Email::Sender::Transport::SMTP::Persistent::VERSION = '1.300010'; } use Moo; extends 'Email::Sender::Transport::SMTP'; # ABSTRACT: an SMTP client that stays online use Net::SMTP; has _cached_client => ( is => 'rw', ); sub _smtp_client { my ($self) = @_; if (my $client = $self->_cached_client) { return $client if eval { $client->reset; $client->ok; }; my $error = $@ || 'error resetting cached SMTP connection: ' . $client->message; Carp::carp($error); } my $client = $self->SUPER::_smtp_client; $self->_cached_client($client); return $client; } sub _message_complete { } sub disconnect { my ($self) = @_; return unless $self->_cached_client; $self->_cached_client->quit; $self->_cached_client(undef); } no Moo; 1; __END__ =pod =encoding UTF-8 =head1 NAME Email::Sender::Transport::SMTP::Persistent - an SMTP client that stays online =head1 VERSION version 1.300010 =head1 DESCRIPTION The stock L reconnects each time it sends a message. This transport only reconnects when the existing connection fails. =head1 METHODS =head2 disconnect $transport->disconnect; This method sends an SMTP QUIT command and destroys the SMTP client, if on exists and is connected. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Transport000755000766000024 012264314106 21543 5ustar00rjbsstaff000000000000Email-Sender-1.300010/t/lib/Test/Email/SenderFailEvery.pm100644000766000024 120412264314106 24124 0ustar00rjbsstaff000000000000Email-Sender-1.300010/t/lib/Test/Email/Sender/Transportpackage Test::Email::Sender::Transport::FailEvery; use Moo; extends 'Email::Sender::Transport::Wrapper'; use MooX::Types::MooseLike::Base qw(Int); has fail_every => ( is => 'ro', isa => Int, required => 1, ); has current_count => ( is => 'rw', isa => Int, default => sub { 0 }, ); around send_email => sub { my ($orig, $self, $email, $env, @rest) = @_; my $count = $self->current_count + 1; $self->current_count($count); my $f = $self->fail_every; if ($count % $f == 0) { Email::Sender::Failure->throw("programmed to fail every $f message(s)"); } return $self->$orig($email, $env, @rest); }; no Moo; 1;