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