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