some text
more text
Yet More Text.
no one of consequence END_HERE
$ma->request->store_header( 'From', [ Email::Address->parse( 'some@here' ) ] ); $ma->command_help( $pod, 'USING LISTS', 'DIRECTIVES' ); my ($method, $args) = $mock_mail->next_call(); is( $args->[1]{To}, 'some@here', 'command_help() should reply to sender' ); is( $args->[1]{Subject}, $self->module() . ' Help', '... with appropriate subject' ); ($method, $args) = $mock_mail->next_call(); is( $args->[1], "USING LISTS\n\n more text\n\nDIRECTIVES\n\n Yet More Text.", '... with text extracted from passed-in POD' ); }
sub process_body :Test( 8 ) { my $self = shift; my $module = $self->module(); my $ma = $self->{ma};
can_ok( $module, 'process_body' ); my $mock_store = Test::MockObject->new(); $mock_store->set_always( attributes => { foo => 1, bar => 1 } ) ->set_true( 'foo' ) ->set_true( 'bar' ) ->clear(); $ma->message->body_set( "Foo: foo\nCar: vroom\nbaR: b a r\n\nMy: friend\nhi\n-- \nFOO: moo" ); is_deeply( $ma->process_body( $mock_store ), [ '', 'My: friend', 'hi' ], 'process_body() should return message without directives or sig' ); my ($method, $args) = $mock_store->next_call( 2 ); is( $method, 'foo', '... calling directive found' ); is( $args->[1], 'foo', '... passing directive value found' ); ($method, $args) = $mock_store->next_call(); isnt( $method, 'car', '... not calling unknown directive' ); is( $method, 'bar', '... lowercasing directive name' ); is( $args->[1], 'b a r', '... passing entire directive value found' ); $ma->message->body_set(); is_deeply( $ma->process_body( $mock_store ), [], '... returning empty list with no body' ); }
sub reply :Test( 6 ) { my $self = shift; my $module = $self->module(); my $ma = $self->{ma}; my $mock_mail = $self->{mail}->set_true(qw( open print close ));
can_ok( $module, 'reply' ); $ma->reply( 'headers', 'body', 'lines' ); my ($method, $args) = $mock_mail->next_call(); is( $method, 'open', 'reply() should open a Mail::Mailer object' ); is( $args->[1], 'headers', '... passing headers' ); ($method, $args) = $mock_mail->next_call(); is( $method, 'print', '... printing body' ); is( "@$args", "$mock_mail body lines", '... all lines passed' ); is( $mock_mail->next_call(), 'close', '... closing message' ); }
sub find_command :Test( 5 ) { my $self = shift; my $module = $self->module(); my $ma = $self->{ma};
can_ok( $module, 'find_command' ); is( $ma->find_command(), undef, 'find_command() should return undef without a valid command' ); $ma->request->store_header( 'Subject', [ '*help*' ] ); is( $ma->find_command(), 'command_help', '... or the name of the command sub, if it exists' ); $ma->request->store_header( 'Subject', [ '*hElP*' ] ); is( $ma->find_command(), 'command_help', '... regardless of capitalization' ); $ma->request->store_header( 'Subject', [ '*drinkME*' ] ); is( $ma->find_command(), '', '... or an empty string if command does not match' ); }
sub copy_headers: Test( 4 ) { my $self = shift; my $module = $self->module(); my $ma = $self->{ma}; my $req = $ma->request();
can_ok( $module, 'copy_headers' ); $req->store_header( 'Subject', [ '*help*' ] ); $req->store_header( 'To', [ 'you@house' ] ); $req->store_header( 'From', [ 'me@home' ] ); $req->store_header( 'From ', [ 1 ] ); $req->store_header( 'Cc', [ 1 ] ); $req->store_header( 'Content-type', [ '' ] ); my $result = $ma->copy_headers(); isnt( $result, $ma->message()->{head}, 'copy_headers() should make a new hash' ); is_deeply( $result, { From => 'me@home', Subject => '*help*', To => 'you@house', Cc => 1, 'Content-type' => '', 'Delivered-to' => '' }, '... cleaning header names' ); ok( ! exists $result->{'From '}, '... removing mbox From header' ); }
package Mail::Action::WithStorage;
@Mail::Action::WithStorage::ISA = 'Mail::Action';
$INC{'Mail/Action/WithStorage.pm'} = 1; sub storage_class { 'StorageTest' } sub parse_alias { 'alias' }
package StorageTest;
sub new { 'ST: ' . $_[1] };
1;
To install Mail::Action, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Mail::Action
CPAN shell
perl -MCPAN -e shell install Mail::Action
For more information on module installation, please visit the detailed CPAN module installation guide.