4 use Test::More tests => 15;
8 package MyRole::Storage;
9 use MooseX::Role::Parameterized;
10 use Moose::Util::TypeConstraints;
14 isa => (enum ['Dumper', 'Storable']),
18 parameter freeze_method => (
22 default => sub { "freeze_" . shift->format },
25 parameter thaw_method => (
29 default => sub { "thaw_" . shift->format },
34 my $format = $p->format;
36 my ($freezer, $thawer);
38 if ($format eq 'Dumper') {
40 $freezer = \&Data::Dumper::Dumper;
41 $thawer = sub { eval "@_" };
44 elsif ($format eq 'Storable') {
46 $freezer = \&Storable::nfreeze;
47 $thawer = \&Storable::thaw;
50 die "Unknown format ($format)";
53 method $p->freeze_method => $freezer;
54 method $p->thaw_method => $thawer;
59 package MyClass::Dumper;
61 with 'MyRole::Storage' => {
66 can_ok('MyClass::Dumper' => qw(freeze_Dumper thaw_Dumper));
67 cant_ok('MyClass::Dumper' => qw(freeze_Storable thaw_Storable));
70 package MyClass::Storable;
72 with 'MyRole::Storage' => {
77 can_ok('MyClass::Storable' => qw(freeze_Storable thaw_Storable));
78 cant_ok('MyClass::Storable' => qw(freeze_Dumper thaw_Dumper));
81 package MyClass::DumperRenamed;
83 with 'MyRole::Storage' => {
85 freeze_method => 'save',
86 thaw_method => 'load',
90 can_ok('MyClass::DumperRenamed' => qw(save load));
91 cant_ok('MyClass::DumperRenamed' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable));
94 package MyClass::Both;
96 with 'MyRole::Storage' => { format => 'Dumper' };
97 with 'MyRole::Storage' => { format => 'Storable' };
100 can_ok('MyClass::Both' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable));
103 package MyClass::Three;
105 with 'MyRole::Storage' => { format => 'Dumper' };
106 with 'MyRole::Storage' => { format => 'Storable' };
107 with 'MyRole::Storage' => {
108 format => 'Storable',
109 freeze_method => 'store',
110 thaw_method => 'dump',
114 can_ok('MyClass::Three' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable store dump));
117 package MyClass::Error::Required;
119 with 'MyRole::Storage';
120 } qr/^Attribute \(format\) is required/;
123 package MyClass::Error::Invalid;
125 with 'MyRole::Storage' => {
128 } qr/^Attribute \(format\) does not pass the type constraint/;
131 local $Test::Builder::Level = $Test::Builder::Level + 1;
132 my $instance = shift;
133 for my $method (@_) {
134 ok(!$instance->can($method), "$instance cannot $method");