Commit | Line | Data |
a15d1371 |
1 | #!/usr/bin/perl |
5a592ad7 |
2 | # This is automatically generated by author/import-moose-test.pl. |
3 | # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! |
4 | use t::lib::MooseCompat; |
a15d1371 |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | use Test::More; |
10 | use Test::Exception; |
11 | |
5a592ad7 |
12 | use Test::Requires { |
13 | 'IO::String' => '0.01', # skip all if not installed |
14 | 'IO::File' => '0.01', |
15 | }; |
a15d1371 |
16 | |
17 | { |
18 | package Email::Mouse; |
19 | use Mouse; |
20 | use Mouse::Util::TypeConstraints; |
21 | |
22 | use IO::String; |
23 | |
24 | our $VERSION = '0.01'; |
25 | |
26 | # create subtype for IO::String |
27 | |
28 | subtype 'IO::String' |
29 | => as 'Object' |
30 | => where { $_->isa('IO::String') }; |
31 | |
32 | coerce 'IO::String' |
33 | => from 'Str' |
34 | => via { IO::String->new($_) }, |
35 | => from 'ScalarRef', |
36 | => via { IO::String->new($_) }; |
37 | |
38 | # create subtype for IO::File |
39 | |
40 | subtype 'IO::File' |
41 | => as 'Object' |
42 | => where { $_->isa('IO::File') }; |
43 | |
44 | coerce 'IO::File' |
45 | => from 'FileHandle' |
46 | => via { bless $_, 'IO::File' }; |
47 | |
48 | # create the alias |
49 | |
5a592ad7 |
50 | subtype 'IO::StringOrFile' => as 'IO::String | IO::File'; |
a15d1371 |
51 | |
52 | # attributes |
53 | |
54 | has 'raw_body' => ( |
55 | is => 'rw', |
56 | isa => 'IO::StringOrFile', |
57 | coerce => 1, |
58 | default => sub { IO::String->new() }, |
59 | ); |
60 | |
61 | sub as_string { |
62 | my ($self) = @_; |
63 | my $fh = $self->raw_body(); |
a15d1371 |
64 | return do { local $/; <$fh> }; |
65 | } |
66 | } |
67 | |
68 | { |
69 | my $email = Email::Mouse->new; |
70 | isa_ok($email, 'Email::Mouse'); |
71 | |
72 | isa_ok($email->raw_body, 'IO::String'); |
73 | |
74 | is($email->as_string, undef, '... got correct empty string'); |
75 | } |
76 | |
77 | { |
78 | my $email = Email::Mouse->new(raw_body => '... this is my body ...'); |
79 | isa_ok($email, 'Email::Mouse'); |
80 | |
81 | isa_ok($email->raw_body, 'IO::String'); |
82 | |
83 | is($email->as_string, '... this is my body ...', '... got correct string'); |
84 | |
85 | lives_ok { |
86 | $email->raw_body('... this is the next body ...'); |
87 | } '... this will coerce correctly'; |
88 | |
89 | isa_ok($email->raw_body, 'IO::String'); |
90 | |
91 | is($email->as_string, '... this is the next body ...', '... got correct string'); |
92 | } |
93 | |
94 | { |
95 | my $str = '... this is my body (ref) ...'; |
96 | |
97 | my $email = Email::Mouse->new(raw_body => \$str); |
98 | isa_ok($email, 'Email::Mouse'); |
99 | |
100 | isa_ok($email->raw_body, 'IO::String'); |
101 | |
102 | is($email->as_string, $str, '... got correct string'); |
103 | |
104 | my $str2 = '... this is the next body (ref) ...'; |
105 | |
106 | lives_ok { |
107 | $email->raw_body(\$str2); |
108 | } '... this will coerce correctly'; |
109 | |
110 | isa_ok($email->raw_body, 'IO::String'); |
111 | |
112 | is($email->as_string, $str2, '... got correct string'); |
113 | } |
114 | |
115 | { |
116 | my $io_str = IO::String->new('... this is my body (IO::String) ...'); |
117 | |
118 | my $email = Email::Mouse->new(raw_body => $io_str); |
119 | isa_ok($email, 'Email::Mouse'); |
120 | |
121 | isa_ok($email->raw_body, 'IO::String'); |
122 | is($email->raw_body, $io_str, '... and it is the one we expected'); |
123 | |
124 | is($email->as_string, '... this is my body (IO::String) ...', '... got correct string'); |
125 | |
126 | my $io_str2 = IO::String->new('... this is the next body (IO::String) ...'); |
127 | |
128 | lives_ok { |
129 | $email->raw_body($io_str2); |
130 | } '... this will coerce correctly'; |
131 | |
132 | isa_ok($email->raw_body, 'IO::String'); |
133 | is($email->raw_body, $io_str2, '... and it is the one we expected'); |
134 | |
135 | is($email->as_string, '... this is the next body (IO::String) ...', '... got correct string'); |
136 | } |
137 | |
138 | { |
139 | my $fh; |
140 | |
141 | open($fh, '<', $0) || die "Could not open $0"; |
142 | |
143 | my $email = Email::Mouse->new(raw_body => $fh); |
144 | isa_ok($email, 'Email::Mouse'); |
145 | |
146 | isa_ok($email->raw_body, 'IO::File'); |
147 | |
148 | close($fh); |
149 | } |
150 | |
151 | { |
152 | my $fh = IO::File->new($0); |
153 | |
154 | my $email = Email::Mouse->new(raw_body => $fh); |
155 | isa_ok($email, 'Email::Mouse'); |
156 | |
157 | isa_ok($email->raw_body, 'IO::File'); |
158 | is($email->raw_body, $fh, '... and it is the one we expected'); |
159 | } |
160 | |
5a592ad7 |
161 | { |
162 | package Foo; |
163 | |
164 | use Mouse; |
165 | use Mouse::Util::TypeConstraints; |
166 | |
167 | subtype 'Coerced' => as 'ArrayRef'; |
168 | coerce 'Coerced' |
169 | => from 'Value' |
170 | => via { [ $_ ] }; |
171 | |
172 | has carray => ( |
173 | is => 'ro', |
174 | isa => 'Coerced | Coerced', |
175 | coerce => 1, |
176 | ); |
177 | } |
178 | |
179 | { |
180 | my $foo; |
181 | lives_ok { $foo = Foo->new( carray => 1 ) } |
182 | 'Can pass non-ref value for carray'; |
183 | is_deeply( |
184 | $foo->carray, [1], |
185 | 'carray was coerced to an array ref' |
186 | ); |
a15d1371 |
187 | |
5a592ad7 |
188 | throws_ok { Foo->new( carray => {} ) } |
189 | qr/\QValidation failed for 'Coerced|Coerced' with value \E(?!undef)/, |
190 | 'Cannot pass a hash ref for carray attribute, and hash ref is not coerced to an undef'; |
191 | } |
a15d1371 |
192 | |
5a592ad7 |
193 | done_testing; |