File | /usr/local/lib/perl5/site_perl/5.10.1/Class/Data/Inheritable.pm |
Statements Executed | 104 |
Statement Execution Time | 340µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
18 | 4 | 1 | 64µs | 64µs | __ANON__[:23] | Class::Data::Inheritable::
4 | 4 | 1 | 37µs | 37µs | mk_classdata | Class::Data::Inheritable::
1 | 1 | 1 | 13µs | 30µs | BEGIN@3 | Class::Data::Inheritable::
1 | 1 | 1 | 7µs | 35µs | BEGIN@4 | Class::Data::Inheritable::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Class::Data::Inheritable; | ||||
2 | |||||
3 | 3 | 24µs | 2 | 48µs | # spent 30µs (13+18) within Class::Data::Inheritable::BEGIN@3 which was called
# once (13µs+18µs) by Exception::Class::Base::BEGIN@8 at line 3 # spent 30µs making 1 call to Class::Data::Inheritable::BEGIN@3
# spent 18µs making 1 call to strict::import |
4 | 3 | 177µs | 2 | 63µs | # spent 35µs (7+28) within Class::Data::Inheritable::BEGIN@4 which was called
# once (7µs+28µs) by Exception::Class::Base::BEGIN@8 at line 4 # spent 35µs making 1 call to Class::Data::Inheritable::BEGIN@4
# spent 28µs making 1 call to vars::import |
5 | 1 | 600ns | $VERSION = '0.08'; | ||
6 | |||||
7 | # spent 37µs within Class::Data::Inheritable::mk_classdata which was called 4 times, avg 9µs/call:
# once (12µs+0s) by Exception::Class::Base::BEGIN@14 at line 22 of Exception/Class/Base.pm
# once (10µs+0s) by Exception::Class::Base::BEGIN@14 at line 15 of Exception/Class/Base.pm
# once (7µs+0s) by Exception::Class::Base::BEGIN@14 at line 16 of Exception/Class/Base.pm
# once (7µs+0s) by Exception::Class::Base::BEGIN@14 at line 19 of Exception/Class/Base.pm | ||||
8 | 24 | 44µs | my ($declaredclass, $attribute, $data) = @_; | ||
9 | |||||
10 | if( ref $declaredclass ) { | ||||
11 | require Carp; | ||||
12 | Carp::croak("mk_classdata() is a class method, not an object method"); | ||||
13 | } | ||||
14 | |||||
15 | # spent 64µs within Class::Data::Inheritable::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Class/Data/Inheritable.pm:23] which was called 18 times, avg 4µs/call:
# 15 times (57µs+0s) by Exception::Class::Base::_initialize at line 133 of Exception/Class/Base.pm, avg 4µs/call
# once (3µs+0s) by Exception::Class::Base::BEGIN@14 at line 17 of Exception/Class/Base.pm
# once (2µs+0s) by Exception::Class::Base::BEGIN@14 at line 23 of Exception/Class/Base.pm
# once (2µs+0s) by Exception::Class::Base::BEGIN@14 at line 20 of Exception/Class/Base.pm | ||||
16 | 72 | 85µs | my $wantclass = ref($_[0]) || $_[0]; | ||
17 | |||||
18 | return $wantclass->mk_classdata($attribute)->(@_) | ||||
19 | if @_>1 && $wantclass ne $declaredclass; | ||||
20 | |||||
21 | $data = $_[1] if @_>1; | ||||
22 | return $data; | ||||
23 | }; | ||||
24 | |||||
25 | my $alias = "_${attribute}_accessor"; | ||||
26 | *{$declaredclass.'::'.$attribute} = $accessor; | ||||
27 | *{$declaredclass.'::'.$alias} = $accessor; | ||||
28 | } | ||||
29 | |||||
30 | 1 | 10µs | 1; | ||
31 | |||||
32 | __END__ | ||||
33 | |||||
34 | =head1 NAME | ||||
35 | |||||
36 | Class::Data::Inheritable - Inheritable, overridable class data | ||||
37 | |||||
38 | =head1 SYNOPSIS | ||||
39 | |||||
40 | package Stuff; | ||||
41 | use base qw(Class::Data::Inheritable); | ||||
42 | |||||
43 | # Set up DataFile as inheritable class data. | ||||
44 | Stuff->mk_classdata('DataFile'); | ||||
45 | |||||
46 | # Declare the location of the data file for this class. | ||||
47 | Stuff->DataFile('/etc/stuff/data'); | ||||
48 | |||||
49 | # Or, all in one shot: | ||||
50 | Stuff->mk_classdata(DataFile => '/etc/stuff/data'); | ||||
51 | |||||
52 | =head1 DESCRIPTION | ||||
53 | |||||
54 | Class::Data::Inheritable is for creating accessor/mutators to class | ||||
55 | data. That is, if you want to store something about your class as a | ||||
56 | whole (instead of about a single object). This data is then inherited | ||||
57 | by your subclasses and can be overriden. | ||||
58 | |||||
59 | For example: | ||||
60 | |||||
61 | Pere::Ubu->mk_classdata('Suitcase'); | ||||
62 | |||||
63 | will generate the method Suitcase() in the class Pere::Ubu. | ||||
64 | |||||
65 | This new method can be used to get and set a piece of class data. | ||||
66 | |||||
67 | Pere::Ubu->Suitcase('Red'); | ||||
68 | $suitcase = Pere::Ubu->Suitcase; | ||||
69 | |||||
70 | The interesting part happens when a class inherits from Pere::Ubu: | ||||
71 | |||||
72 | package Raygun; | ||||
73 | use base qw(Pere::Ubu); | ||||
74 | |||||
75 | # Raygun's suitcase is Red. | ||||
76 | $suitcase = Raygun->Suitcase; | ||||
77 | |||||
78 | Raygun inherits its Suitcase class data from Pere::Ubu. | ||||
79 | |||||
80 | Inheritance of class data works analogous to method inheritance. As | ||||
81 | long as Raygun does not "override" its inherited class data (by using | ||||
82 | Suitcase() to set a new value) it will continue to use whatever is set | ||||
83 | in Pere::Ubu and inherit further changes: | ||||
84 | |||||
85 | # Both Raygun's and Pere::Ubu's suitcases are now Blue | ||||
86 | Pere::Ubu->Suitcase('Blue'); | ||||
87 | |||||
88 | However, should Raygun decide to set its own Suitcase() it has now | ||||
89 | "overridden" Pere::Ubu and is on its own, just like if it had | ||||
90 | overriden a method: | ||||
91 | |||||
92 | # Raygun has an orange suitcase, Pere::Ubu's is still Blue. | ||||
93 | Raygun->Suitcase('Orange'); | ||||
94 | |||||
95 | Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu | ||||
96 | no longer effect Raygun. | ||||
97 | |||||
98 | # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite. | ||||
99 | Pere::Ubu->Suitcase('Samsonite'); | ||||
100 | |||||
101 | =head1 Methods | ||||
102 | |||||
103 | =head2 mk_classdata | ||||
104 | |||||
105 | Class->mk_classdata($data_accessor_name); | ||||
106 | Class->mk_classdata($data_accessor_name => $value); | ||||
107 | |||||
108 | This is a class method used to declare new class data accessors. | ||||
109 | A new accessor will be created in the Class using the name from | ||||
110 | $data_accessor_name, and optionally initially setting it to the given | ||||
111 | value. | ||||
112 | |||||
113 | To facilitate overriding, mk_classdata creates an alias to the | ||||
114 | accessor, _field_accessor(). So Suitcase() would have an alias | ||||
115 | _Suitcase_accessor() that does the exact same thing as Suitcase(). | ||||
116 | This is useful if you want to alter the behavior of a single accessor | ||||
117 | yet still get the benefits of inheritable class data. For example. | ||||
118 | |||||
119 | sub Suitcase { | ||||
120 | my($self) = shift; | ||||
121 | warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid'; | ||||
122 | |||||
123 | $self->_Suitcase_accessor(@_); | ||||
124 | } | ||||
125 | |||||
126 | =head1 AUTHOR | ||||
127 | |||||
128 | Original code by Damian Conway. | ||||
129 | |||||
130 | Maintained by Michael G Schwern until September 2005. | ||||
131 | |||||
132 | Now maintained by Tony Bowden. | ||||
133 | |||||
134 | =head1 BUGS and QUERIES | ||||
135 | |||||
136 | Please direct all correspondence regarding this module to: | ||||
137 | bug-Class-Data-Inheritable@rt.cpan.org | ||||
138 | |||||
139 | =head1 COPYRIGHT and LICENSE | ||||
140 | |||||
141 | Copyright (c) 2000-2005, Damian Conway and Michael G Schwern. | ||||
142 | All Rights Reserved. | ||||
143 | |||||
144 | This module is free software. It may be used, redistributed and/or | ||||
145 | modified under the same terms as Perl itself. | ||||
146 | |||||
147 | =head1 SEE ALSO | ||||
148 | |||||
149 | L<perltooc> has a very elaborate discussion of class data in Perl. | ||||
150 |