Test-Email-0.07/ 777 0 0 0 11100272502 6345 5Test-Email-0.07/.svn/ 777 0 0 0 11100272471 7236 5Test-Email-0.07/.svn/entries 777 0 0 1665 11100272470 10724 09 dir 8 file:///C:/svn/test-email file:///C:/svn 2007-06-27T05:05:17.453125Z 8 James svn:special svn:externals svn:needs-lock 8b885719-6a82-7f43-b875-eeafde72ba5e t dir lib dir MANIFEST file 2007-06-27T05:05:41.890625Z 0eccd54933df7a4b8e27bf47244aab5b 2007-06-27T05:05:17.453125Z 8 James META.yml file 14 2008-10-24T07:09:48.953125Z 2b0f990a94ae7e1b50c3b0767d6238e0 2008-10-24T07:11:52.187500Z 14 James 498 Makefile.PL file 14 2008-10-24T07:10:08.984375Z 8ffca98a6462fa68e5e706a475bb7441 2008-10-24T07:11:52.187500Z 14 James 1135 Changes file 14 2008-10-24T06:23:22.281250Z d5d348b0a46aae2c902965bc6651e579 2008-10-24T07:11:52.187500Z 14 James 394 Makefile.old file 14 deleted README file 14 2008-10-24T06:26:31.968750Z aef8fc3d437dc6bbed37c74ab95f4d93 2008-10-24T07:11:52.187500Z 14 James 1380 Test-Email-0.07/.svn/format 777 0 0 2 11100264760 10446 09 Test-Email-0.07/.svn/prop-base/ 777 0 0 0 10640370045 11132 5Test-Email-0.07/.svn/props/ 777 0 0 0 10640370045 10405 5Test-Email-0.07/.svn/text-base/ 777 0 0 0 11100272470 11131 5Test-Email-0.07/.svn/text-base/Changes.svn-base 777 0 0 612 11100272470 14203 0Revision 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 Test-Email-0.07/.svn/text-base/Makefile.PL.svn-base 777 0 0 2157 11100272470 14710 0use 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 ', 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); Test-Email-0.07/.svn/text-base/MANIFEST.svn-base 777 0 0 330 10640370045 14043 0Changes 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) Test-Email-0.07/.svn/text-base/META.yml.svn-base 777 0 0 762 11100272470 14167 0# 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 Test-Email-0.07/.svn/text-base/README.svn-base 777 0 0 2544 11100272470 13616 0Test-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 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. Test-Email-0.07/.svn/tmp/ 777 0 0 0 11100272470 10035 5Test-Email-0.07/.svn/tmp/prop-base/ 777 0 0 0 10640370045 11732 5Test-Email-0.07/.svn/tmp/props/ 777 0 0 0 10640370045 11205 5Test-Email-0.07/.svn/tmp/text-base/ 777 0 0 0 11100272470 11731 5Test-Email-0.07/Changes 777 0 0 612 11100264732 7710 0Revision 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 Test-Email-0.07/lib/ 777 0 0 0 10640370045 7124 5Test-Email-0.07/lib/.svn/ 777 0 0 0 11100272467 10011 5Test-Email-0.07/lib/.svn/entries 777 0 0 305 11100272467 11446 09 dir 8 file:///C:/svn/test-email/lib file:///C:/svn 2007-06-27T05:05:17.453125Z 8 James svn:special svn:externals svn:needs-lock 8b885719-6a82-7f43-b875-eeafde72ba5e Test dir Test-Email-0.07/lib/.svn/format 777 0 0 2 11100272467 11217 09 Test-Email-0.07/lib/.svn/prop-base/ 777 0 0 0 10640370045 11700 5Test-Email-0.07/lib/.svn/props/ 777 0 0 0 10640370045 11153 5Test-Email-0.07/lib/.svn/text-base/ 777 0 0 0 10640370045 11704 5Test-Email-0.07/lib/.svn/tmp/ 777 0 0 0 11100272467 10611 5Test-Email-0.07/lib/.svn/tmp/prop-base/ 777 0 0 0 10640370045 12500 5Test-Email-0.07/lib/.svn/tmp/props/ 777 0 0 0 10640370045 11753 5Test-Email-0.07/lib/.svn/tmp/text-base/ 777 0 0 0 10640370045 12504 5Test-Email-0.07/lib/Test/ 777 0 0 0 10640512404 10040 5Test-Email-0.07/lib/Test/.svn/ 777 0 0 0 11100272471 10723 5Test-Email-0.07/lib/Test/.svn/entries 777 0 0 742 11100272470 12364 09 dir 8 file:///C:/svn/test-email/lib/Test file:///C:/svn 2007-06-27T05:05:17.453125Z 8 James svn:special svn:externals svn:needs-lock 8b885719-6a82-7f43-b875-eeafde72ba5e Email.pm file 14 2008-10-24T07:00:52.250000Z 167ee289d3b40620aa58be36b297f9b9 2008-10-24T07:11:52.187500Z 14 James 7889 POP3.pm file 14 2008-10-24T06:57:14.031250Z 7962afa8bb00e4aa5301f129f91f6b07 2008-10-24T07:11:52.187500Z 14 James 9055 Test-Email-0.07/lib/Test/.svn/format 777 0 0 2 11100272467 12136 09 Test-Email-0.07/lib/Test/.svn/prop-base/ 777 0 0 0 10640370045 12617 5Test-Email-0.07/lib/Test/.svn/props/ 777 0 0 0 10640370045 12072 5Test-Email-0.07/lib/Test/.svn/text-base/ 777 0 0 0 11100272470 12616 5Test-Email-0.07/lib/Test/.svn/text-base/Email.pm.svn-base 777 0 0 17321 11100272470 16027 0package 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 <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 and L for clarification. =head1 METHODS =over =item Cnew($lines_aref);> This is identical to Cnew()>. See there for details. =item C<$email-Eok($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 and C. Keys for C<$test_href> are either C, 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 and L. 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 Cparts_ok($parts_count, $description);> Check to see how many MIME parts this email contains. Each part is also a Test::Email object. =item Cmime_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, L, L, L =head1 TODO I am open to suggestions. =head1 AUTHOR James Tolley, Ejames@cpan.orgE =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 Test-Email-0.07/lib/Test/.svn/text-base/POP3.pm.svn-base 777 0 0 21537 11100272470 15525 0package 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-Eget_email()>. Messages returned are L objects. =head1 METHODS =over =item Cnew($href);> The arguments passed in the href are host, user, and pass. =item Cwait_for_email_count($count, $timeout_seconds?);> B 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 Cget_email();> Get all of the email messages currently in local cache. You should call C<$pop3-Ewait_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 objects. =item Cget_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-Ewait_for_email_count()>. =item Cok($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-Ewait_for_email_count()> before calling this method. C will produce TAP output, identical to C and C. =item Cget_parser();> L uses L to process the messages. (MIME is not yet handled by C, it will be soon.) Use this method if you want to manage the parser. =back =head1 EXPORT None. =head1 SEE ALSO L, L, L, L =head1 AUTHOR James Tolley, Ljames@cpan.orgE> =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 Test-Email-0.07/lib/Test/.svn/tmp/ 777 0 0 0 11100272470 11522 5Test-Email-0.07/lib/Test/.svn/tmp/prop-base/ 777 0 0 0 10640370045 13417 5Test-Email-0.07/lib/Test/.svn/tmp/props/ 777 0 0 0 10640370045 12672 5Test-Email-0.07/lib/Test/.svn/tmp/text-base/ 777 0 0 0 11100272470 13416 5Test-Email-0.07/lib/Test/Email.pm 777 0 0 17321 11100271244 11530 0package 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 <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 and L for clarification. =head1 METHODS =over =item Cnew($lines_aref);> This is identical to Cnew()>. See there for details. =item C<$email-Eok($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 and C. Keys for C<$test_href> are either C, 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 and L. 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 Cparts_ok($parts_count, $description);> Check to see how many MIME parts this email contains. Each part is also a Test::Email object. =item Cmime_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, L, L, L =head1 TODO I am open to suggestions. =head1 AUTHOR James Tolley, Ejames@cpan.orgE =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 Test-Email-0.07/lib/Test/POP3.pm 777 0 0 21537 11100270712 11225 0package 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-Eget_email()>. Messages returned are L objects. =head1 METHODS =over =item Cnew($href);> The arguments passed in the href are host, user, and pass. =item Cwait_for_email_count($count, $timeout_seconds?);> B 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 Cget_email();> Get all of the email messages currently in local cache. You should call C<$pop3-Ewait_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 objects. =item Cget_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-Ewait_for_email_count()>. =item Cok($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-Ewait_for_email_count()> before calling this method. C will produce TAP output, identical to C and C. =item Cget_parser();> L uses L to process the messages. (MIME is not yet handled by C, it will be soon.) Use this method if you want to manage the parser. =back =head1 EXPORT None. =head1 SEE ALSO L, L, L, L =head1 AUTHOR James Tolley, Ljames@cpan.orgE> =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 Test-Email-0.07/Makefile.PL 777 0 0 2157 11100272320 10405 0use 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 ', 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); Test-Email-0.07/MANIFEST 777 0 0 330 10640370045 7546 0Changes 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) Test-Email-0.07/META.yml 777 0 0 762 11100272274 7674 0# 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 Test-Email-0.07/README 777 0 0 2544 11100265227 7323 0Test-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 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. Test-Email-0.07/t/ 777 0 0 0 10640512403 6615 5Test-Email-0.07/t/.svn/ 777 0 0 0 11100272471 7501 5Test-Email-0.07/t/.svn/entries 777 0 0 1505 11100272470 11160 09 dir 8 file:///C:/svn/test-email/t file:///C:/svn 2007-06-27T05:05:17.453125Z 8 James svn:special svn:externals svn:needs-lock 8b885719-6a82-7f43-b875-eeafde72ba5e 03_headers.t file 14 2008-10-24T07:01:37.328125Z 6d0614794e8169943bc30ccd2744c08b 2008-10-24T07:11:52.187500Z 14 James 1927 04_body.t file 14 2008-10-24T07:01:35.828125Z f5c0f74ba3eebf4cc2548ae6d2a3a1ce 2008-10-24T07:11:52.187500Z 14 James 2184 02_wait.t file 2007-06-27T05:05:41.734375Z e12fb9bf51961d14e28f8cc194eb834a 2007-06-27T05:05:17.453125Z 8 James 01_login.t file 2007-06-27T05:05:41.734375Z ef08f9ce3158bfbfade7cc56c3dd513d 2007-06-27T05:05:17.453125Z 8 James 05_email.t file 2007-06-27T05:05:41.734375Z 778510dc8d2c426eb296a698347bda50 2007-06-27T05:05:17.453125Z 8 James Test-Email-0.07/t/.svn/format 777 0 0 2 11100272467 10714 09 Test-Email-0.07/t/.svn/prop-base/ 777 0 0 0 10640370045 11375 5Test-Email-0.07/t/.svn/props/ 777 0 0 0 10640370045 10650 5Test-Email-0.07/t/.svn/text-base/ 777 0 0 0 11100272470 11374 5Test-Email-0.07/t/.svn/text-base/01_login.t.svn-base 777 0 0 1011 10640370045 14767 0#!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__ Test-Email-0.07/t/.svn/text-base/02_wait.t.svn-base 777 0 0 3131 10640370045 14631 0#!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__ Test-Email-0.07/t/.svn/text-base/03_headers.t.svn-base 777 0 0 3607 11100272470 15304 0#!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__ Test-Email-0.07/t/.svn/text-base/04_body.t.svn-base 777 0 0 4210 11100272470 14616 0#!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__ Test-Email-0.07/t/.svn/text-base/05_email.t.svn-base 777 0 0 1517 10640370045 14765 0#!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: To: Subject: Tester This is the message END # pass some tests $email->header_like('to', qr/localhost/, 'to'); $email->header_ok('from', '', '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__ Test-Email-0.07/t/.svn/tmp/ 777 0 0 0 11100272470 10300 5Test-Email-0.07/t/.svn/tmp/prop-base/ 777 0 0 0 10640370045 12175 5Test-Email-0.07/t/.svn/tmp/props/ 777 0 0 0 10640370045 11450 5Test-Email-0.07/t/.svn/tmp/text-base/ 777 0 0 0 11100272470 12174 5Test-Email-0.07/t/01_login.t 777 0 0 1011 10640370045 10472 0#!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__ Test-Email-0.07/t/02_wait.t 777 0 0 3131 10640370045 10334 0#!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__ Test-Email-0.07/t/03_headers.t 777 0 0 3607 11100271321 11001 0#!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__ Test-Email-0.07/t/04_body.t 777 0 0 4210 11100271317 10320 0#!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__ Test-Email-0.07/t/05_email.t 777 0 0 1517 10640370045 10470 0#!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: To: Subject: Tester This is the message END # pass some tests $email->header_like('to', qr/localhost/, 'to'); $email->header_ok('from', '', '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__