Commit | Line | Data |
---|---|---|
1a7ebbb3 | 1 | |
9ec169fe | 2 | package # hide the package from PAUSE |
3 | InstanceCountingClass; | |
1a7ebbb3 | 4 | |
5 | use strict; | |
6 | use warnings; | |
7 | ||
a4258ffd | 8 | our $VERSION = '0.03'; |
1a7ebbb3 | 9 | |
e2f8b029 | 10 | use base 'Class::MOP::Class'; |
1a7ebbb3 | 11 | |
1aeb4c53 | 12 | InstanceCountingClass->meta->add_attribute('count' => ( |
550d56db | 13 | reader => 'get_count', |
14 | default => 0 | |
15 | )); | |
1a7ebbb3 | 16 | |
d69fb6b3 | 17 | InstanceCountingClass->meta->add_before_method_modifier('_construct_instance' => sub { |
a4258ffd | 18 | my ($class) = @_; |
1aeb4c53 | 19 | $class->{'count'}++; |
a4258ffd | 20 | }); |
1a7ebbb3 | 21 | |
e2f8b029 | 22 | 1; |
23 | ||
24 | __END__ | |
25 | ||
26 | =pod | |
27 | ||
28 | =head1 NAME | |
29 | ||
30 | InstanceCountingClass - An example metaclass which counts instances | |
31 | ||
32 | =head1 SYNOPSIS | |
33 | ||
34 | package Foo; | |
35 | ||
677eb158 | 36 | use metaclass 'InstanceCountingClass'; |
37 | ||
e2f8b029 | 38 | sub new { |
39 | my $class = shift; | |
5659d76e | 40 | $class->meta->new_object(@_); |
e2f8b029 | 41 | } |
42 | ||
43 | # ... meanwhile, somewhere in the code | |
44 | ||
45 | my $foo = Foo->new(); | |
46 | print Foo->meta->get_count(); # prints 1 | |
47 | ||
48 | my $foo2 = Foo->new(); | |
49 | print Foo->meta->get_count(); # prints 2 | |
50 | ||
51 | # ... etc etc etc | |
52 | ||
53 | =head1 DESCRIPTION | |
54 | ||
55 | This is a classic example of a metaclass which keeps a count of each | |
56 | instance which is created. | |
57 | ||
1a09d9cc | 58 | =head1 AUTHORS |
e2f8b029 | 59 | |
60 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |
61 | ||
1a09d9cc | 62 | Yuval Kogman E<lt>nothingmuch@woobling.comE<gt> |
63 | ||
e2f8b029 | 64 | =head1 COPYRIGHT AND LICENSE |
65 | ||
69e3ab0a | 66 | Copyright 2006-2008 by Infinity Interactive, Inc. |
e2f8b029 | 67 | |
68 | L<http://www.iinteractive.com> | |
69 | ||
70 | This library is free software; you can redistribute it and/or modify | |
71 | it under the same terms as Perl itself. | |
72 | ||
73 | =cut |