r41148 - in /branches/upstream/libtest-email-perl/current: Changes MANIFEST META.yml Makefile.PL README lib/ lib/Test/ lib/Test/Email.pm lib/Test/POP3.pm t/ t/01_login.t t/02_wait.t t/03_headers.t t/04_body.t t/05_email.t
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Mon Aug 3 07:43:20 UTC 2009
Author: ryan52-guest
Date: Mon Aug 3 07:43:15 2009
New Revision: 41148
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41148
Log:
Load /tmp/tmp.MRBUSPeJAw/to_upload/Test-Email-0.07 into
branches/upstream/libtest-email-perl/current.
Added:
branches/upstream/libtest-email-perl/current/Changes (with props)
branches/upstream/libtest-email-perl/current/MANIFEST (with props)
branches/upstream/libtest-email-perl/current/META.yml (with props)
branches/upstream/libtest-email-perl/current/Makefile.PL (with props)
branches/upstream/libtest-email-perl/current/README (with props)
branches/upstream/libtest-email-perl/current/lib/
branches/upstream/libtest-email-perl/current/lib/Test/
branches/upstream/libtest-email-perl/current/lib/Test/Email.pm (with props)
branches/upstream/libtest-email-perl/current/lib/Test/POP3.pm (with props)
branches/upstream/libtest-email-perl/current/t/
branches/upstream/libtest-email-perl/current/t/01_login.t (with props)
branches/upstream/libtest-email-perl/current/t/02_wait.t (with props)
branches/upstream/libtest-email-perl/current/t/03_headers.t (with props)
branches/upstream/libtest-email-perl/current/t/04_body.t (with props)
branches/upstream/libtest-email-perl/current/t/05_email.t (with props)
Added: branches/upstream/libtest-email-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/Changes?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/Changes (added)
+++ branches/upstream/libtest-email-perl/current/Changes Mon Aug 3 07:43:15 2009
@@ -1,0 +1,18 @@
+Revision history for Perl extension Test::Email.
+
+0.07 Oct 23, 2008
+ - diag, thanks to Chia-liang Kao
+
+0.06 Jun 27 2007
+ - parts_ok
+ - mime_type_ok
+
+0.04 Jun 9 2007
+ - small, significant fix for CPAN
+
+0.03 Jun 6 2007
+ - first release version
+
+0.01 Tue May 8 18:37:20 2007
+ - original version; created by h2xs 1.23 with options
+ -AXn Test::Email
Propchange: branches/upstream/libtest-email-perl/current/Changes
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/MANIFEST?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/MANIFEST (added)
+++ branches/upstream/libtest-email-perl/current/MANIFEST Mon Aug 3 07:43:15 2009
@@ -1,0 +1,12 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/01_login.t
+t/02_wait.t
+t/03_headers.t
+t/04_body.t
+t/05_email.t
+lib/Test/Email.pm
+lib/Test/POP3.pm
+META.yml Module meta-data (added by MakeMaker)
Propchange: branches/upstream/libtest-email-perl/current/MANIFEST
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/META.yml?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/META.yml (added)
+++ branches/upstream/libtest-email-perl/current/META.yml Mon Aug 3 07:43:15 2009
@@ -1,0 +1,15 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Test-Email
+version: 0.07
+version_from: lib/Test/Email.pm
+installdirs: site
+requires:
+ Mail::POP3Client: 2
+ Mail::Sendmail: 0.79
+ MIME::Entity: 5.4
+ MIME::Parser: 5.4
+ Test::Builder: 0.7
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Propchange: branches/upstream/libtest-email-perl/current/META.yml
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/Makefile.PL?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/Makefile.PL (added)
+++ branches/upstream/libtest-email-perl/current/Makefile.PL Mon Aug 3 07:43:15 2009
@@ -1,0 +1,39 @@
+use strict;
+use warnings FATAL => 'all';
+
+use ExtUtils::MakeMaker;
+
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+my %config = (
+ NAME => 'Test::Email',
+ VERSION_FROM => 'lib/Test/Email.pm', # finds $VERSION
+ PREREQ_PM => {
+ 'Mail::POP3Client' => 2,
+ 'MIME::Parser' => 5.4,
+ 'MIME::Entity' => 5.4,
+ 'Test::Builder' => 0.7,
+ 'Mail::Sendmail' => 0.79, # for tests
+ },
+ ABSTRACT_FROM => 'lib/Test/Email.pm',
+ AUTHOR => 'James Tolley <james at cpan.org>',
+ test => { TESTS => 't/05_email.t' },
+);
+
+# find out about running tests for POP3
+if (! exists $ENV{TEST_POP3_HOST}) {
+ print "\nTo run tests for Test::POP3, set ".
+ "the following environment variables:\n".
+ "TEST_POP3_HOST, TEST_POP3_USER, TEST_POP3_PASS, ".
+ "TEST_POP3_SMTP, and TEST_POP3_EMAIL.\n".
+ "Then run this script again.\n\n";
+
+ sleep 5;
+}
+else {
+ $config{test}->{TESTS} = join ' ', glob 't/*.t';
+}
+
+WriteMakefile(%config);
+
Propchange: branches/upstream/libtest-email-perl/current/Makefile.PL
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/README?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/README (added)
+++ branches/upstream/libtest-email-perl/current/README Mon Aug 3 07:43:15 2009
@@ -1,0 +1,47 @@
+Test-Email version 0.04
+=======================
+
+INSTALLATION
+
+To install this module type the following:
+
+ # optionally, set environment variables for testing; see below; then...
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+TESTING Test::POP3
+
+If you would like to test Test::POP3 as well as Test::Email, the test scripts
+will need to have access to a POP3 account, as well as SMTP server information.
+You can let it know that you want to run these tests, and also let it know how
+to run the tests, by setting these environment variables:
+
+TEST_POP3_HOST - the POP3 server
+TEST_POP3_USER - the login for that server
+TEST_POP3_PASS - the POP3 password
+TEST_POP3_SMTP - the outgoing mail server
+TEST_POP3_EMAIL - used as both the from and to address of the test emails
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+MIME::Parser
+MIME::Entity
+Test::Builder
+Mail::POP3Client
+Mail::Sendmail - tests use this to send mail when testing Test::POP3
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2007-2008 by James Tolley <james at cpan.org>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.8 or,
+at your option, any later version of Perl 5 you may have available.
+
+
Propchange: branches/upstream/libtest-email-perl/current/README
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/lib/Test/Email.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/lib/Test/Email.pm?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/lib/Test/Email.pm (added)
+++ branches/upstream/libtest-email-perl/current/lib/Test/Email.pm Mon Aug 3 07:43:15 2009
@@ -1,0 +1,324 @@
+package Test::Email;
+use strict;
+use warnings;
+
+use Test::Builder;
+use MIME::Parser;
+use Carp 'croak';
+
+use base 'MIME::Entity';
+
+our $VERSION = '0.07';
+
+my $TEST = Test::Builder->new();
+
+my $DEBUG = 0;
+# for quietly failing .t tests which we expect to fail
+$Test::Email::QUIET_DIAG = 0;
+
+sub ok {
+ my ($self, $test_href, $desc) = @_;
+
+ my $pass = $self->_run_tests($test_href);
+
+ my $ok = $TEST->ok($pass, $desc);
+
+ return $ok;
+}
+
+sub header_ok {
+ my ($self, $header_name, $argument, $description) = @_;
+
+ my $value = $self->head()->get($header_name);
+ chomp($value);
+
+ my $pass = $TEST->ok($value eq $argument, $description);
+
+ return $pass;
+}
+
+sub header_like {
+ my ($self, $header_name, $argument, $description) = @_;
+
+ my $value = $self->head()->get($header_name);
+ chomp($value);
+
+ my $pass = $TEST->like($value, $argument, $description);
+
+ return $pass;
+}
+
+sub header_is {
+ my ($self, $header_name, $argument, $description) = @_;
+
+ my $value = $self->head()->get($header_name);
+ chomp($value);
+
+ my $pass = $TEST->is_eq($value, $argument, $description);
+
+ return $pass;
+}
+
+sub body_ok {
+ my ($self, $argument, $description) = @_;
+
+ my $body = join '', @{ $self->body() };
+
+ $body =~ s/\n+$//;
+ $argument =~ s/\n+$//;
+
+ my $pass = $TEST->ok($body eq $argument, $description);
+
+ return $pass;
+}
+
+sub body_like {
+ my ($self, $argument, $description) = @_;
+
+ my $body = join '', @{ $self->body() };
+
+ $body =~ s/\n+$//;
+ $argument =~ s/\n+$//;
+
+ my $pass = $TEST->like($body, $argument, $description);
+
+ return $pass;
+}
+
+sub body_is {
+ my ($self, $argument, $description) = @_;
+
+ my $body = join '', @{ $self->body() };
+
+ $body =~ s/\n+$//;
+ $argument =~ s/\n+$//;
+
+ my $pass = $TEST->is_eq($body, $argument, $description);
+
+ return $pass;
+}
+
+sub parts_ok {
+ my ($self, $part_count, $description) = @_;
+
+ my $pass = $TEST->is_num($part_count, scalar($self->parts()), $description);
+
+ return $pass;
+}
+
+sub mime_type_ok {
+ my ($self, $type, $description) = @_;
+
+ my $pass = $TEST->is_eq($type, $self->mime_type(), $description);
+
+ return $pass;
+}
+
+# run all tests against this email, return success
+sub _run_tests {
+ my ($self, $test_href) = @_;
+
+ for my $key (keys %$test_href) {
+ my $passed = $self->_test($key, $test_href->{$key});
+ if (!$passed) {
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+my %test_for = (
+ header => \&_test_header,
+ body => \&_test_body,
+);
+
+# perform one test against one email
+sub _test {
+ my ($self, $key, $test) = @_;
+
+ _debug("in _test($self, $key, $test)");
+
+ if (my $test_cref = $test_for{$key}) {
+ return $test_cref->($self, $test);
+ }
+ else {
+ return $test_for{header}->($self, $key, $test);
+ }
+}
+
+sub _test_header {
+ my ($self, $header, $test) = @_;
+
+ _debug("in _test_header($self, $header, $test)");
+
+ my $value = $self->head()->get($header) || '';
+ chomp($value);
+
+ return _do_test($value, $test, $header);
+}
+
+sub _test_body {
+ my ($self, $test) = @_;
+
+ _debug("in _test_body($self, $test)");
+
+ my $body = join '', @{ $self->body() };
+ return _do_test($body, $test, 'body');
+}
+
+sub _do_test {
+ my ($thing, $test, $what) = @_;
+
+ _debug("Testing '$thing' against $test");
+
+ my $type = ref $test;
+ if ($type eq 'Regexp') {
+ my $ret = $thing =~ $test;
+ if (!$ret && !$Test::Email::QUIET_DIAG) {
+ $TEST->diag("Email $what:");
+ $TEST->diag(sprintf <<DIAGNOSTIC, $thing, "doesn't match", $test);
+ %s
+ %13s '%s'
+DIAGNOSTIC
+ }
+ return $ret;
+ }
+ elsif ($type eq '') {
+ $thing =~ s/\n+$//;
+ $test =~ s/\n+$//;
+ my $ret = $thing eq $test;
+ if (!$ret && !$Test::Email::QUIET_DIAG) {
+ $TEST->diag("Email $what:");
+ $TEST->_is_diag($thing, 'eq', $test);
+ }
+ return $ret;
+ }
+ else {
+ croak "I don't know how to test for this type: '$type'";
+ }
+}
+
+sub _debug {
+ my ($msg) = @_;
+ warn $msg."\n" if $DEBUG;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Test::Email - Test Email Contents
+
+=head1 SYNOPSIS
+
+ use Test::Email;
+
+ # is-a MIME::Entity
+ my $email = Test::Email->new(\@lines);
+
+ # all-in-one test
+ $email->ok({
+ # optional search parameters
+ from => ($is or qr/$regex/),
+ subject => ($is or qr/$regex/),
+ body => ($is or qr/$regex/),
+ headername => ($is or qr/$regex/),
+ }, "passed tests");
+
+ # single-test header methods
+ $email->header_is($header_name, $value, "$header_name matches");
+ $email->header_ok($header_name, $value, "$header_name matches");
+ $email->header_like($header_name, qr/regex/, "$header_name matches");
+
+ # single-test body methods
+ $email->body_is($header_name, $value, "$header_name matches");
+ $email->body_ok($header_name, $value, "$header_name matches");
+ $email->body_like($header_name, qr/regex/, "$header_name matches");
+
+ # how many MIME parts does the messages contain?
+ $email->parts_ok($parts_count, "there were $parts_count parts found");
+
+ # what is the MIME type of the firs part
+ my @parts = $email->parts(); # see MIME::Entity
+ $parts[0]->mime_type_ok('test/html', 'the first part is type text/html');
+
+=head1 DESCRIPTION
+
+Please note that this is ALPHA CODE. As such, the interface is likely to
+change.
+
+Test::Email is a subclass of MIME::Entity, with the above methods.
+If you want the messages fetched from a POP3 account, use Test::POP3.
+
+Tests for equality remove trailing newlines from strings before testing.
+This is because some mail messages have newlines appended to them during
+the mailing process, which could cause unnecessary confusion.
+
+This module should be 100% self-explanatory. If not, then please look at
+L<Test::Simple> and L<Test::More> for clarification.
+
+=head1 METHODS
+
+=over
+
+=item C<my $email = Test::Email-E<gt>new($lines_aref);>
+
+This is identical to C<MIME::Entity-E<gt>new()>. See there for details.
+
+=item C<$email-E<gt>ok($test_href, $description);>
+
+Using this method, you can test multiple qualities of an email message
+with one test. This will execute the tests as expected and will produce
+output just like C<Test::Simple::ok> and C<Test::More::ok>. Keys for
+C<$test_href> are either C<body>, or they are considered to be the name
+of a header, case-insensitive.
+
+=item single-test methods
+
+The single-test methods in the synopsis above are very similar to their
+counterparts in L<Test::Simple> and L<Test::More>. Please consult those
+modules for documentation.
+
+Please note that tests for equality remove newlines from their operands
+before testing. This is because some email messages have newlines appended
+to them during mailing.
+
+=item C<my $ok = $email->parts_ok($parts_count, $description);>
+
+Check to see how many MIME parts this email contains. Each part is also a
+Test::Email object.
+
+=item C<my $ok = $email->mime_type_ok($expected_mime_type, $description);>
+
+Check the MIME type of an email or an email part.
+
+=back
+
+=head1 EXPORT
+
+None.
+
+=head1 SEE ALSO
+
+L<Test::Builder>, L<Test::Simple>, L<Test::More>, L<Test::POP3>
+
+=head1 TODO
+
+I am open to suggestions.
+
+=head1 AUTHOR
+
+James Tolley, E<lt>james at cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2007-2008 by James Tolley
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.8 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
Propchange: branches/upstream/libtest-email-perl/current/lib/Test/Email.pm
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/lib/Test/POP3.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/lib/Test/POP3.pm?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/lib/Test/POP3.pm (added)
+++ branches/upstream/libtest-email-perl/current/lib/Test/POP3.pm Mon Aug 3 07:43:15 2009
@@ -1,0 +1,357 @@
+package Test::POP3;
+use strict;
+use warnings;
+
+use Test::Builder;
+use Mail::POP3Client;
+use Test::Email;
+use MIME::Parser;
+use Carp 'croak';
+
+our $VERSION = '0.07';
+
+my $TEST = Test::Builder->new();
+
+my $DEBUG = 0;
+
+sub new {
+ my ($class, $params_href) = @_;
+
+ my $self = bless {
+ _connected => 0,
+ _host => $params_href->{host},
+ _user => $params_href->{user},
+ _pass => $params_href->{pass},
+ _emails_href => {},
+ _email_id => 1,
+ }, $class;
+
+ return unless $self->_connect();
+ return $self;
+}
+
+sub ok {
+ my ($self, $test_href, $desc) = @_;
+
+ my $pass = $self->_run_tests($test_href);
+
+ my $ok = $TEST->ok($pass, $desc);
+
+ return $ok;
+}
+
+# return the number of emails deleted
+sub delete_all {
+ my $self = shift;
+
+ # download the messages from the server
+ $self->_download_messages();
+
+ # count the number of emails
+ my $count = keys %{$self->{_emails_href}};
+
+ # delete the messages
+ $self->{_emails_href} = {};
+
+ return $count;
+}
+
+# this deletes email from the cache
+sub get_email {
+ my $self = shift;
+
+ my @email = values %{ $self->{_emails_href} };
+
+ $self->{_emails_href} = {};
+
+ return @email;
+}
+
+# arg: should we check the server? default: no
+sub get_email_count {
+ my $self = shift;
+ my $check_server = shift;
+
+ if ($check_server) {
+ $self->_download_messages();
+ }
+
+ return scalar keys %{ $self->{_emails_href} };
+}
+
+# return the number of messages found
+sub wait_for_email_count {
+ my ($self, $looking_for_count, $timeout) = @_;
+ $timeout ||= 30;
+
+ my $start = time;
+ _debug("start: $start");
+
+ my $i = 0;
+ while ($start + $timeout > time) {
+ _debug('in loop');
+
+ my $email_count = $self->get_email_count(1); # check the server
+ _debug("email count: '$email_count'");
+
+ if ($email_count >= $looking_for_count) {
+ _debug('returning');
+ return $email_count;
+ }
+
+ if ($start + $timeout > time) {
+ _debug('sleeping');
+ sleep 1;
+ }
+ }
+
+ _debug("after loop($start + $timeout): @{[time]}");
+
+ return $self->get_email_count(0); # don't check the server again
+}
+
+# run all tests against all emails, return success
+sub _run_tests {
+ my ($self, $test_href) = @_;
+
+ # only check already-downloaded messages
+ for my $email_id (keys %{ $self->{_emails_href} }) {
+ my $email = $self->{_emails_href}->{$email_id};
+
+ my $passed = $email->_run_tests($test_href);
+ next unless $passed;
+
+ # this email passed the tests, delete it
+ my $subject = $email->head()->get('subject');
+ _debug("Deleting passed email message: $subject");
+
+ delete $self->{_emails_href}->{$email_id};
+ return 1;
+ }
+
+ return; # no emails passed all tests
+}
+
+sub _debug {
+ my ($msg) = @_;
+ warn $msg."\n" if $DEBUG;
+}
+
+sub _connect {
+ my $self = shift;
+
+ _debug("about to connect");
+
+ return if $self->{_connected};
+
+ _debug("connecting");
+
+ my $host = $self->{_host} || croak "I need a host";
+ my $user = $self->{_user} || croak "I need a user";
+ my $pass = $self->{_pass} || croak "I need a pass";
+
+ $self->{_pop3} = Mail::POP3Client->new(
+ HOST => $host,
+ USER => $user,
+ PASSWORD => $pass,
+ DEBUG => $DEBUG,
+ AUTH_MODE => 'PASS',
+ ) or warn "failed to connect to '$host'"
+ and return;
+
+ return $self->{_connected} = 1;
+}
+
+sub _disconnect {
+ my $self = shift;
+
+ _debug("disconnecting");
+
+ if ($self->{_connected}) {
+ $self->_pop3()->Close();
+ }
+
+ $self->{_connected} = 0;
+
+ return 1;
+}
+
+sub DESTROY {
+ shift()->_disconnect();
+}
+
+sub _pop3 {
+ return shift()->{_pop3};
+}
+
+# download the messages and store them locally
+# try once
+# return the number downloaded
+sub _download_messages {
+ my $self = shift;
+
+ _debug('downloading');
+
+ $self->_connect();
+
+ my $pop3 = $self->_pop3();
+ my $parser = $self->get_parser();
+
+ my $msg_count = $self->_pop3()->Count();
+ for my $msgnum (1..$msg_count) {
+ # create local unique id
+ my $id = $self->{_email_id}++;
+
+ # get the message as a string, create Test::Email
+ my $msg = $pop3->HeadAndBody($msgnum);
+ my $entity = $parser->parse_data($msg);
+
+ # store in $self
+ $self->{_emails_href}->{$id} = $entity;
+
+ # delete from server
+ $pop3->Delete($msgnum);
+ }
+
+ $self->_disconnect();
+
+ _debug("returning found msg count: '$msg_count'");
+ return $msg_count;
+}
+
+sub get_parser {
+ my $self = shift;
+
+ if (! exists $self->{_parser}) {
+ my $parser = MIME::Parser->new();
+ $parser->interface(ENTITY_CLASS => 'Test::Email');
+ $self->{_parser} = $parser;
+ }
+
+ return $self->{_parser};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Test::POP3 - Automate Email Delivery Tests
+
+=head1 SYNOPSIS
+
+ use Test::POP3;
+
+ my $pop = Test::POP3->new({
+ host => $host,
+ user => $user,
+ pass => $pass,
+ });
+
+ # this will delete all messages from the server
+ ok($count == $pop->wait_for_email_count($count,$timeout),"got $count");
+
+ # find and delete a single email message which matches these rules
+ # see Test::Email for more information
+ $pop->ok({
+ # optional search parameters
+ to => ($is or qr/is like/),
+ from => ($is or qr/is like/),
+ subject => ($is or qr/is like/),
+ body => ($is or qr/is like/),
+ headername => ($is or qr/is like/),
+ }, "got message");
+
+ ok($pop->get_email_count() == $count, "$count emails in cache");
+
+ # get the Test::Email object
+ my @email = $pop->get_email();
+
+ ok($pop->delete_all() == 2, "deleted 2 messages");
+
+ # tweak MIME::Parser settings
+ my $parser = $pop->get_parser();
+
+=head1 DESCRIPTION
+
+Please note that this is ALPHA CODE. As such, the interface is likely to
+change.
+
+This module can help you to create automated tests of email
+delivered to a POP3 account.
+
+Messages retrieved from the server but not yet matched by a test will
+be cached until either that message is the first to pass a test, or is
+returned by C<$pop3-E<gt>get_email()>. Messages returned are L<Test::Email>
+objects.
+
+=head1 METHODS
+
+=over
+
+=item C<my $pop = Test::POP3-E<gt>new($href);>
+
+The arguments passed in the href are host, user, and pass.
+
+=item C<my $count = $pop-E<gt>wait_for_email_count($count, $timeout_seconds?);>
+
+B<Calling this method will result in all messages being deleted from the server.>
+This will wait up to $timeout seconds for there to be $count unprocessed
+messages found on the server. After $count or more messages are found,
+or after $timeout seconds, the current email count will be returned. $timeout_seconds
+defaults to 30.
+
+=item C<my @email = $pop-E<gt>get_email();>
+
+Get all of the email messages currently in local cache. You should call
+C<$pop3-E<gt>wait_for_email_count($count)> before calling this method if
+you think that there may be messages on the server yet to be retrieved.
+Calling this method will cause the local cache to be emptied. Email messages
+returned will be L<Test::Email> objects.
+
+=item C<my $count = $pop-E<gt>get_email_count($check_server);>
+
+This will return the number of email messages in the cache. If C<$check_server>
+is true, then the server will be checked once before the count is determined.
+If you would like to wait for messages to arrive on the server, and then be
+downloaded prior to counting, use C<$pop3-E<gt>wait_for_email_count()>.
+
+=item C<my $ok = $pop-E<gt>ok($test_href, $description);>
+
+Calling this method will cause the email in the local cache to be tested,
+according to the contents of C<$test_href>. The first email which passes
+all tests will be deleted from the local cache. Since this method only checks
+the local cache, you will want to call C<$pop3-E<gt>wait_for_email_count()>
+before calling this method. C<ok> will produce TAP output, identical to
+C<Test::Simple::ok> and C<Test::More::ok>.
+
+=item C<my $parser = $pop-E<gt>get_parser();>
+
+L<Test::POP3> uses L<MIME::Parser> to process the messages. (MIME is not yet
+handled by C<Test::Email>, it will be soon.) Use this method if you want to
+manage the parser.
+
+=back
+
+=head1 EXPORT
+
+None.
+
+=head1 SEE ALSO
+
+L<Test::Builder>, L<Test::Simple>, L<Test::More>, L<MIME::Parser>
+
+=head1 AUTHOR
+
+James Tolley, L<E<lt>james at cpan.orgE<gt>>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2007 by James Tolley
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.8 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
Propchange: branches/upstream/libtest-email-perl/current/lib/Test/POP3.pm
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/t/01_login.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/t/01_login.t?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/t/01_login.t (added)
+++ branches/upstream/libtest-email-perl/current/t/01_login.t Mon Aug 3 07:43:15 2009
@@ -1,0 +1,28 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More tests => 2;
+BEGIN { use_ok('Test::POP3') };
+
+#########################
+
+my ($host, $user, $pass) = get_info();
+
+SKIP: {
+ skip 'No POP3 settings found', 2 unless $host;
+
+ my $pop3 = Test::POP3->new({
+ host => $host,
+ user => $user,
+ pass => $pass,
+ });
+ ok($pop3,'new & login');
+}
+
+sub get_info {
+ return map $ENV{"TEST_POP3_$_"}, map uc, qw(host user pass smtp email);
+}
+
+__END__
+
Propchange: branches/upstream/libtest-email-perl/current/t/01_login.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/t/02_wait.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/t/02_wait.t?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/t/02_wait.t (added)
+++ branches/upstream/libtest-email-perl/current/t/02_wait.t Mon Aug 3 07:43:15 2009
@@ -1,0 +1,70 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Data::Dumper;
+use Mail::Sendmail;
+use Test::More tests => 5;
+BEGIN { use_ok('Test::POP3') };
+
+#########################
+
+my ($host, $user, $pass, $smtp, $email) = get_info();
+
+
+SKIP: {
+ skip 'No POP3 settings found', 5 unless $host;
+
+ my $pop3 = Test::POP3->new({
+ host => $host,
+ user => $user,
+ pass => $pass,
+ });
+
+ # no tmpfiles
+ my $parser = $pop3->get_parser();
+ $parser->output_to_core(1);
+
+ # no messages
+ $pop3->delete_all();
+ my $msg_count = $pop3->get_email_count(0);
+ is($msg_count, 0, 'no messages');
+
+ # send 3 messages
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 1',
+ message => 'message 1',
+ smtp => $smtp,
+ );
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 2',
+ message => 'message 2',
+ smtp => $smtp,
+ );
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 3',
+ message => 'message 3',
+ smtp => $smtp,
+ );
+
+ # then wait for them
+ is($pop3->wait_for_email_count(3,30), 3, 'waited for 3 messages');
+
+ is($pop3->delete_all(), 3, 'deleted 3 messages');
+
+ # then timeout waiting for a message that's not there
+ is($pop3->wait_for_email_count(1,10), 0, 'timed out');
+};
+
+sub get_info {
+ return map $ENV{"TEST_POP3_$_"}, map uc, qw(host user pass smtp email);
+}
+
+__END__
+
Propchange: branches/upstream/libtest-email-perl/current/t/02_wait.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/t/03_headers.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/t/03_headers.t?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/t/03_headers.t (added)
+++ branches/upstream/libtest-email-perl/current/t/03_headers.t Mon Aug 3 07:43:15 2009
@@ -1,0 +1,84 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Data::Dumper;
+use Mail::Sendmail;
+use Test::More tests => 7;
+BEGIN { use_ok('Test::POP3') };
+
+#########################
+
+my ($host, $user, $pass, $smtp, $email) = get_info();
+
+# don't surprise/confuse the user
+# we expect to fail some of these
+$Test::Email::QUIET_DIAG = 1;
+
+SKIP: {
+ skip 'No POP3 settings found', 5 unless $host;
+ my $pop3 = Test::POP3->new({
+ host => $host,
+ user => $user,
+ pass => $pass,
+ });
+
+ # no tmpfiles
+ my $parser = $pop3->get_parser();
+ $parser->output_to_core(1);
+
+ # no messages
+ $pop3->delete_all();
+ my $msg_count = $pop3->get_email_count(1);
+ is($msg_count, 0, 'no messages');
+
+ # send 3 messages
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 1',
+ message => 'message 1',
+ smtp => $smtp,
+ );
+ sleep 1;
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 2',
+ message => 'message 2',
+ smtp => $smtp,
+ );
+ sleep 1;
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 3',
+ message => 'message 3',
+ smtp => $smtp,
+ );
+
+ # then wait for them
+ is($pop3->wait_for_email_count(3), 3, 'found 3 messages');
+
+ $pop3->ok({
+ subject => qr/ 1$/,
+ }, 'subject regexp');
+
+ $pop3->ok({
+ subject => 'test 2',
+ }, 'subject string');
+
+ $pop3->ok({
+ subject => 'test 3',
+ 'content-type' => qr|text/plain|,
+ }, 'subject and content-type');
+
+ is($pop3->delete_all(), 0, 'no others to be deleted');
+};
+
+sub get_info {
+ return map $ENV{"TEST_POP3_$_"}, map uc, qw(host user pass smtp email);
+}
+
+__END__
+
Propchange: branches/upstream/libtest-email-perl/current/t/03_headers.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/t/04_body.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/t/04_body.t?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/t/04_body.t (added)
+++ branches/upstream/libtest-email-perl/current/t/04_body.t Mon Aug 3 07:43:15 2009
@@ -1,0 +1,96 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Data::Dumper;
+use Mail::Sendmail;
+use Test::More tests => 9;
+BEGIN { use_ok('Test::POP3') };
+
+#########################
+
+my $pc = 1;
+my ($host, $user, $pass, $smtp, $email) = get_info();
+
+# don't surprise/confuse the user
+# we expect to fail some of these
+$Test::Email::QUIET_DIAG = 1;
+
+SKIP: {
+ skip 'No POP3 settings found', 9 unless $host;
+ my $test = Test::POP3->new({
+ host => $host,
+ user => $user,
+ pass => $pass,
+ });
+
+ # no tmpfiles
+ my $parser = $test->get_parser();
+ $parser->output_to_core(1);
+
+ # no messages
+ $test->delete_all();
+ my $msg_count = $test->get_email_count(1);
+ is($msg_count, 0, 'no messages');
+
+ # send 3 messages
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 1',
+ message => 'message 1',
+ smtp => $smtp,
+ );
+ sleep 1;
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 2',
+ message => 'message 2',
+ smtp => $smtp,
+ );
+ sleep 1;
+ sendmail(
+ to => $email,
+ from => $email,
+ subject => 'test 3',
+ message => 'message 3',
+ smtp => $smtp,
+ );
+
+ # then wait for them
+ is($test->wait_for_email_count(3), 3, 'found 3 messages');
+
+ # fail a single test
+ ok(!$test->_run_tests({
+ body => qr/4/,
+ }, 'should not see this'), 'one wrong arg fails');
+
+ # fail part of a multiple test
+ ok(!$test->_run_tests({
+ body => qr/5/,
+ subject => 'test 1',
+ }, 'should not see this'), 'some wrong args fail');
+
+ $test->ok({
+ body => qr/2/,
+ }, 'body regexp');
+
+ $test->ok({
+ body => 'message 3',
+ }, 'body string');
+
+ $test->ok({
+ body => qr/1/,
+ subject => 'test 1',
+ }, 'body and subject');
+
+ is($test->delete_all(), 0, 'no others to be deleted');
+};
+
+sub get_info {
+ return map $ENV{"TEST_POP3_$_"}, map uc, qw(host user pass smtp email);
+}
+
+__END__
+
Propchange: branches/upstream/libtest-email-perl/current/t/04_body.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libtest-email-perl/current/t/05_email.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-email-perl/current/t/05_email.t?rev=41148&op=file
==============================================================================
--- branches/upstream/libtest-email-perl/current/t/05_email.t (added)
+++ branches/upstream/libtest-email-perl/current/t/05_email.t Mon Aug 3 07:43:15 2009
@@ -1,0 +1,36 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Data::Dumper;
+use Mail::Sendmail;
+use MIME::Parser;
+use Test::More tests => 7;
+BEGIN { use_ok('Test::Email') };
+
+#########################
+
+my $parser = MIME::Parser->new();
+$parser->interface(ENTITY_CLASS => 'Test::Email');
+$parser->output_to_core(1); # no tmpfiles
+
+# setup the email for testing
+my $email = $parser->parse_data(<<'END');
+From:<james at localhost>
+To:<james at localhost>
+Subject: Tester
+
+This is the message
+END
+
+# pass some tests
+$email->header_like('to', qr/localhost/, 'to');
+$email->header_ok('from', '<james at localhost>', 'from');
+$email->header_is('subject', 'Tester', 'subject');
+
+$email->body_like(qr/^This is/, 'body_like');
+$email->body_ok('This is the message', 'body_ok');
+$email->body_is('This is the message', 'body_is');
+
+__END__
+
Propchange: branches/upstream/libtest-email-perl/current/t/05_email.t
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list