foo
[gitmo/Moose.git] / t / 058_union_types_and_coercions.t
index 2707454..c9a42b8 100644 (file)
 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