Commit | Line | Data |
0d2825cd |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
a4ea464f |
4 | use Test::More tests => 15; |
0d2825cd |
5 | use Test::Exception; |
6 | |
7 | do { |
8 | package MyRole::Storage; |
9 | use MooseX::Role::Parameterized; |
10 | use Moose::Util::TypeConstraints; |
11 | |
12 | parameter format => ( |
0d2825cd |
13 | isa => (enum ['Dumper', 'Storable']), |
14 | required => 1, |
15 | ); |
16 | |
17 | parameter freeze_method => ( |
0d2825cd |
18 | isa => 'Str', |
19 | lazy => 1, |
20 | default => sub { "freeze_" . shift->format }, |
21 | ); |
22 | |
23 | parameter thaw_method => ( |
0d2825cd |
24 | isa => 'Str', |
25 | lazy => 1, |
26 | default => sub { "thaw_" . shift->format }, |
27 | ); |
28 | |
29 | role { |
30 | my $p = shift; |
31 | my $format = $p->format; |
32 | |
33 | my ($freezer, $thawer); |
34 | |
35 | if ($format eq 'Dumper') { |
36 | require Data::Dumper; |
37 | $freezer = \&Data::Dumper::Dumper; |
38 | $thawer = sub { eval "@_" }; |
39 | |
40 | } |
41 | elsif ($format eq 'Storable') { |
42 | require Storable; |
43 | $freezer = \&Storable::nfreeze; |
44 | $thawer = \&Storable::thaw; |
45 | } |
46 | else { |
47 | die "Unknown format ($format)"; |
48 | } |
49 | |
50 | method $p->freeze_method => $freezer; |
51 | method $p->thaw_method => $thawer; |
52 | }; |
53 | }; |
54 | |
0d2825cd |
55 | do { |
56 | package MyClass::Dumper; |
57 | use Moose; |
58 | with 'MyRole::Storage' => { |
59 | format => 'Dumper', |
60 | }; |
61 | }; |
62 | |
09156b03 |
63 | can_ok('MyClass::Dumper' => qw(freeze_Dumper thaw_Dumper)); |
eda20a62 |
64 | cant_ok('MyClass::Dumper' => qw(freeze_Storable thaw_Storable)); |
09156b03 |
65 | |
66 | do { |
67 | package MyClass::Storable; |
68 | use Moose; |
69 | with 'MyRole::Storage' => { |
70 | format => 'Storable', |
71 | }; |
72 | }; |
73 | |
74 | can_ok('MyClass::Storable' => qw(freeze_Storable thaw_Storable)); |
75 | cant_ok('MyClass::Storable' => qw(freeze_Dumper thaw_Dumper)); |
76 | |
77 | do { |
78 | package MyClass::DumperRenamed; |
79 | use Moose; |
80 | with 'MyRole::Storage' => { |
81 | format => 'Dumper', |
82 | freeze_method => 'save', |
83 | thaw_method => 'load', |
84 | }; |
85 | }; |
86 | |
87 | can_ok('MyClass::DumperRenamed' => qw(save load)); |
88 | cant_ok('MyClass::DumperRenamed' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable)); |
89 | |
90 | do { |
91 | package MyClass::Both; |
92 | use Moose; |
93 | with 'MyRole::Storage' => { format => 'Dumper' }; |
94 | with 'MyRole::Storage' => { format => 'Storable' }; |
95 | }; |
96 | |
97 | can_ok('MyClass::Both' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable)); |
98 | |
99 | do { |
100 | package MyClass::Three; |
101 | use Moose; |
102 | with 'MyRole::Storage' => { format => 'Dumper' }; |
103 | with 'MyRole::Storage' => { format => 'Storable' }; |
104 | with 'MyRole::Storage' => { |
105 | format => 'Storable', |
106 | freeze_method => 'store', |
107 | thaw_method => 'dump', |
108 | }; |
109 | }; |
110 | |
111 | can_ok('MyClass::Three' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable store dump)); |
112 | |
a4ea464f |
113 | throws_ok { |
114 | package MyClass::Error::Required; |
115 | use Moose; |
116 | with 'MyRole::Storage'; |
117 | } qr/^Attribute \(format\) is required/; |
118 | |
119 | throws_ok { |
120 | package MyClass::Error::Invalid; |
121 | use Moose; |
122 | with 'MyRole::Storage' => { |
123 | format => 'YAML', |
124 | }; |
125 | } qr/^Attribute \(format\) does not pass the type constraint/; |
126 | |
09156b03 |
127 | sub cant_ok { |
128 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
129 | my $instance = shift; |
130 | for my $method (@_) { |
131 | ok(!$instance->can($method), "$instance cannot $method"); |
132 | } |
133 | } |
134 | |