6 use Scalar::Util qw( isweak );
11 package HasClassAttribute;
14 use MooseX::ClassAttribute;
15 use MooseX::AttributeHelpers;
20 class_has 'ObjectCount' =>
26 class_has 'WeakAttribute' =>
32 class_has 'LazyAttribute' =>
36 # The side effect is used to test that this was called
38 default => sub { $Lazy = 1 },
41 class_has 'ReadOnlyAttribute' =>
47 class_has 'ManyNames' =>
56 class_has 'Delegatee' =>
59 handles => [ 'units', 'color' ],
60 # if it's not lazy it makes a new object before we define
61 # Delegatee's attributes.
63 default => sub { Delegatee->new() },
66 class_has 'Mapping' =>
67 ( metaclass => 'Collection::Hash',
69 isa => 'HashRef[Str]',
70 default => sub { {} },
72 { exists => 'ExistsInMapping',
73 keys => 'IdsInMapping',
81 builder => '_BuildIt',
84 class_has 'LazyBuilt' =>
87 builder => '_BuildIt',
102 $self->ObjectCount( $self->ObjectCount() + 1 );
111 $class->meta()->make_immutable();
112 Delegatee->meta()->make_immutable();
138 use MooseX::ClassAttribute;
140 extends 'HasClassAttribute';
142 class_has '+ReadOnlyAttribute' =>
145 class_has 'YetAnotherAttribute' =>
157 local $Test::Builder::Level = $Test::Builder::Level + 1;
160 is( HasClassAttribute->ObjectCount(), 0,
161 'ObjectCount() is 0' );
163 my $hca1 = HasClassAttribute->new();
164 is( $hca1->size(), 5,
165 'size is 5 - object attribute works as expected' );
166 is( HasClassAttribute->ObjectCount(), 1,
167 'ObjectCount() is 1' );
169 my $hca2 = HasClassAttribute->new( size => 10 );
170 is( $hca2->size(), 10,
171 'size is 10 - object attribute can be set via constructor' );
172 is( HasClassAttribute->ObjectCount(), 2,
173 'ObjectCount() is 2' );
174 is( $hca2->ObjectCount(), 2,
175 'ObjectCount() is 2 - can call class attribute accessor on object' );
179 my $hca3 = HasClassAttribute->new( ObjectCount => 20 );
180 is( $hca3->ObjectCount(), 3,
181 'class attributes passed to the constructor do not get set in the object' );
182 is( HasClassAttribute->ObjectCount(), 3,
183 'class attributes are not affected by constructor params' );
187 my $object = bless {}, 'Thing';
189 HasClassAttribute->WeakAttribute($object);
193 ok( ! defined HasClassAttribute->WeakAttribute(),
194 'weak class attributes are weak' );
198 is( $HasClassAttribute::Lazy, 0,
199 '$HasClassAttribute::Lazy is 0' );
201 is( HasClassAttribute->LazyAttribute(), 1,
202 'HasClassAttribute->LazyAttribute() is 1' );
204 is( $HasClassAttribute::Lazy, 1,
205 '$HasClassAttribute::Lazy is 1 after calling LazyAttribute' );
209 eval { HasClassAttribute->ReadOnlyAttribute(20) };
210 like( $@, qr/\QCannot assign a value to a read-only accessor/,
211 'cannot set read-only class attribute' );
215 is( Child->ReadOnlyAttribute(), 30,
216 q{Child class can extend parent's class attribute} );
220 ok( ! HasClassAttribute->HasM(),
221 'HasM() returns false before M is set' );
223 HasClassAttribute->SetM(22);
225 ok( HasClassAttribute->HasM(),
226 'HasM() returns true after M is set' );
227 is( HasClassAttribute->M(), 22,
230 HasClassAttribute->ClearM();
232 ok( ! HasClassAttribute->HasM(),
233 'HasM() returns false after M is cleared' );
237 isa_ok( HasClassAttribute->Delegatee(), 'Delegatee',
238 'has a Delegetee object' );
239 is( HasClassAttribute->units(), 5,
240 'units() delegates to Delegatee and returns 5' );
244 my @ids = HasClassAttribute->IdsInMapping();
246 'there are no keys in the mapping yet' );
248 ok( ! HasClassAttribute->ExistsInMapping('a'),
249 'key does not exist in mapping' );
251 HasClassAttribute->SetMapping( a => 20 );
253 ok( HasClassAttribute->ExistsInMapping('a'),
254 'key does exist in mapping' );
256 is( HasClassAttribute->GetMapping('a'), 20,
257 'value for a in mapping is 20' );
261 is( HasClassAttribute->Built(), 42,
262 'attribute with builder works' );
264 is( HasClassAttribute->LazyBuilt(), 42,
265 'attribute with lazy builder works' );