6 use Scalar::Util qw( isweak );
10 package HasClassAttribute;
13 use MooseX::ClassAttribute;
14 use MooseX::AttributeHelpers;
19 class_has 'ObjectCount' => (
25 class_has 'WeakAttribute' => (
31 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' ],
61 # if it's not lazy it makes a new object before we define
62 # Delegatee's attributes.
64 default => sub { Delegatee->new() },
67 class_has 'Mapping' => (
68 metaclass => 'Collection::Hash',
70 isa => 'HashRef[Str]',
71 default => sub { {} },
73 exists => 'ExistsInMapping',
74 keys => 'IdsInMapping',
80 class_has 'Built' => (
82 builder => '_BuildIt',
85 class_has 'LazyBuilt' => (
88 builder => '_BuildIt',
91 class_has 'Triggerish' => (
93 trigger => sub { shift->_CallTrigger(@_) },
107 $self->ObjectCount( $self->ObjectCount() + 1 );
115 push @Triggered, [@_];
121 $class->meta()->make_immutable();
122 Delegatee->meta()->make_immutable();
148 use MooseX::ClassAttribute;
150 extends 'HasClassAttribute';
152 class_has '+ReadOnlyAttribute' => ( default => 30 );
154 class_has 'YetAnotherAttribute' => (
165 local $Test::Builder::Level = $Test::Builder::Level + 1;
169 HasClassAttribute->ObjectCount(), 0,
173 my $hca1 = HasClassAttribute->new();
176 'size is 5 - object attribute works as expected'
179 HasClassAttribute->ObjectCount(), 1,
183 my $hca2 = HasClassAttribute->new( size => 10 );
186 'size is 10 - object attribute can be set via constructor'
189 HasClassAttribute->ObjectCount(), 2,
193 $hca2->ObjectCount(), 2,
194 'ObjectCount() is 2 - can call class attribute accessor on object'
199 my $hca3 = HasClassAttribute->new( ObjectCount => 20 );
201 $hca3->ObjectCount(), 3,
202 'class attributes passed to the constructor do not get set in the object'
205 HasClassAttribute->ObjectCount(), 3,
206 'class attributes are not affected by constructor params'
211 my $object = bless {}, 'Thing';
213 HasClassAttribute->WeakAttribute($object);
218 !defined HasClassAttribute->WeakAttribute(),
219 'weak class attributes are weak'
225 $HasClassAttribute::Lazy, 0,
226 '$HasClassAttribute::Lazy is 0'
230 HasClassAttribute->LazyAttribute(), 1,
231 'HasClassAttribute->LazyAttribute() is 1'
235 $HasClassAttribute::Lazy, 1,
236 '$HasClassAttribute::Lazy is 1 after calling LazyAttribute'
241 eval { HasClassAttribute->ReadOnlyAttribute(20) };
243 $@, qr/\QCannot assign a value to a read-only accessor/,
244 'cannot set read-only class attribute'
250 Child->ReadOnlyAttribute(), 30,
251 q{Child class can extend parent's class attribute}
257 !HasClassAttribute->HasM(),
258 'HasM() returns false before M is set'
261 HasClassAttribute->SetM(22);
264 HasClassAttribute->HasM(),
265 'HasM() returns true after M is set'
268 HasClassAttribute->M(), 22,
272 HasClassAttribute->ClearM();
275 !HasClassAttribute->HasM(),
276 'HasM() returns false after M is cleared'
282 HasClassAttribute->Delegatee(), 'Delegatee',
283 'has a Delegetee object'
286 HasClassAttribute->units(), 5,
287 'units() delegates to Delegatee and returns 5'
292 my @ids = HasClassAttribute->IdsInMapping();
295 'there are no keys in the mapping yet'
299 !HasClassAttribute->ExistsInMapping('a'),
300 'key does not exist in mapping'
303 HasClassAttribute->SetMapping( a => 20 );
306 HasClassAttribute->ExistsInMapping('a'),
307 'key does exist in mapping'
311 HasClassAttribute->GetMapping('a'), 20,
312 'value for a in mapping is 20'
318 HasClassAttribute->Built(), 42,
319 'attribute with builder works'
323 HasClassAttribute->LazyBuilt(), 42,
324 'attribute with lazy builder works'
329 HasClassAttribute->Triggerish(42);
330 is( scalar @HasClassAttribute::Triggered, 1, 'trigger was called' );
331 is( HasClassAttribute->Triggerish(), 42, 'Triggerish is now 42' );
333 HasClassAttribute->Triggerish(84);
334 is( HasClassAttribute->Triggerish(), 84, 'Triggerish is now 84' );
337 \@HasClassAttribute::Triggered,
339 [qw( HasClassAttribute 42 )],
340 [qw( HasClassAttribute 84 42 )],
342 'trigger passes old value correctly'