Permalink
Browse files

Transport is now a role; there, I did it!

  • Loading branch information...
1 parent 78e0714 commit bcb777686772f2ac3bb1c24a002934c67b5cbb67 @rjbs rjbs committed Jun 3, 2009
View
6 lib/Email/Sender.pm
@@ -1,10 +1,11 @@
-use warnings;
-use strict;
package Email::Sender;
+use Moose::Role;
# ABSTRACT: a library for sending email
our $VERSION = '0.004';
+requires 'send';
+
=head1 NAME
Email::Sender - a library for sending email
@@ -42,4 +43,5 @@ under the same terms as Perl itself.
=cut
+no Moose::Role;
1;
View
109 lib/Email/Sender/Role/CommonSending.pm
@@ -0,0 +1,109 @@
+package Email::Sender::Role::CommonSending;
+use Moose::Role;
+
+use Carp;
+use Email::Abstract;
+use Email::Sender::Success;
+use Email::Sender::Failure::Temporary;
+use Email::Sender::Failure::Permanent;
+use Scalar::Util ();
+
+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);
+
+ my $return = eval {
+ $self->send_email($email, $envelope, @rest);
+ };
+
+ my $err = $@;
+ return $return if $return;
+
+ if (eval { $err->isa('Email::Sender::Failure') } and ! $err->recipients) {
+ $err->_recipients([ @{ $envelope->{to} } ]);
+ }
+
+ defined($err) ? die($err) : confess('unknown error');
+}
+
+=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.
+
+=cut
+
+sub prepare_email {
+ my ($self, $msg) = @_;
+
+ 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 blessed $msg and eval { $msg->isa('Email::Abstract') };
+
+ return Email::Abstract->new($msg);
+}
+
+=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<send_email> method. This method is responsible
+for ensuring that the F<to> entry is an array.
+
+=cut
+
+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;
+}
+
+=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<send_email> methods.
+
+=cut
+
+sub success {
+ my $self = shift;
+ my $success = Email::Sender::Success->new(@_);
+}
+
+=head1 AUTHOR
+
+Ricardo SIGNES, C<< <rjbs@cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests through the web interface at
+L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
+notified of progress on your bug as I make changes.
+
+=head1 COPYRIGHT
+
+Copyright 2006-2008, Ricardo SIGNES.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+no Moose::Role;
+1;
View
169 lib/Email/Sender/Transport.pm
@@ -1,170 +1,18 @@
package Email::Sender::Transport;
-use Moose;
+use Moose::Role;
=head1 NAME
-Email::Sender::Transport - base class for email transports
+Email::Sender::Transport - role for email transports
=cut
-our $VERSION = '0.004';
+with 'Email::Sender::Role::CommonSending';
-use Carp;
-use Email::Abstract;
-use Email::Sender::Success;
-use Email::Sender::Failure::Temporary;
-use Email::Sender::Failure::Permanent;
-use Scalar::Util ();
-
-=head1 SYNOPSIS
-
- package Email::Sender::Transport::IM2000;
- use Moose;
- extends 'Email::Sender::Transport';
-
- sub send_email {
- my ($self, $email, $env) = @_;
- print $email->as_string;
- return $self->success;
- }
-
- ...
-
- my $xport = Email::Sender::Transport::IM2000->new;
- $xport->send($email, { to => [ $recipient, ... ], from => $from });
-
-=head1 DESCRIPTION
-
-Email::Sender::Transport is the base class for mail-sending classes in the
-Email::Sender system.
-
-=head1 USER'S API
-
-There are only three critical things to know about using an Email::Sender
-transport:
-
-=over
-
-=item * create the transport, consulting its documentation for parameters
-
-=item * call its send method, passing an email and envelope
-
-=item * it will return an L<Email::Sender::Success> or throw an L<Email::Sender::Failure>
-
-=back
-
-Some transports will either succeed or fail totally. Some also allow partial
-success to be signalled. Others (like LMTP) may I<require> that partial
-success be accounted for.
-
-Partial success is indicated by the return of a
-L<Email::Sender::Success::Partial>. The most commonly useful network
-transports, Sendmail and SMTP, will never return a partial success in their
-default configuration, so most users can avoid worrying about them.
-
-=head2 send
-
- my $result = eval { $sender->send($email, \%env) };
-
-This is the only method that most users will ever need to call. It attempts to
-send the message across the transport, and will either return success or raise
-an exception.
-
-=cut
-
-sub send {
- my ($self, $message, $env, @rest) = @_;
- my $email = $self->prepare_email($message);
- my $envelope = $self->prepare_envelope($env);
-
- my $return = eval {
- $self->send_email($email, $envelope, @rest);
- };
-
- my $err = $@;
- return $return if $return;
-
- if (eval { $err->isa('Email::Sender::Failure') } and ! $err->recipients) {
- $err->_recipients([ @{ $envelope->{to} } ]);
- }
-
- defined($err) ? die($err) : confess('unknown error');
-}
-
-=head1 DEVELOPER'S API
-
-=head2 send_email
-
-This method is called by C<send>, which should probably not be overriden.
-Instead, override this method. It is passed an L<Email::Abstract> object and
-an envelope. The envelope is a hashref in the following form:
-
- to - an arrayref of email addresses (strings)
- from - a single email address (string)
-
-It should either return success (as an L<Email::Sender::Success>) or throw an
-exception (preferably one that is an L<Email::Sender::Failure>).
-
-=cut
-
-sub send_email {
- my $class = ref $_[0] ? ref $_[0] : $_[0];
- Carp::croak "send_email method not implemented on $class";
-}
-
-=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.
-
-=cut
-
-sub prepare_email {
- my ($self, $msg) = @_;
-
- 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 blessed $msg and eval { $msg->isa('Email::Abstract') };
-
- return Email::Abstract->new($msg);
-}
-
-=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<send_email> method. This method is responsible
-for ensuring that the F<to> entry is an array.
-
-=cut
-
-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;
-}
-
-=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<send_email> methods.
-
-=cut
-
-sub success {
- my $self = shift;
- my $success = Email::Sender::Success->new(@_);
+sub is_simple {
+ my ($self) = @_;
+ return if $self->allow_partial_success;
+ return 1;
}
=head2 allow_partial_success
@@ -196,6 +44,5 @@ under the same terms as Perl itself.
=cut
-__PACKAGE__->meta->make_immutable;
-no Moose;
+no Moose::Role;
1;
View
2 lib/Email/Sender/Transport/DevNull.pm
@@ -1,6 +1,6 @@
package Email::Sender::Transport::DevNull;
use Moose;
-extends 'Email::Sender::Transport';
+with 'Email::Sender::Transport';
our $VERSION = '0.004';
View
2 lib/Email/Sender/Transport/Maildir.pm
@@ -1,6 +1,6 @@
package Email::Sender::Transport::Maildir;
use Moose;
-extends 'Email::Sender::Transport';
+with 'Email::Sender::Transport';
our $VERSION = '0.004';
View
2 lib/Email/Sender/Transport/Mbox.pm
@@ -1,6 +1,6 @@
package Email::Sender::Transport::Mbox;
use Moose;
-extends 'Email::Sender::Transport';
+with 'Email::Sender::Transport';
our $VERSION = '0.004';
View
2 lib/Email/Sender/Transport/Print.pm
@@ -1,6 +1,6 @@
package Email::Sender::Transport::Print;
use Moose;
-extends 'Email::Sender::Transport';
+with 'Email::Sender::Transport';
our $VERSION = '0.004';
View
2 lib/Email/Sender/Transport/SMTP.pm
@@ -1,6 +1,6 @@
package Email::Sender::Transport::SMTP;
use Moose;
-extends 'Email::Sender::Transport';
+with 'Email::Sender::Transport';
our $VERSION = '0.004';
View
2 lib/Email/Sender/Transport/Sendmail.pm
@@ -1,6 +1,6 @@
package Email::Sender::Transport::Sendmail;
use Moose;
-extends 'Email::Sender::Transport';
+with 'Email::Sender::Transport';
our $VERSION = '0.004';
View
2 lib/Email/Sender/Transport/Test.pm
@@ -1,6 +1,6 @@
package Email::Sender::Transport::Test;
use Moose;
-extends 'Email::Sender::Transport';
+with 'Email::Sender::Transport';
our $VERSION = '0.004';
View
2 lib/Email/Sender/Transport/Wrapper.pm
@@ -1,6 +1,6 @@
package Email::Sender::Transport::Wrapper;
use Moose;
-extends 'Email::Sender::Transport';
+with 'Email::Sender::Transport';
our $VERSION = '0.004';
View
2 t/devnull.t
@@ -7,7 +7,7 @@ use Email::Sender;
use Email::Sender::Transport::DevNull;
my $xport = Email::Sender::Transport::DevNull->new;
-isa_ok($xport, 'Email::Sender::Transport');
+ok($xport->does('Email::Sender::Transport'));
isa_ok($xport, 'Email::Sender::Transport::DevNull');
my $message = <<'END_MESSAGE';
View
2 t/print.t
@@ -15,7 +15,7 @@ use Email::Sender::Transport::Print;
}
my $xport = Email::Sender::Transport::Print->new({ fh => CP->new });
-isa_ok($xport, 'Email::Sender::Transport');
+ok($xport->does('Email::Sender::Transport'));
isa_ok($xport, 'Email::Sender::Transport::Print');
my $message = <<'END_MESSAGE';
View
2 t/test.t
@@ -8,7 +8,7 @@ use Email::Sender::Transport::Test;
use Email::Sender::Transport::Failable;
my $sender = Email::Sender::Transport::Test->new;
-isa_ok($sender, 'Email::Sender::Transport');
+ok($sender->does('Email::Sender::Transport'));
isa_ok($sender, 'Email::Sender::Transport::Test');
is(@{ $sender->deliveries }, 0, "no deliveries so far");
View
9 t/trans-misc.t
@@ -1,9 +0,0 @@
-#!perl
-use strict;
-use warnings;
-use Test::More tests => 1;
-
-use Email::Sender::Transport;
-
-eval { Email::Sender::Transport->new->send_email };
-like($@, qr{method not implemented}, 'Transport is not a useful Transport');

0 comments on commit bcb7776

Please sign in to comment.