← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:20 2010

File /usr/local/lib/perl5/site_perl/5.10.1/Class/Data/Inheritable.pm
Statements Executed 104
Statement Execution Time 340µs
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
184164µs64µsClass::Data::Inheritable::::__ANON__[:23]Class::Data::Inheritable::__ANON__[:23]
44137µs37µsClass::Data::Inheritable::::mk_classdataClass::Data::Inheritable::mk_classdata
11113µs30µsClass::Data::Inheritable::::BEGIN@3Class::Data::Inheritable::BEGIN@3
1117µs35µsClass::Data::Inheritable::::BEGIN@4Class::Data::Inheritable::BEGIN@4
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Class::Data::Inheritable;
2
3324µs248µ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
use strict qw(vars subs);
# spent 30µs making 1 call to Class::Data::Inheritable::BEGIN@3 # spent 18µs making 1 call to strict::import
43177µs263µ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
use vars qw($VERSION);
# spent 35µs making 1 call to Class::Data::Inheritable::BEGIN@4 # spent 28µs making 1 call to vars::import
51600ns$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
sub mk_classdata {
82444µ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
my $accessor = sub {
167285µ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
30110µs1;
31
32__END__
33
34=head1 NAME
35
36Class::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
54Class::Data::Inheritable is for creating accessor/mutators to class
55data. That is, if you want to store something about your class as a
56whole (instead of about a single object). This data is then inherited
57by your subclasses and can be overriden.
58
59For example:
60
61 Pere::Ubu->mk_classdata('Suitcase');
62
63will generate the method Suitcase() in the class Pere::Ubu.
64
65This 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
70The 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
78Raygun inherits its Suitcase class data from Pere::Ubu.
79
80Inheritance of class data works analogous to method inheritance. As
81long as Raygun does not "override" its inherited class data (by using
82Suitcase() to set a new value) it will continue to use whatever is set
83in 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
88However, 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
90overriden a method:
91
92 # Raygun has an orange suitcase, Pere::Ubu's is still Blue.
93 Raygun->Suitcase('Orange');
94
95Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu
96no 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
108This is a class method used to declare new class data accessors.
109A new accessor will be created in the Class using the name from
110$data_accessor_name, and optionally initially setting it to the given
111value.
112
113To facilitate overriding, mk_classdata creates an alias to the
114accessor, _field_accessor(). So Suitcase() would have an alias
115_Suitcase_accessor() that does the exact same thing as Suitcase().
116This is useful if you want to alter the behavior of a single accessor
117yet 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
128Original code by Damian Conway.
129
130Maintained by Michael G Schwern until September 2005.
131
132Now maintained by Tony Bowden.
133
134=head1 BUGS and QUERIES
135
136Please direct all correspondence regarding this module to:
137 bug-Class-Data-Inheritable@rt.cpan.org
138
139=head1 COPYRIGHT and LICENSE
140
141Copyright (c) 2000-2005, Damian Conway and Michael G Schwern.
142All Rights Reserved.
143
144This module is free software. It may be used, redistributed and/or
145modified under the same terms as Perl itself.
146
147=head1 SEE ALSO
148
149L<perltooc> has a very elaborate discussion of class data in Perl.
150