← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:45 2010

File /project/perl/lib/Class/Data/Inheritable.pm
Statements Executed 6120
Statement Execution Time 48.5ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
148429740.4ms41.9msClass::Data::Inheritable::::__ANON__[:23]Class::Data::Inheritable::__ANON__[:23]
351952.08ms2.08msClass::Data::Inheritable::::mk_classdataClass::Data::Inheritable::mk_classdata
0000s0sClass::Data::Inheritable::::BEGINClass::Data::Inheritable::BEGIN
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
33100µs1111µsuse strict qw(vars subs);
# spent 111µs making 1 call to strict::import
43457µs1137µsuse vars qw($VERSION);
# spent 137µs making 1 call to vars::import
517µs$VERSION = '0.06';
6
7
# spent 2.08ms within Class::Data::Inheritable::mk_classdata which was called 35 times, avg 60µs/call: # 17 times (1.06ms+0s) by Class::Data::Inheritable::__ANON__[/project/perl/lib/Class/Data/Inheritable.pm:23] at line 18, avg 63µs/call # once (73µs+0s) by base::import at line 59 of Class/DBI.pm # once (69µs+0s) by base::import at line 90 of Class/DBI.pm # once (68µs+0s) by base::import at line 10 of Ima/DBI.pm # once (65µs+0s) by base::import at line 98 of Class/DBI.pm # once (60µs+0s) by base::import at line 18 of Class/DBI/Plugin/Pager.pm # once (60µs+0s) by base::import at line 81 of Class/DBI.pm # once (56µs+0s) by Class::DBI::Plugin::RetrieveAll::import at line 79 of Class/DBI/Plugin/RetrieveAll.pm # once (54µs+0s) by base::import at line 82 of Class/DBI.pm # once (53µs+0s) by base::import at line 85 of Class/DBI.pm # once (53µs+0s) by base::import at line 87 of Class/DBI.pm # once (53µs+0s) by base::import at line 144 of Class/DBI.pm # once (53µs+0s) by base::import at line 86 of Class/DBI.pm # once (52µs+0s) by base::import at line 19 of Class/DBI/Plugin/Pager.pm # once (52µs+0s) by base::import at line 84 of Class/DBI.pm # once (52µs+0s) by base::import at line 83 of Class/DBI.pm # once (52µs+0s) by base::import at line 89 of Class/DBI.pm # once (49µs+0s) by base::import at line 11 of Ima/DBI.pm # once (48µs+0s) by base::import at line 88 of Class/DBI.pm
sub mk_classdata {
82102.33ms 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 41.9ms (40.4+1.55) within Class::Data::Inheritable::__ANON__[/project/perl/lib/Class/Data/Inheritable.pm:23] which was called 1484 times, avg 28µs/call: # 464 times (11.7ms+0s) by Class::DBI::primary_column at line 275 of Class/DBI.pm, avg 25µs/call # 463 times (13.1ms+0s) by Class::DBI::_find_columns at line 294 of Class/DBI.pm, avg 28µs/call # 461 times (12.2ms+0s) by Class::DBI::_fresh_init at line 512 of Class/DBI.pm, avg 26µs/call # 17 times (488µs+0s) by Class::Data::Inheritable::__ANON__[/project/perl/lib/Class/Data/Inheritable.pm:23] at line 18, avg 29µs/call # 13 times (454µs+256µs) by Ima::DBI::set_sql at line 362 of Ima/DBI.pm, avg 55µs/call # 13 times (369µs+0s) by Ima::DBI::set_sql at line 360 of Ima/DBI.pm, avg 28µs/call # 8 times (320µs+205µs) by Class::DBI::_set_columns at line 249 of Class/DBI.pm, avg 66µs/call # 5 times (266µs+258µs) by Class::DBI::_extend_class_data at line 1210 of Class/DBI.pm, avg 105µs/call # 5 times (238µs+172µs) by Class::DBI::_extend_meta at line 1042 of Class/DBI.pm, avg 82µs/call # 5 times (132µs+0s) by Class::DBI::_extend_meta at line 1040 of Class/DBI.pm, avg 26µs/call # 5 times (132µs+0s) by Class::DBI::_extend_class_data at line 1208 of Class/DBI.pm, avg 26µs/call # 4 times (105µs+0s) by Class::DBI::table at line 220 of Class/DBI.pm, avg 26µs/call # 3 times (79µs+0s) by Class::DBI::find_column at line 289 of Class/DBI.pm, avg 26µs/call # 2 times (155µs+204µs) by Class::DBI::table at line 218 of Class/DBI.pm, avg 180µs/call # 2 times (58µs+0s) by Class::DBI::transform_sql at line 151 of Class/DBI.pm, avg 29µs/call # once (97µs+96µs) by main::BEGIN at line 5 of Wiki/DB/Wiki.pm # once (81µs+99µs) by Class::DBI::_require_class at line 6 of Wiki/DB/WikiCategories.pm # once (70µs+90µs) by Class::DBI::Plugin::RetrieveAll::__ANON__[/project/perl/lib/Class/DBI/Plugin/RetrieveAll.pm:84] at line 83 of Class/DBI/Plugin/RetrieveAll.pm # once (69µs+86µs) by Class::DBI::set_db at line 211 of Class/DBI.pm # once (57µs+85µs) by Ima::DBI::_remember_handle at line 305 of Ima/DBI.pm # once (29µs+0s) by Class::DBI::Plugin::RetrieveAll::__ANON__[/project/perl/lib/Class/DBI/Plugin/RetrieveAll.pm:93] at line 90 of Class/DBI/Plugin/RetrieveAll.pm # once (28µs+0s) by Class::DBI::meta_info at line 1047 of Class/DBI.pm # once (27µs+0s) by Ima::DBI::_remember_handle at line 303 of Ima/DBI.pm # once (27µs+0s) by Class::DBI::_flesh at line 854 of Class/DBI.pm # once (27µs+0s) by base::import at line 145 of Class/DBI.pm # once (27µs+0s) by Class::DBI::_essential at line 285 of Class/DBI.pm # once (26µs+0s) by Class::DBI::Plugin::Pager::import at line 93 of Class/DBI/Plugin/Pager.pm # once (26µs+0s) by Class::DBI::_default_attributes at line 201 of Class/DBI.pm # once (25µs+0s) by Class::DBI::get at line 844 of Class/DBI.pm
my $accessor = sub {
16590245.6ms my $wantclass = ref($_[0]) || $_[0];
17
18 return $wantclass->mk_classdata($attribute)->(@_)
# spent 1.06ms making 17 calls to Class::Data::Inheritable::mk_classdata, avg 63µs/call # spent 488µs making 17 calls to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23], avg 29µs/call
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
30111µ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 terms of the Perl Artistic License (see
146http://www.perl.com/perl/misc/Artistic.html)
147
148=head1 SEE ALSO
149
150L<perltootc> has a very elaborate discussion of class data in Perl.
151
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.