r3318 - in /packages/libemail-send-perl/branches/upstream/current:
./ lib/Email/ lib/Email/Send/ t/ t/lib/ t/lib/Email/Send/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Tue Jul 25 14:02:08 UTC 2006
Author: eloy
Date: Tue Jul 25 14:02:07 2006
New Revision: 3318
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3318
Log:
Load /tmp/tmp.JCUYK14667/libemail-send-perl-2.16 into
packages/libemail-send-perl/branches/upstream/current.
Added:
packages/libemail-send-perl/branches/upstream/current/t/abstract-msg.t
packages/libemail-send-perl/branches/upstream/current/t/all-mailers.t
packages/libemail-send-perl/branches/upstream/current/t/errors.t
packages/libemail-send-perl/branches/upstream/current/t/io.t
packages/libemail-send-perl/branches/upstream/current/t/lib/BadMailer.pm
packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Fail.pm
packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Unavail.pm
packages/libemail-send-perl/branches/upstream/current/t/modifier.t
packages/libemail-send-perl/branches/upstream/current/t/pod-coverage.t
packages/libemail-send-perl/branches/upstream/current/t/pod.t
packages/libemail-send-perl/branches/upstream/current/t/without.t
Modified:
packages/libemail-send-perl/branches/upstream/current/Changes
packages/libemail-send-perl/branches/upstream/current/MANIFEST
packages/libemail-send-perl/branches/upstream/current/META.yml
packages/libemail-send-perl/branches/upstream/current/Makefile.PL
packages/libemail-send-perl/branches/upstream/current/lib/Email/Send.pm
packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/IO.pm
packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/NNTP.pm
packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Qmail.pm
packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/SMTP.pm
packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Sendmail.pm
packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Test.pm
packages/libemail-send-perl/branches/upstream/current/t/classic.t
packages/libemail-send-perl/branches/upstream/current/t/email-send.t
packages/libemail-send-perl/branches/upstream/current/t/foreign-mailer.t
packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/OK.pm
packages/libemail-send-perl/branches/upstream/current/t/no-import.t
packages/libemail-send-perl/branches/upstream/current/t/object-mailer.t
packages/libemail-send-perl/branches/upstream/current/t/sendmail.t
packages/libemail-send-perl/branches/upstream/current/t/test.t
Modified: packages/libemail-send-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/Changes?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/Changes (original)
+++ packages/libemail-send-perl/branches/upstream/current/Changes Tue Jul 25 14:02:07 2006
@@ -1,3 +1,19 @@
+2.16 2006-07-24
+
+ - the without.t test no longer breaks if Test::Without::Module isn't there
+
+2.15 2006-07-21
+
+ - append, to not print, to IO::All objects
+ - added simple test for message modifier (response to bug from ABH)
+ - use File::Spec->path for path, not ENV{PATH} (bug 20109, Simon Flack)
+ - use Symbol.pm, not global filehandles
+ - undef is never a valid message
+ - remove use warnings
+ - plan all tests
+ - improve testing
+ - add pod tests
+
2.11 2006-07-05
- fixed bug introduced in 2.10; message modifiers were broken
Modified: packages/libemail-send-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/MANIFEST?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libemail-send-perl/branches/upstream/current/MANIFEST Tue Jul 25 14:02:07 2006
@@ -11,17 +11,28 @@
MANIFEST This list of files
META.yml
README
+t/abstract-msg.t
+t/all-mailers.t
t/classic.t
t/email-send-test.t
t/email-send.t
+t/errors.t
t/foreign-mailer.t
+t/io.t
+t/lib/BadMailer.pm
+t/lib/Email/Send/Fail.pm
+t/lib/Email/Send/OK.pm
+t/lib/Email/Send/Unavail.pm
+t/lib/OKMailer.pm
+t/lib/OKMailerOO.pm
+t/modifier.t
t/no-import.t
t/object-mailer.t
+t/pod-coverage.t
+t/pod.t
t/sendmail.t
t/test.t
-t/lib/Email/Send/OK.pm
-t/lib/OKMailer.pm
-t/lib/OKMailerOO.pm
+t/without.t
util/executable
util/not-executable
util/sendmail
Modified: packages/libemail-send-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/META.yml?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/META.yml (original)
+++ packages/libemail-send-perl/branches/upstream/current/META.yml Tue Jul 25 14:02:07 2006
@@ -1,16 +1,18 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Email-Send
-version: 2.11
+version: 2.16
version_from: lib/Email/Send.pm
installdirs: site
requires:
Class::Accessor::Fast: 0.19
Email::Address: 1.80
Email::Simple: 1.92
+ File::Spec: 0
Module::Pluggable: 2.97
Return::Value: 1.28
Scalar::Util: 1.02
+ Symbol: 0.00
Test::More: 0.47
distribution_type: module
Modified: packages/libemail-send-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/Makefile.PL?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/Makefile.PL (original)
+++ packages/libemail-send-perl/branches/upstream/current/Makefile.PL Tue Jul 25 14:02:07 2006
@@ -8,10 +8,12 @@
'Class::Accessor::Fast' => '0.19',
'Email::Address' => '1.80',
'Email::Simple' => '1.92',
+ 'File::Spec' => 0, # min ver unknown; core in 5.005
'Module::Pluggable' => '2.97', # topic safety
'Return::Value' => '1.28',
- 'Scalar::Util' => '1.02',
- 'Test::More' => '0.47',
+ 'Scalar::Util' => '1.02', # reason unknown; core in 5.7.3
+ 'Symbol' => '0.00', # min ver unknown; core in 5.002
+ 'Test::More' => '0.47', # reason unknown; core in 5.8.1
},
VERSION_FROM => 'lib/Email/Send.pm',
);
Modified: packages/libemail-send-perl/branches/upstream/current/lib/Email/Send.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/lib/Email/Send.pm?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/lib/Email/Send.pm (original)
+++ packages/libemail-send-perl/branches/upstream/current/lib/Email/Send.pm Tue Jul 25 14:02:07 2006
@@ -2,7 +2,7 @@
use strict;
use vars qw[$VERSION];
-$VERSION = '2.11';
+$VERSION = '2.16';
use base qw[Class::Accessor::Fast];
use Email::Simple;
@@ -99,10 +99,10 @@
my ($class, $args) = @_;
$args->{mailer_args} ||= [];
my %plugins = map {
- my ($short_name) = /^Email::Send::(.+)/;
- ($short_name, $_);
- } $class->plugins;
- $args->{_plugin_list} = \%plugins;
+ my ($short_name) = /^Email::Send::(.+)/;
+ ($short_name, $_);
+ } $class->plugins;
+ $args->{_plugin_list} = \%plugins;
return $class->SUPER::new($args);
}
__PACKAGE__->mk_accessors(qw[mailer mailer_args message_modifier _plugin_list]);
@@ -128,21 +128,22 @@
=cut
sub send {
- goto &_send_function unless eval { $_[0]->isa('Email::Send') };
- my ($self, $message, @args) = @_;
- my $simple = $self->_objectify_message($message);
- return failure "No message found." unless $simple;
-
- $self->message_modifier->(
- $self, $simple,
- @args,
- ) if $self->message_modifier;
-
- if ( $self->mailer ) {
- return $self->_send_it($self->mailer, $simple);
- }
-
- return $self->_try_all($simple);
+ goto &_send_function unless eval { $_[0]->isa('Email::Send') };
+ my ($self, $message, @args) = @_;
+
+ my $simple = $self->_objectify_message($message);
+ return failure "No message found." unless $simple;
+
+ $self->message_modifier->(
+ $self, $simple,
+ @args,
+ ) if $self->message_modifier;
+
+ if ( $self->mailer ) {
+ return $self->_send_it($self->mailer, $simple);
+ }
+
+ return $self->_try_all($simple);
}
=item all_mailers()
@@ -155,12 +156,12 @@
=cut
sub all_mailers {
- my ($self) = @_;
- my @mailers;
- for ( keys %{$self->_plugin_list} ) {
- push @mailers, $_ if $self->mailer_available($_);
- }
- return @mailers;
+ my ($self) = @_;
+ my @mailers;
+ for ( keys %{$self->_plugin_list} ) {
+ push @mailers, $_ if $self->mailer_available($_);
+ }
+ return @mailers;
}
=item mailer_available()
@@ -195,6 +196,7 @@
sub _objectify_message {
my ($self, $message) = @_;
+ return undef unless defined $message;
return $message if UNIVERSAL::isa($message, 'Email::Simple');
return Email::Simple->new($message) unless ref($message);
return Email::Abstract->cast($message => 'Email::Simple')
@@ -228,12 +230,12 @@
}
sub _try_all {
- my ($self, $simple) = @_;
- foreach ( $self->all_mailers ) {
- my $sent = $self->_send_it($_, $simple);
- return $sent if $sent;
- }
- return failure "Unable to send message.";
+ my ($self, $simple) = @_;
+ foreach ( $self->all_mailers ) {
+ my $sent = $self->_send_it($_, $simple);
+ return $sent if $sent;
+ }
+ return failure "Unable to send message.";
}
# Classic Interface.
@@ -246,9 +248,9 @@
sub _send_function {
my ($mailer, $message, @args) = @_;
__PACKAGE__->new({
- mailer => $mailer,
- mailer_args => \@args,
- })->send($message);
+ mailer => $mailer,
+ mailer_args => \@args,
+ })->send($message);
}
1;
@@ -291,22 +293,22 @@
use Return::Value;
sub is_available {
- eval { use LWP::UserAgent }
+ eval { use LWP::UserAgent }
}
sub send {
my ($class, $message, @args);
- use LWP::UserAgent;
+ require LWP::UserAgent;
if ( @args ) {
my ($URL, $FIELD) = @args;
$AGENT = LWP::UserAgent->new;
}
return failure "Can't send to URL if no URL and field are named"
- unless $URL && $FIELD;
+ unless $URL && $FIELD;
$AGENT->post($URL => { $FIELD => $message->as_string });
- return success;
+ return success;
}
1;
@@ -334,7 +336,9 @@
=head1 AUTHOR
-Casey West, <F<casey at geeknest.com>>.
+Current maintainer: Ricardo SIGNES, <F<rjbs at cpan.org>>.
+
+Original author: Casey West, <F<casey at geeknest.com>>.
=head1 COPYRIGHT
Modified: packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/IO.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/IO.pm?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/IO.pm (original)
+++ packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/IO.pm Tue Jul 25 14:02:07 2006
@@ -4,7 +4,7 @@
use Return::Value;
use vars qw[$VERSION];
-$VERSION = '2.04';
+$VERSION = '2.15';
use vars qw[@IO];
@IO = ('=') unless @IO;
@@ -17,10 +17,10 @@
sub send {
my ($class, $message, @args) = @_;
- eval { require IO::All;IO::All->import };
+ eval { require IO::All; IO::All->import };
return failure "send: Loading IO::All failed: $@" if $@;
@args = (@IO) unless @args;
- eval {io(@args)->print($message->as_string)};
+ eval {io(@args)->append($message->as_string)};
return failure $@ if $@;
return success;
}
@@ -74,7 +74,9 @@
=head1 AUTHOR
-Casey West, <F<casey at geeknest.com>>.
+Current maintainer: Ricardo SIGNES, <F<rjbs at cpan.org>>.
+
+Original author: Casey West, <F<casey at geeknest.com>>.
=head1 COPYRIGHT
Modified: packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/NNTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/NNTP.pm?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/NNTP.pm (original)
+++ packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/NNTP.pm Tue Jul 25 14:02:07 2006
@@ -1,5 +1,4 @@
package Email::Send::NNTP;
-# $Id: NNTP.pm,v 1.6 2006/04/20 15:39:06 cwest Exp $
use strict;
use vars qw[$NNTP $VERSION];
@@ -64,7 +63,9 @@
=head1 AUTHOR
-Casey West, <F<casey at geeknest.com>>.
+Current maintainer: Ricardo SIGNES, <F<rjbs at cpan.org>>.
+
+Original author: Casey West, <F<casey at geeknest.com>>.
=head1 COPYRIGHT
Modified: packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Qmail.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Qmail.pm?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Qmail.pm (original)
+++ packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Qmail.pm Tue Jul 25 14:02:07 2006
@@ -1,25 +1,49 @@
package Email::Send::Qmail;
-# $Id: Qmail.pm,v 1.6 2006/01/28 23:02:44 cwest Exp $
use strict;
+
+use File::Spec ();
+use Return::Value;
+use Symbol qw(gensym);
use vars qw[$QMAIL $VERSION];
$QMAIL ||= q[qmail-inject];
-
-use Return::Value;
-
-$VERSION = '2.04';
+$VERSION = '2.15';
sub is_available {
- return `which $QMAIL`
- ? success
- : failure;
+ my $class = shift;
+
+
+ return failure "No qmail found" unless $class->_find_qmail;
+ return success;
+}
+
+sub _find_qmail {
+ my $class = shift;
+
+ my $sendmail;
+ for my $dir (File::Spec->path) {
+ if ( -x "$dir/$QMAIL" ) {
+ $sendmail = "$dir/$QMAIL";
+ last;
+ }
+ }
+ return $sendmail;
}
sub send {
my ($class, $message, @args) = @_;
- open QMAIL, "| $QMAIL @args" or return failure;
- print QMAIL $message->as_string;
- close QMAIL;
+
+ my $pipe = gensym;
+
+ open $pipe, "| $QMAIL @args"
+ or return failure "couldn't open pipe to qmail";
+
+ print $pipe $message->as_string
+ or return failure "couldn't send message to qmail";
+
+ close $pipe
+ or return failure "error when closing pipe to qmail";
+
return success;
}
@@ -56,7 +80,9 @@
=head1 AUTHOR
-Casey West, <F<casey at geeknest.com>>.
+Current maintainer: Ricardo SIGNES, <F<rjbs at cpan.org>>.
+
+Original author: Casey West, <F<casey at geeknest.com>>.
=head1 COPYRIGHT
Modified: packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/SMTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/SMTP.pm?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/SMTP.pm (original)
+++ packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/SMTP.pm Tue Jul 25 14:02:07 2006
@@ -1,5 +1,4 @@
package Email::Send::SMTP;
-# $Id: SMTP.pm,v 1.13 2006/04/20 15:39:06 cwest Exp $
use strict;
use vars qw[$SMTP $VERSION];
@@ -156,7 +155,9 @@
=head1 AUTHOR
-Casey West, <F<casey at geeknest.com>>.
+Current maintainer: Ricardo SIGNES, <F<rjbs at cpan.org>>.
+
+Original author: Casey West, <F<casey at geeknest.com>>.
=head1 COPYRIGHT
Modified: packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Sendmail.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Sendmail.pm?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Sendmail.pm (original)
+++ packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Sendmail.pm Tue Jul 25 14:02:07 2006
@@ -1,29 +1,31 @@
package Email::Send::Sendmail;
-# $Id: Sendmail.pm,v 1.7 2006/01/28 23:02:44 cwest Exp $
use strict;
+use File::Spec ();
use Return::Value;
+use Symbol qw(gensym);
use vars qw[$SENDMAIL $VERSION];
-$VERSION = '2.04';
+$VERSION = '2.15';
sub is_available {
my $class = shift;
- my $status = '';
- $status = "No Sendmail found" unless $class->_find_sendmail;
- return success $status;
+
+ # This is RIDICULOUS. Why do we say it's available if it isn't?
+ # -- rjbs, 2006-07-06
+ return success "No Sendmail found" unless $class->_find_sendmail;
+ return success '';
}
sub _find_sendmail {
my $class = shift;
return $SENDMAIL if defined $SENDMAIL;
- my @path = split /:/, $ENV{PATH};
my $sendmail;
- for (@path) {
- if ( -x "$_/sendmail" ) {
- $sendmail = "$_/sendmail";
+ for my $dir (File::Spec->path) {
+ if ( -x "$dir/sendmail" ) {
+ $sendmail = "$dir/sendmail";
last;
}
}
@@ -33,13 +35,18 @@
sub send {
my ($class, $message, @args) = @_;
my $mailer = $class->_find_sendmail;
+
return failure "Found $mailer but cannot execute it"
unless -x $mailer;
- open SENDMAIL, "| $mailer -t -oi @args"
+
+ my $pipe = gensym;
+
+ open $pipe, "| $mailer -t -oi @args"
or return failure "Error executing $mailer: $!";
- print SENDMAIL $message->as_string
+ print $pipe $message->as_string
or return failure "Error printing via pipe to $mailer: $!";
- close SENDMAIL;
+ close $pipe
+ or return failure "error when closing pipe to $mailer: $!";
return success;
}
@@ -77,7 +84,9 @@
=head1 AUTHOR
-Casey West, <F<casey at geeknest.com>>.
+Current maintainer: Ricardo SIGNES, <F<rjbs at cpan.org>>.
+
+Original author: Casey West, <F<casey at geeknest.com>>.
=head1 COPYRIGHT
Modified: packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Test.pm?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Test.pm (original)
+++ packages/libemail-send-perl/branches/upstream/current/lib/Email/Send/Test.pm Tue Jul 25 14:02:07 2006
@@ -156,7 +156,9 @@
=head1 AUTHORS
-Adam Kennedy E<lt>cpan at ali.asE<gt>, L<http://ali.as/>
+Current maintainer: Ricardo SIGNES, <F<rjbs at cpan.org>>.
+
+Original author: Adam Kennedy E<lt>cpan at ali.asE<gt>, L<http://ali.as/>
=head1 COPYRIGHT
Added: packages/libemail-send-perl/branches/upstream/current/t/abstract-msg.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/abstract-msg.t?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/abstract-msg.t (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/abstract-msg.t Tue Jul 25 14:02:07 2006
@@ -1,0 +1,50 @@
+use Test::More;
+use strict;
+$^W = 1;
+
+BEGIN { use_ok('Email::Send', 'Test'); }
+require Email::Send::Test;
+
+my $tests = 3;
+
+my $message;
+
+if (eval { require Mail::Internet; }) {
+ plan tests => $tests;
+
+ $message = Mail::Internet->new(
+ Header => Mail::Header->new([
+ "From: your mom\n",
+ "To: your dad\n",
+ ]),
+ Body => [ "This is a message\n" ],
+ );
+
+ isa_ok($message, 'Mail::Internet');
+} elsif (eval { require MIME::Entity }) {
+ plan tests => $tests;
+
+ $message = MIME::Entity->build(
+ From => 'me at myhost.com',
+ To => 'you at yourhost.com',
+ Subject => "Hello, nurse!",
+ Data => "This is a message\n",
+ );
+
+ isa_ok($message, 'MIME::Entity');
+} else {
+ plan skip_all => "these tests require Mail::Internet or MIME::Entity";
+}
+
+send Test => $message;
+
+my @emails = Email::Send::Test->emails;
+
+is(@emails, 1, "we delivered the non-Simple message");
+
+like(
+ $emails[0]->body,
+ qr/This is a message/,
+ "the delivered message looks like what we send",
+);
+
Added: packages/libemail-send-perl/branches/upstream/current/t/all-mailers.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/all-mailers.t?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/all-mailers.t (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/all-mailers.t Tue Jul 25 14:02:07 2006
@@ -1,0 +1,71 @@
+use Test::More tests => 11;
+use strict;
+$^W = 1;
+
+use lib 't/lib';
+
+BEGIN { use_ok('Email::Send', 'Test'); }
+
+my $sender = Email::Send->new;
+my @mailers = $sender->all_mailers;
+
+ok(
+ @mailers > 2, # we'll never unbundle Sendmail or SMTP
+ "we found at least a couple mailers",
+);
+
+my $ok = 1;
+my @mailer_pkgs;
+for my $mailer (@mailers) {
+ my $invocant = $sender->_mailer_invocant($mailer) or $ok = 0;
+ push @mailer_pkgs, $invocant unless Scalar::Util::blessed($invocant);
+}
+
+ok($ok, "all mailers are valid mailers");
+
+ok(
+ grep({ $_ eq 'Email::Send::OK' } @mailer_pkgs),
+ "we found the OK sender (from t/lib)",
+);
+
+ok(
+ ! grep({ $_ eq 'Email::Send::Unavail' } @mailer_pkgs),
+ "the unavailable (t/lib) sender isn't available",
+);
+
+my $message = <<'END_MESSAGE';
+From: rjbs at whitehouse.gov
+To: hdp at kremlin.su
+Subject: this wall
+
+Tear it down.
+END_MESSAGE
+
+{
+ # This will let us use try_all without actually trying all.
+ $sender->{_plugin_list} = { Test => 'Email::Send::Test' };
+
+ my $rv = $sender->send($message);
+ ok($rv, "we can send a message via 'try all mailers' method");
+ is(
+ Email::Send::Test->emails,
+ 1,
+ "and it's sent to the (only) mailer available",
+ );
+}
+
+{
+ # This will let us use try_all without actually trying all.
+ $sender->{_plugin_list} = { Test => 'Email::Send::Fail' };
+
+ my $rv = $sender->send($message);
+ ok(!$rv, "we couldn't send when the only choice fails");
+ like("$rv", qr/unable to send/i, "and we got the expected error message");
+}
+
+{
+ my $rv = send(Unavail => $message);
+
+ ok(!$rv, "we can't send to an unavailable mailer");
+ like("$rv", qr/never available/i, "and we get its unavailable failure");
+}
Modified: packages/libemail-send-perl/branches/upstream/current/t/classic.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/classic.t?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/classic.t (original)
+++ packages/libemail-send-perl/branches/upstream/current/t/classic.t Tue Jul 25 14:02:07 2006
@@ -1,5 +1,4 @@
-use Test::More qw[no_plan];
-# $Id: classic.t,v 1.2 2006/04/20 15:39:06 cwest Exp $
+use Test::More tests => 3;
use strict;
$^W =1;
Modified: packages/libemail-send-perl/branches/upstream/current/t/email-send.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/email-send.t?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/email-send.t (original)
+++ packages/libemail-send-perl/branches/upstream/current/t/email-send.t Tue Jul 25 14:02:07 2006
@@ -1,4 +1,4 @@
-use Test::More qw[no_plan];
+use Test::More tests => 20;
use strict;
$^W = 1;
@@ -14,15 +14,15 @@
my $mailer = Email::Send->new();
isa_ok $mailer, 'Email::Send';
-ok ! $mailer->mailer;
-ok ! @{$mailer->mailer_args};
-ok ! $mailer->message_modifier;
+ok ! $mailer->mailer, "it has no defined mailer";
+ok ! @{$mailer->mailer_args}, "and no mailer args";
+ok ! $mailer->message_modifier, "and no message modifier";
$mailer->mailer('SMTP');
$mailer->mailer_args([Host => 'localhost']);
$mailer->message_modifier(sub {1});
-is $mailer->mailer, 'SMTP';
-is $mailer->mailer_args->[1], 'localhost';
-is ref($mailer->message_modifier), 'CODE';
-is $mailer->message_modifier->(), 1;
+is $mailer->mailer, 'SMTP', "we've set its mailer to smtp";
+is $mailer->mailer_args->[1], 'localhost', "and set a mailer arg";
+is ref($mailer->message_modifier), 'CODE', "and a message modifier";
+is $mailer->message_modifier->(), 1, "and the message modifier can be called";
Added: packages/libemail-send-perl/branches/upstream/current/t/errors.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/errors.t?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/errors.t (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/errors.t Tue Jul 25 14:02:07 2006
@@ -1,0 +1,33 @@
+use Test::More tests => 7;
+use strict;
+$^W = 1;
+
+use lib 't/lib';
+
+BEGIN { use_ok('Email::Send', 'Test'); }
+
+{ # undef message
+ my $rv = send;
+ ok(!$rv, "sending with no message is false");
+ like("$rv", qr/no message found/i, "correct error message");
+}
+
+{ # broken mailers in mailer_available
+ { # mailer module that won't load
+ my $sender = Email::Send->new;
+
+ my $rv = $sender->mailer_available("Test::Email::Send::Won't::Exist");
+
+ ok(!$rv, "failed to load mailer (doesn't exist)"),
+ like("$rv", qr/can't locate/i, "and got correct exception");
+ }
+
+ { # mailer module that won't load
+ my $sender = Email::Send->new;
+
+ my $rv = $sender->mailer_available("BadMailer");
+
+ ok(!$rv, "failed to load mailer BadMailer"),
+ like("$rv", qr/doesn't report avail/i, "and got correct failure");
+ }
+}
Modified: packages/libemail-send-perl/branches/upstream/current/t/foreign-mailer.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/foreign-mailer.t?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/foreign-mailer.t (original)
+++ packages/libemail-send-perl/branches/upstream/current/t/foreign-mailer.t Tue Jul 25 14:02:07 2006
@@ -1,4 +1,4 @@
-use Test::More qw[no_plan];
+use Test::More tests => 3;
# $Id: classic.t,v 1.1 2006/01/17 22:11:38 cwest Exp $
use strict;
$^W =1;
Added: packages/libemail-send-perl/branches/upstream/current/t/io.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/io.t?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/io.t (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/io.t Tue Jul 25 14:02:07 2006
@@ -1,0 +1,39 @@
+use Test::More;
+use strict;
+$^W = 1;
+
+use lib 't/lib';
+
+use Email::Send;
+
+plan skip_all => "these tests require IO::All"
+ unless Email::Send->new->mailer_available('IO');
+
+plan skip_all => "these tests require File::Temp"
+ unless eval { require File::Temp; File::Temp->import(qw(tempfile)); 1 };
+
+plan tests => 3;
+
+my $message = <<"END_MESSAGE";
+To: put-up
+From: shut-up
+Subject: jfdi
+
+This is a test (message).
+END_MESSAGE
+
+my (undef, $filename) = tempfile(CLEANUP => 1);
+
+{ my @no_warning_please = @Email::Send::IO::IO; }
+ at Email::Send::IO::IO = ($filename);
+
+my $sender = Email::Send->new({ mailer => 'IO' });
+
+ok($sender->send($message), 'send the first message');
+ok($sender->send($message), 'and send it again');
+
+open TEMPFILE, "<$filename" or die "couldn't open temp file: $!";
+
+my @lines = <TEMPFILE>;
+
+is(@lines, 10, "message delivered twice: nine lines in file");
Added: packages/libemail-send-perl/branches/upstream/current/t/lib/BadMailer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/lib/BadMailer.pm?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/lib/BadMailer.pm (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/lib/BadMailer.pm Tue Jul 25 14:02:07 2006
@@ -1,0 +1,4 @@
+## our out-of-namespace mailer:
+package BadMailer;
+
+1;
Added: packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Fail.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Fail.pm?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Fail.pm (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Fail.pm Tue Jul 25 14:02:07 2006
@@ -1,0 +1,12 @@
+package Email::Send::Fail;
+
+use strict;
+use Return::Value;
+
+sub is_available { 1 }
+
+sub send {
+ return failure "no bounce, no play";
+}
+
+1;
Modified: packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/OK.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/OK.pm?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/OK.pm (original)
+++ packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/OK.pm Tue Jul 25 14:02:07 2006
@@ -3,7 +3,6 @@
use Test::More;
use strict;
-use warnings;
sub is_available { 1 }
Added: packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Unavail.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Unavail.pm?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Unavail.pm (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/lib/Email/Send/Unavail.pm Tue Jul 25 14:02:07 2006
@@ -1,0 +1,12 @@
+package Email::Send::Unavail;
+
+use strict;
+use Return::Value;
+
+sub is_available { return failure "never available" }
+
+sub send {
+ die "this should never be called!"; # Seriously, guys. -- rjbs, 2006-07-06
+}
+
+1;
Added: packages/libemail-send-perl/branches/upstream/current/t/modifier.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/modifier.t?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/modifier.t (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/modifier.t Tue Jul 25 14:02:07 2006
@@ -1,0 +1,38 @@
+#!/usr/bin/perl -w
+use strict;
+$^W = 1;
+
+# Does everything load?
+use Test::More tests => 5;
+use Email::Send ();
+use Email::Send::Test ();
+
+# Clear first, just in case
+ok( Email::Send::Test->clear, '->clear returns true' );
+
+my $sender = Email::Send->new({ mailer => 'Test' });
+isa_ok( $sender, 'Email::Send' );
+
+my $i = 0;
+$sender->message_modifier(sub {
+ my ($self, $message, $arg) = @_;
+ $message->header_set('X-Whatever' => $i++);
+});
+
+my $message = <<'END_MESSAGE';
+From: mom at house.example.com
+To: dad at house.example.com
+Subject: test message
+
+This is the last time I clean up your socks.
+END_MESSAGE
+
+$sender->send($message); # once!
+$sender->send($message); # twice!
+
+my @emails = Email::Send::Test->emails;
+
+is(@emails, 2, "we've sent two mails");
+
+is($emails[0]->header('X-Whatever'), 0, "first message has X-Whatever: 0");
+is($emails[1]->header('X-Whatever'), 1, "second message has X-Whatever: 1");
Modified: packages/libemail-send-perl/branches/upstream/current/t/no-import.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/no-import.t?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/no-import.t (original)
+++ packages/libemail-send-perl/branches/upstream/current/t/no-import.t Tue Jul 25 14:02:07 2006
@@ -1,10 +1,9 @@
#!perl
use strict;
-use warnings;
use lib 't/lib';
-use Test::More 'no_plan';
+use Test::More tests => 3;
BEGIN { use_ok('Email::Send', ()); }
Modified: packages/libemail-send-perl/branches/upstream/current/t/object-mailer.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/object-mailer.t?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/object-mailer.t (original)
+++ packages/libemail-send-perl/branches/upstream/current/t/object-mailer.t Tue Jul 25 14:02:07 2006
@@ -1,5 +1,4 @@
-use Test::More qw[no_plan];
-# $Id: classic.t,v 1.1 2006/01/17 22:11:38 cwest Exp $
+use Test::More tests => 8;
use strict;
$^W =1;
Added: packages/libemail-send-perl/branches/upstream/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/pod-coverage.t?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/pod-coverage.t (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/pod-coverage.t Tue Jul 25 14:02:07 2006
@@ -1,0 +1,13 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.08";
+plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage"
+ if $@;
+
+# Having to trustme these is obnoxious. It would be nice if there was a base
+# class for mailers. Then again, whatever. -- rjbs, 2006-07-06
+all_pod_coverage_ok({
+ trustme => [ qw(send is_available) ],
+ coverage_class => 'Pod::Coverage::CountParents'
+});
Added: packages/libemail-send-perl/branches/upstream/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/pod.t?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/pod.t (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/pod.t Tue Jul 25 14:02:07 2006
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
Modified: packages/libemail-send-perl/branches/upstream/current/t/sendmail.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/sendmail.t?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/sendmail.t (original)
+++ packages/libemail-send-perl/branches/upstream/current/t/sendmail.t Tue Jul 25 14:02:07 2006
@@ -38,6 +38,7 @@
&& ! -x '/usr/bin/sendmail';
local $ENV{PATH} = '/usr/bin:/usr/sbin';
+ $ENV{PATH} =~ tr/:/;/ if $^O =~ /Win/;
my $path = Email::Send::Sendmail->_find_sendmail;
is( $path, '/usr/sbin/sendmail', 'found sendmail in /usr/sbin' );
}
@@ -106,12 +107,13 @@
my $return = $sender->send($email);
ok( $return, 'send() succeeded with executable sendmail in path' );
- unless ( -f 'sendmail.log' ) {
- fail( 'sendmail did not write sendmail.log' );
- last SKIP;
+ if ( -f 'sendmail.log' ) {
+ open my $fh, '<sendmail.log'
+ or die "Cannot read sendmail.log: $!";
+ my $log = join '', <$fh>;
+ like( $log, qr/From: Casey West/, 'log contains From header' );
+ } else {
+ fail( 'cannot check sendmail log contents' );
+ last SKIP;
}
- open my $fh, '<sendmail.log'
- or die "Cannot read sendmail.log: $!";
- my $log = join '', <$fh>;
- like( $log, qr/From: Casey West/, 'log contains From header' );
}
Modified: packages/libemail-send-perl/branches/upstream/current/t/test.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/test.t?rev=3318&op=diff
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/test.t (original)
+++ packages/libemail-send-perl/branches/upstream/current/t/test.t Tue Jul 25 14:02:07 2006
@@ -1,5 +1,4 @@
-use Test::More qw[no_plan];
-# $Id: test.t,v 1.4 2005/05/11 03:01:26 cwest Exp $
+use Test::More tests => 3;
use strict;
$^W =1;
Added: packages/libemail-send-perl/branches/upstream/current/t/without.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-send-perl/branches/upstream/current/t/without.t?rev=3318&op=file
==============================================================================
--- packages/libemail-send-perl/branches/upstream/current/t/without.t (added)
+++ packages/libemail-send-perl/branches/upstream/current/t/without.t Tue Jul 25 14:02:07 2006
@@ -1,0 +1,26 @@
+use Test::More;
+use strict;
+$^W = 1;
+
+BEGIN {
+ plan skip_all => "these tests require Test::Without::Module"
+ unless eval "require Test::Without::Module; 1";
+
+ plan tests => 3;
+
+ Test::Without::Module->import(qw(Email::Abstract));
+}
+
+use lib 't/lib';
+
+BEGIN { use_ok('Email::Send', 'Test'); }
+
+{ # unknown message type
+ my $message = bless \(my $x = 0), "Mail::Ain't::Known";
+ my $rv = send(Test => $message);
+ ok(!$rv, "sending with unknown message class is false");
+
+ # I don't like this error. We found something, we just don't know what.
+ # -- rjbs, 2006-07-06
+ like("$rv", qr/no message found/i, "expected error message");
+}
More information about the Pkg-perl-cvs-commits
mailing list