trAvis - MANAGER

Edit File: 003-apply.t

use strict;
use warnings;
use Test::More;
use Test::Fatal;

my %args;
do {
    package MyRole::Storage;
    use MooseX::Role::Parameterized;
    use Moose::Util::TypeConstraints;

parameter format => (
        isa      => (enum ['Dumper', 'Storable']),
        required => 1,
    );

parameter freeze_method => (
        isa     => 'Str',
        lazy    => 1,
        default => sub { "freeze_" . shift->format },
    );

parameter thaw_method => (
        isa     => 'Str',
        lazy    => 1,
        default => sub { "thaw_" . shift->format },
    );

role {
        my $p = shift;
        %args = @_;

my $format = $p->format;

my ($freezer, $thawer);

if ($format eq 'Dumper') {
            require Data::Dumper;
            $freezer = \&Data::Dumper::Dumper;
            $thawer  = sub { eval "@_" };

}
        elsif ($format eq 'Storable') {
            require Storable;
            $freezer = \&Storable::nfreeze;
            $thawer  = \&Storable::thaw;
        }
        else {
            die "Unknown format ($format)";
        }

method $p->freeze_method => $freezer;
        method $p->thaw_method   => $thawer;
    };
};

do {
    package MyClass::Dumper;
    use Moose;
    with 'MyRole::Storage' => {
        format => 'Dumper',
    };
};

can_ok('MyClass::Dumper' => qw(freeze_Dumper thaw_Dumper));
cant_ok('MyClass::Dumper' => qw(freeze_Storable thaw_Storable));

is($args{consumer}, MyClass::Dumper->meta, 'Role block receives consumer');
is(MyClass::Dumper->meta->roles->[0]->genitor, MyRole::Storage->meta, 'genitor');

do {
    package MyClass::Storable;
    use Moose;
    with 'MyRole::Storage' => {
        format => 'Storable',
    };
};

can_ok('MyClass::Storable' => qw(freeze_Storable thaw_Storable));
cant_ok('MyClass::Storable' => qw(freeze_Dumper thaw_Dumper));

is($args{consumer}, MyClass::Storable->meta, 'Role block receives consumer');

do {
    package MyClass::DumperRenamed;
    use Moose;
    with 'MyRole::Storage' => {
        format => 'Dumper',
        freeze_method => 'save',
        thaw_method   => 'load',
    };
};

can_ok('MyClass::DumperRenamed' => qw(save load));
cant_ok('MyClass::DumperRenamed' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable));

is($args{consumer}, MyClass::DumperRenamed->meta, 'Role block receives consumer');

do {
    package MyClass::Both;
    use Moose;
    with 'MyRole::Storage' => { format => 'Dumper'   };
    with 'MyRole::Storage' => { format => 'Storable' };
};

can_ok('MyClass::Both' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable));
is($args{consumer}, MyClass::Both->meta, 'Role block receives consumer');

do {
    package MyClass::Three;
    use Moose;
    with 'MyRole::Storage' => { format => 'Dumper'   };
    with 'MyRole::Storage' => { format => 'Storable' };
    with 'MyRole::Storage' => {
        format        => 'Storable',
        freeze_method => 'store',
        thaw_method   => 'dump',
    };
};

can_ok('MyClass::Three' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable store dump));
is($args{consumer}, MyClass::Three->meta, 'Role block receives consumer');

like( exception {
    package MyClass::Error::Required;
    use Moose;
    with 'MyRole::Storage';
}, qr/^Attribute $format$ is required/);

like( exception {
    package MyClass::Error::Invalid;
    use Moose;
    with 'MyRole::Storage' => {
        format => 'YAML',
    };
}, qr/^Attribute $format$ does not pass the type constraint/);

like( exception {
    package MyRole::Sans::Block;
    use MooseX::Role::Parameterized;

parameter 'foo';

package MyClass::Error::BlocklessRole;
    use Moose;
    with 'MyRole::Sans::Block' => {};
}, qr/^\QA role generator is required to apply parameterized roles (did you forget the 'role { ... }' block in your parameterized role 'MyRole::Sans::Block'?)\E/);

sub cant_ok {
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $instance = shift;
    for my $method (@_) {
        ok(!$instance->can($method), "$instance cannot $method");
    }
}

done_testing;