-#!/usr/bin/perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use Test::More;\r
-use Test::Exception;\r
-\r
-BEGIN {\r
- eval "use IO::String; use IO::File;";\r
- plan skip_all => "IO::String and IO::File are required for this test" if $@;\r
- plan tests => 28;\r
-}\r
-\r
-\r
-\r
-{\r
- package Email::Mouse;\r
- use Mouse;\r
- use Mouse::Util::TypeConstraints;\r
-\r
- use IO::String;\r
-\r
- our $VERSION = '0.01';\r
-\r
- # create subtype for IO::String\r
-\r
- subtype 'IO::String'\r
- => as 'Object'\r
- => where { $_->isa('IO::String') };\r
-\r
- coerce 'IO::String'\r
- => from 'Str'\r
- => via { IO::String->new($_) },\r
- => from 'ScalarRef',\r
- => via { IO::String->new($_) };\r
-\r
- # create subtype for IO::File\r
-\r
- subtype 'IO::File'\r
- => as 'Object'\r
- => where { $_->isa('IO::File') };\r
-\r
- coerce 'IO::File'\r
- => from 'FileHandle'\r
- => via { bless $_, 'IO::File' };\r
-\r
- # create the alias\r
-\r
- my $st = subtype 'IO::StringOrFile' => as 'IO::String | IO::File';\r
-\r
- # attributes\r
-\r
- has 'raw_body' => (\r
- is => 'rw',\r
- isa => 'IO::StringOrFile',\r
- coerce => 1,\r
- default => sub { IO::String->new() },\r
- );\r
-\r
- sub as_string {\r
- my ($self) = @_;\r
- my $fh = $self->raw_body();\r
-\r
- return do { local $/; <$fh> };\r
- }\r
-}\r
-\r
-{\r
- my $email = Email::Mouse->new;\r
- isa_ok($email, 'Email::Mouse');\r
-\r
- isa_ok($email->raw_body, 'IO::String');\r
-\r
- is($email->as_string, undef, '... got correct empty string');\r
-}\r
-\r
-{\r
- my $email = Email::Mouse->new(raw_body => '... this is my body ...');\r
- isa_ok($email, 'Email::Mouse');\r
-\r
- isa_ok($email->raw_body, 'IO::String');\r
-\r
- is($email->as_string, '... this is my body ...', '... got correct string');\r
-\r
- lives_ok {\r
- $email->raw_body('... this is the next body ...');\r
- } '... this will coerce correctly';\r
-\r
- isa_ok($email->raw_body, 'IO::String');\r
-\r
- is($email->as_string, '... this is the next body ...', '... got correct string');\r
-}\r
-\r
-{\r
- my $str = '... this is my body (ref) ...';\r
-\r
- my $email = Email::Mouse->new(raw_body => \$str);\r
- isa_ok($email, 'Email::Mouse');\r
-\r
- isa_ok($email->raw_body, 'IO::String');\r
-\r
- is($email->as_string, $str, '... got correct string');\r
-\r
- my $str2 = '... this is the next body (ref) ...';\r
-\r
- lives_ok {\r
- $email->raw_body(\$str2);\r
- } '... this will coerce correctly';\r
-\r
- isa_ok($email->raw_body, 'IO::String');\r
-\r
- is($email->as_string, $str2, '... got correct string');\r
-}\r
-\r
-{\r
- my $io_str = IO::String->new('... this is my body (IO::String) ...');\r
-\r
- my $email = Email::Mouse->new(raw_body => $io_str);\r
- isa_ok($email, 'Email::Mouse');\r
-\r
- isa_ok($email->raw_body, 'IO::String');\r
- is($email->raw_body, $io_str, '... and it is the one we expected');\r
-\r
- is($email->as_string, '... this is my body (IO::String) ...', '... got correct string');\r
-\r
- my $io_str2 = IO::String->new('... this is the next body (IO::String) ...');\r
-\r
- lives_ok {\r
- $email->raw_body($io_str2);\r
- } '... this will coerce correctly';\r
-\r
- isa_ok($email->raw_body, 'IO::String');\r
- is($email->raw_body, $io_str2, '... and it is the one we expected');\r
-\r
- is($email->as_string, '... this is the next body (IO::String) ...', '... got correct string');\r
-}\r
-\r
-{\r
- my $fh;\r
-\r
- open($fh, '<', $0) || die "Could not open $0";\r
-\r
- my $email = Email::Mouse->new(raw_body => $fh);\r
- isa_ok($email, 'Email::Mouse');\r
-\r
- isa_ok($email->raw_body, 'IO::File');\r
-\r
- close($fh);\r
-}\r
-\r
-{\r
- my $fh = IO::File->new($0);\r
-\r
- my $email = Email::Mouse->new(raw_body => $fh);\r
- isa_ok($email, 'Email::Mouse');\r
-\r
- isa_ok($email->raw_body, 'IO::File');\r
- is($email->raw_body, $fh, '... and it is the one we expected');\r
-}\r
-\r
-\r
-\r
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+ eval "use IO::String; use IO::File;";
+ plan skip_all => "IO::String and IO::File are required for this test" if $@;
+ plan tests => 28;
+}
+
+
+
+{
+ 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
+
+ my $st = subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
+ #::diag $st->dump;
+
+ # 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');
+}
+
+
+
projects / gitmo/Mouse.git / commitdiff