#!/usr/bin/perl # This is automatically generated by author/import-moose-test.pl. # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! use t::lib::MooseCompat; use strict; use warnings; use Test::More; use Test::Exception; use Test::Requires { 'IO::String' => '0.01', # skip all if not installed 'IO::File' => '0.01', }; { package Email::Mouse; use Mouse; use Mouse::Util::TypeConstraints; use IO::String; our $VERSION = '0.01'; # create subtype for IO::String subtype 'IO::String' => as 'Object' => where { $_->isa('IO::String') }; coerce 'IO::String' => from 'Str' => via { IO::String->new($_) }, => from 'ScalarRef', => via { IO::String->new($_) }; # create subtype for IO::File subtype 'IO::File' => as 'Object' => where { $_->isa('IO::File') }; coerce 'IO::File' => from 'FileHandle' => via { bless $_, 'IO::File' }; # create the alias subtype 'IO::StringOrFile' => as 'IO::String | IO::File'; # attributes has 'raw_body' => ( is => 'rw', isa => 'IO::StringOrFile', coerce => 1, default => sub { IO::String->new() }, ); sub as_string { my ($self) = @_; my $fh = $self->raw_body(); return do { local $/; <$fh> }; } } { my $email = Email::Mouse->new; isa_ok($email, 'Email::Mouse'); isa_ok($email->raw_body, 'IO::String'); is($email->as_string, undef, '... got correct empty string'); } { my $email = Email::Mouse->new(raw_body => '... this is my body ...'); isa_ok($email, 'Email::Mouse'); 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'); } { my $str = '... this is my body (ref) ...'; my $email = Email::Mouse->new(raw_body => \$str); isa_ok($email, 'Email::Mouse'); 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'); } { my $io_str = IO::String->new('... this is my body (IO::String) ...'); my $email = Email::Mouse->new(raw_body => $io_str); isa_ok($email, 'Email::Mouse'); 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'); } { my $fh; open($fh, '<', $0) || die "Could not open $0"; my $email = Email::Mouse->new(raw_body => $fh); isa_ok($email, 'Email::Mouse'); isa_ok($email->raw_body, 'IO::File'); close($fh); } { my $fh = IO::File->new($0); my $email = Email::Mouse->new(raw_body => $fh); isa_ok($email, 'Email::Mouse'); isa_ok($email->raw_body, 'IO::File'); is($email->raw_body, $fh, '... and it is the one we expected'); } { package Foo; use Mouse; use Mouse::Util::TypeConstraints; subtype 'Coerced' => as 'ArrayRef'; coerce 'Coerced' => from 'Value' => via { [ $_ ] }; has carray => ( is => 'ro', isa => 'Coerced | Coerced', coerce => 1, ); } { my $foo; lives_ok { $foo = Foo->new( carray => 1 ) } 'Can pass non-ref value for carray'; is_deeply( $foo->carray, [1], 'carray was coerced to an array ref' ); throws_ok { Foo->new( carray => {} ) } qr/\QValidation failed for 'Coerced|Coerced' with value \E(?!undef)/, 'Cannot pass a hash ref for carray attribute, and hash ref is not coerced to an undef'; } done_testing;