t/040_type_constraints/009_union_types_and_coercions.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     eval "use IO::String; use IO::File;";
  11     plan skip_all => "IO::String and IO::File are required for this test" if $@;
  12     plan tests => 29;
  13 }
  14
  15 BEGIN {
  16     use_ok('Moose');
  17 }
  18
  19 {
  20     package Email::Moose;
  21     use Moose;
  22     use Moose::Util::TypeConstraints;
  23
  24     use IO::String;
  25
  26     our $VERSION = '0.01';
  27
  28     # create subtype for IO::String
  29
  30     subtype 'IO::String'
  31         => as 'Object'
  32         => where { $_->isa('IO::String') };
  33
  34     coerce 'IO::String'
  35         => from 'Str'
  36             => via { IO::String->new($_) },
  37         => from 'ScalarRef',
  38             => via { IO::String->new($_) };
  39
  40     # create subtype for IO::File
  41
  42     subtype 'IO::File'
  43         => as 'Object'
  44         => where { $_->isa('IO::File') };
  45
  46     coerce 'IO::File'
  47         => from 'FileHandle'
  48             => via { bless $_, 'IO::File' };
  49
  50     # create the alias
  51
  52     subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
  53
  54     # attributes
  55
  56     has 'raw_body' => (
  57         is      => 'rw',
  58         isa     => 'IO::StringOrFile',
  59         coerce  => 1,
  60         default => sub { IO::String->new() },
  61     );
  62
  63     sub as_string {
  64         my ($self) = @_;
  65         my $fh = $self->raw_body();
  66         return do { local $/; <$fh> };
  67     }
  68 }
  69
  70 {
  71     my $email = Email::Moose->new;
  72     isa_ok($email, 'Email::Moose');
  73
  74     isa_ok($email->raw_body, 'IO::String');
  75
  76     is($email->as_string, undef, '... got correct empty string');
  77 }
  78
  79 {
  80     my $email = Email::Moose->new(raw_body => '... this is my body ...');
  81     isa_ok($email, 'Email::Moose');
  82
  83     isa_ok($email->raw_body, 'IO::String');
  84
  85     is($email->as_string, '... this is my body ...', '... got correct string');
  86
  87     lives_ok {
  88         $email->raw_body('... this is the next body ...');
  89     } '... this will coerce correctly';
  90
  91     isa_ok($email->raw_body, 'IO::String');
  92
  93     is($email->as_string, '... this is the next body ...', '... got correct string');
  94 }
  95
  96 {
  97     my $str = '... this is my body (ref) ...';
  98
  99     my $email = Email::Moose->new(raw_body => \$str);
 100     isa_ok($email, 'Email::Moose');
 101
 102     isa_ok($email->raw_body, 'IO::String');
 103
 104     is($email->as_string, $str, '... got correct string');
 105
 106     my $str2 = '... this is the next body (ref) ...';
 107
 108     lives_ok {
 109         $email->raw_body(\$str2);
 110     } '... this will coerce correctly';
 111
 112     isa_ok($email->raw_body, 'IO::String');
 113
 114     is($email->as_string, $str2, '... got correct string');
 115 }
 116
 117 {
 118     my $io_str = IO::String->new('... this is my body (IO::String) ...');
 119
 120     my $email = Email::Moose->new(raw_body => $io_str);
 121     isa_ok($email, 'Email::Moose');
 122
 123     isa_ok($email->raw_body, 'IO::String');
 124     is($email->raw_body, $io_str, '... and it is the one we expected');
 125
 126     is($email->as_string, '... this is my body (IO::String) ...', '... got correct string');
 127
 128     my $io_str2 = IO::String->new('... this is the next body (IO::String) ...');
 129
 130     lives_ok {
 131         $email->raw_body($io_str2);
 132     } '... this will coerce correctly';
 133
 134     isa_ok($email->raw_body, 'IO::String');
 135     is($email->raw_body, $io_str2, '... and it is the one we expected');
 136
 137     is($email->as_string, '... this is the next body (IO::String) ...', '... got correct string');
 138 }
 139
 140 {
 141     my $fh;
 142
 143     open($fh, '<', $0) || die "Could not open $0";
 144
 145     my $email = Email::Moose->new(raw_body => $fh);
 146     isa_ok($email, 'Email::Moose');
 147
 148     isa_ok($email->raw_body, 'IO::File');
 149
 150     close($fh);
 151 }
 152
 153 {
 154     my $fh = IO::File->new($0);
 155
 156     my $email = Email::Moose->new(raw_body => $fh);
 157     isa_ok($email, 'Email::Moose');
 158
 159     isa_ok($email->raw_body, 'IO::File');
 160     is($email->raw_body, $fh, '... and it is the one we expected');
 161 }
 162
 163
 164