Profile of /usr/local/lib/perl5/site_perl/5.10.1/Class/Data/Inheritable.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:10 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/Class/Data/Inheritable.pm
Statements Executed | 44
Statement Execution Time | 9.52ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
4 | 4 | 1 | 62µs | 62µs | Class::Data::Inheritable::::mk_classdataClass::Data::Inheritable::mk_classdata
1 | 1 | 1 | 22µs | 34µs | Class::Data::Inheritable::::BEGIN@3Class::Data::Inheritable::BEGIN@3
3 | 3 | 1 | 11µs | 11µs | Class::Data::Inheritable::::__ANON__[:23]Class::Data::Inheritable::__ANON__[:23]
1 | 1 | 1 | 6µs | 24µs | Class::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Class::Data::Inheritable;
2 |  |  |  |  |
3 | 3 | 24µs | 2 | 46µs | # spent 34µs (22+12) within Class::Data::Inheritable::BEGIN@3 which was called # once (22µs+12µs) by Exception::Class::Base::BEGIN@8 at line 3 use strict qw(vars subs); # spent 34µs making 1 call to Class::Data::Inheritable::BEGIN@3 # spent 12µs making 1 call to strict::import
4 | 3 | 9.39ms | 2 | 42µs | # spent 24µs (6+18) within Class::Data::Inheritable::BEGIN@4 which was called # once (6µs+18µs) by Exception::Class::Base::BEGIN@8 at line 4 use vars qw($VERSION); # spent 24µs making 1 call to Class::Data::Inheritable::BEGIN@4 # spent 18µs making 1 call to vars::import
5 | 1 | 3µs |  |  | $VERSION = '0.08';
6 |  |  |  |  |
7 |  |  |  |  | # spent 62µs within Class::Data::Inheritable::mk_classdata which was called 4 times, avg 15µs/call: # once (21µs+0s) by Exception::Class::Base::BEGIN@14 at line 16 of Exception/Class/Base.pm # once (18µs+0s) by Exception::Class::Base::BEGIN@14 at line 15 of Exception/Class/Base.pm # once (12µs+0s) by Exception::Class::Base::BEGIN@14 at line 19 of Exception/Class/Base.pm # once (10µs+0s) by Exception::Class::Base::BEGIN@14 at line 22 of Exception/Class/Base.pm sub mk_classdata {
8 | 24 | 73µ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 11µs within Class::Data::Inheritable::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Class/Data/Inheritable.pm:23] which was called 3 times, avg 4µs/call: # once (5µs+0s) by Exception::Class::Base::BEGIN@14 at line 17 of Exception/Class/Base.pm # once (3µs+0s) by Exception::Class::Base::BEGIN@14 at line 23 of Exception/Class/Base.pm # once (3µs+0s) by Exception::Class::Base::BEGIN@14 at line 20 of Exception/Class/Base.pm my $accessor = sub {
16 | 12 | 20µ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 |  |  |  |  |