Help-Site Computer Manuals
Software
Hardware
Programming
Networking
  Algorithms & Data Structures   Programming Languages   Revision Control
  Protocols
  Cameras   Computers   Displays   Keyboards & Mice   Motherboards   Networking   Printers & Scanners   Storage
  Windows   Linux & Unix   Mac

/var/sites/help-site.com/auto/tmp/CPAN/9677/Mail-Action-0.42/lib/Mail/Action/Test.pm

/var/sites/help-site.com/auto/tmp/CPAN/9677/Mail-Action-0.42/lib/Mail/Action/Test.pm


USING LISTS

more text


DIRECTIVES

Yet More Text.


CREDITS

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;

Programminig
Wy
Wy
yW
Wy
Programming
Wy
Wy
Wy
Wy