t/040_type_constraints/009_union_types_and_coercions.t

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