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