use strict;
use warnings;
-use Test::More tests => 1;
+use Test::More;
use Test::Exception;
BEGIN {
- use_ok('Moose');
+ eval "use IO::String; use IO::File;";
+ plan skip_all => "IO::String and IO::File are required for this test" if $@;
+ plan tests => 29;
}
-__END__
-
-package Email::Moose;
-
-use warnings;
-use strict;
-
-use Moose;
-use Moose::Util::TypeConstraints;
-
-use IO::String;
+BEGIN {
+ use_ok('Moose');
+}
-=head1 NAME
+{
+ package Email::Moose;
+ use Moose;
+ use Moose::Util::TypeConstraints;
-Email::Moose - Email::Simple on Moose steroids
+ use IO::String;
-=head1 VERSION
+ our $VERSION = '0.01';
-Version 0.01
+ # create subtype for IO::String
-=cut
+ subtype 'IO::String'
+ => as 'Object'
+ => where { $_->isa('IO::String') };
-our $VERSION = '0.01';
+ coerce 'IO::String'
+ => from 'Str'
+ => via { IO::String->new($_) },
+ => from 'ScalarRef',
+ => via { IO::String->new($_) };
-=head1 SYNOPSIS
+ # create subtype for IO::File
-=head1 METHODS
+ subtype 'IO::File'
+ => as 'Object'
+ => where { $_->isa('IO::File') };
-=head2 raw_body
+ coerce 'IO::File'
+ => from 'FileHandle'
+ => via { bless $_, 'IO::File' };
+
+ # attributes
+
+ has 'raw_body' => (
+ is => 'rw',
+ isa => 'IO::String | IO::File',
+ coerce => 1,
+ default => sub { IO::String->new() },
+ );
+
+ sub as_string {
+ my ($self) = @_;
+ my $fh = $self->raw_body();
+ return do { local $/; <$fh> };
+ }
+}
-=cut
+{
+ my $email = Email::Moose->new;
+ isa_ok($email, 'Email::Moose');
-subtype q{IO::String}
- => as q{Object}
- => where { $_->isa(q{IO::String}) };
+ isa_ok($email->raw_body, 'IO::String');
+
+ is($email->as_string, undef, '... got correct empty string');
+}
-coerce q{IO::String}
- => from q{Str}
- => via { IO::String->new($_) },
- => from q{ScalarRef},
- => via { IO::String->new($_) };
+{
+ my $email = Email::Moose->new(raw_body => '... this is my body ...');
+ isa_ok($email, 'Email::Moose');
+
+ isa_ok($email->raw_body, 'IO::String');
+
+ is($email->as_string, '... this is my body ...', '... got correct string');
+
+ lives_ok {
+ $email->raw_body('... this is the next body ...');
+ } '... this will coerce correctly';
+
+ isa_ok($email->raw_body, 'IO::String');
+
+ is($email->as_string, '... this is the next body ...', '... got correct string');
+}
-type q{FileHandle}
- => where { Scalar::Util::openhandle($_) };
-
-subtype q{IO::File}
- => as q{Object}
- => where { $_->isa(q{IO::File}) };
+{
+ my $str = '... this is my body (ref) ...';
+
+ my $email = Email::Moose->new(raw_body => \$str);
+ isa_ok($email, 'Email::Moose');
+
+ isa_ok($email->raw_body, 'IO::String');
+
+ is($email->as_string, $str, '... got correct string');
+
+ my $str2 = '... this is the next body (ref) ...';
+
+ lives_ok {
+ $email->raw_body(\$str2);
+ } '... this will coerce correctly';
+
+ isa_ok($email->raw_body, 'IO::String');
+
+ is($email->as_string, $str2, '... got correct string');
+}
-coerce q{IO::File}
- => from q{FileHandle}
- => via { bless $_, q{IO::File} };
+{
+ my $io_str = IO::String->new('... this is my body (IO::String) ...');
+
+ my $email = Email::Moose->new(raw_body => $io_str);
+ isa_ok($email, 'Email::Moose');
+
+ isa_ok($email->raw_body, 'IO::String');
+ is($email->raw_body, $io_str, '... and it is the one we expected');
+
+ is($email->as_string, '... this is my body (IO::String) ...', '... got correct string');
+
+ my $io_str2 = IO::String->new('... this is the next body (IO::String) ...');
+
+ lives_ok {
+ $email->raw_body($io_str2);
+ } '... this will coerce correctly';
+
+ isa_ok($email->raw_body, 'IO::String');
+ is($email->raw_body, $io_str2, '... and it is the one we expected');
+
+ is($email->as_string, '... this is the next body (IO::String) ...', '... got correct string');
+}
-subtype q{IO::Socket}
- => as q{Object}
- => where { $_->isa(q{IO::Socket}) };
+{
+ my $fh;
+
+ open($fh, '<', $0) || die "Could not open $0";
+
+ my $email = Email::Moose->new(raw_body => $fh);
+ isa_ok($email, 'Email::Moose');
+
+ isa_ok($email->raw_body, 'IO::File');
+
+ close($fh);
+}
-coerce q{IO::Socket}
- => from q{CodeRef} # no test sample yet
- => via { IO::Socket->new($_) };
-=cut
+{
+ my $fh = IO::File->new($0);
-has q{raw_body} => (
- is => q{rw},
- isa => q{IO::String | IO::File | IO::Socket},
- coerce => 1,
- default => sub { IO::String->new() },
-);
+ my $email = Email::Moose->new(raw_body => $fh);
+ isa_ok($email, 'Email::Moose');
+
+ isa_ok($email->raw_body, 'IO::File');
+ is($email->raw_body, $fh, '... and it is the one we expected');
+}
-=head2 as_string
-=cut
-sub as_string {
- my ($self) = @_;
- my $fh = $self->raw_body();
- return do { local $/; <$fh> };
-}
\ No newline at end of file