Commit | Line | Data |
a254bf51 |
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 |