← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:49 2015

Filename/usr/share/perl5/Class/Accessor.pm
StatementsExecuted 397 statements in 1.51ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
311251µs365µsClass::Accessor::::_mk_accessors Class::Accessor::_mk_accessors
161138µs38µsClass::Accessor::::make_accessor Class::Accessor::make_accessor
33327µs392µsClass::Accessor::::mk_accessors Class::Accessor::mk_accessors
161116µs16µsClass::Accessor::::accessor_name_for Class::Accessor::accessor_name_for
44415µs15µsClass::Accessor::::import Class::Accessor::import
161112µs12µsClass::Accessor::::mutator_name_for Class::Accessor::mutator_name_for
11111µs21µsClass::Accessor::::BEGIN@3 Class::Accessor::BEGIN@3
1117µs16µsClass::Accessor::::BEGIN@27 Class::Accessor::BEGIN@27
1114µs4µsClass::Accessor::::BEGIN@218 Class::Accessor::BEGIN@218
0000s0sC4::Templates::::activethemes C4::Templates::activethemes
0000s0sC4::Templates::::filename C4::Templates::filename
0000s0sC4::Templates::::htdocs C4::Templates::htdocs
0000s0sC4::Templates::::interface C4::Templates::interface
0000s0sC4::Templates::::lang C4::Templates::lang
0000s0sC4::Templates::::preferredtheme C4::Templates::preferredtheme
0000s0sC4::Templates::::theme C4::Templates::theme
0000s0sC4::Templates::::vars C4::Templates::vars
0000s0sClass::Accessor::::__ANON__[:182] Class::Accessor::__ANON__[:182]
0000s0sClass::Accessor::::__ANON__[:198] Class::Accessor::__ANON__[:198]
0000s0sClass::Accessor::::__ANON__[:214] Class::Accessor::__ANON__[:214]
0000s0sClass::Accessor::::__ANON__[:37] Class::Accessor::__ANON__[:37]
0000s0sClass::Accessor::::__ANON__[:43] Class::Accessor::__ANON__[:43]
0000s0sClass::Accessor::::_carp Class::Accessor::_carp
0000s0sClass::Accessor::::_croak Class::Accessor::_croak
0000s0sClass::Accessor::::best_practice_accessor_name_for Class::Accessor::best_practice_accessor_name_for
0000s0sClass::Accessor::::best_practice_mutator_name_for Class::Accessor::best_practice_mutator_name_for
0000s0sClass::Accessor::::follow_best_practice Class::Accessor::follow_best_practice
0000s0sClass::Accessor::::get Class::Accessor::get
0000s0sClass::Accessor::::make_ro_accessor Class::Accessor::make_ro_accessor
0000s0sClass::Accessor::::make_wo_accessor Class::Accessor::make_wo_accessor
0000s0sClass::Accessor::::mk_ro_accessors Class::Accessor::mk_ro_accessors
0000s0sClass::Accessor::::mk_wo_accessors Class::Accessor::mk_wo_accessors
0000s0sClass::Accessor::::new Class::Accessor::new
0000s0sClass::Accessor::::set Class::Accessor::set
0000s0sMARC::Charset::Code::::altMARC::Charset::Code::alt
0000s0sMARC::Charset::Code::::charsetMARC::Charset::Code::charset
0000s0sMARC::Charset::Code::::is_combiningMARC::Charset::Code::is_combining
0000s0sMARC::Charset::Code::::marcMARC::Charset::Code::marc
0000s0sMARC::Charset::Code::::marc_left_halfMARC::Charset::Code::marc_left_half
0000s0sMARC::Charset::Code::::marc_right_halfMARC::Charset::Code::marc_right_half
0000s0sMARC::Charset::Code::::nameMARC::Charset::Code::name
0000s0sMARC::Charset::Code::::ucsMARC::Charset::Code::ucs
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Class::Accessor;
218µsrequire 5.00502;
32110µs232µs
# spent 21µs (11+11) within Class::Accessor::BEGIN@3 which was called: # once (11µs+11µs) by base::import at line 3
use strict;
# spent 21µs making 1 call to Class::Accessor::BEGIN@3 # spent 11µs making 1 call to strict::import
41300ns$Class::Accessor::VERSION = '0.34';
5
6sub new {
7 my($proto, $fields) = @_;
8 my($class) = ref $proto || $proto;
9
10 $fields = {} unless defined $fields;
11
12 # make a copy of $fields.
13 bless {%$fields}, $class;
14}
15
16
# spent 392µs (27+365) within Class::Accessor::mk_accessors which was called 3 times, avg 131µs/call: # once (10µs+188µs) by C4::Auth::BEGIN@29 at line 39 of C4/Templates.pm # once (7µs+171µs) by MARC::Charset::Table::BEGIN@43 at line 10 of MARC/Charset/Code.pm # once (10µs+6µs) by C4::Biblio::BEGIN@38 at line 52 of C4/Linker.pm
sub mk_accessors {
1734µs my($self, @fields) = @_;
18
19322µs3365µs $self->_mk_accessors('rw', @fields);
# spent 365µs making 3 calls to Class::Accessor::_mk_accessors, avg 122µs/call
20}
21
2226µs126µsif (eval { require Sub::Name }) {
# spent 26µs making 1 call to Exporter::import
23 Sub::Name->import;
24}
25
26{
273882µs225µs
# spent 16µs (7+9) within Class::Accessor::BEGIN@27 which was called: # once (7µs+9µs) by base::import at line 27
no strict 'refs';
# spent 16µs making 1 call to Class::Accessor::BEGIN@27 # spent 9µs making 1 call to strict::unimport
28
29
# spent 15µs within Class::Accessor::import which was called 4 times, avg 4µs/call: # once (5µs+0s) by C4::Output::BEGIN@36 at line 36 of C4/Output.pm # once (4µs+0s) by C4::Biblio::BEGIN@38 at line 38 of C4/Biblio.pm # once (4µs+0s) by C4::Auth::BEGIN@29 at line 29 of C4/Auth.pm # once (2µs+0s) by MARC::Charset::Table::BEGIN@43 at line 43 of MARC/Charset/Table.pm
sub import {
3043µs my ($class, @what) = @_;
3143µs my $caller = caller;
32418µs for (@what) {
33 if (/^(?:antlers|moose-?like)$/i) {
34 *{"${caller}::has"} = sub {
35 my ($f, %args) = @_;
36 $caller->_mk_accessors(($args{is}||"rw"), $f);
37 };
38 *{"${caller}::extends"} = sub {
39 @{"${caller}::ISA"} = @_;
40 unless (grep $_->can("_mk_accessors"), @_) {
41 push @{"${caller}::ISA"}, $class;
42 }
43 };
44 # we'll use their @ISA as a default, in case it happens to be
45 # set already
46 &{"${caller}::extends"}(@{"${caller}::ISA"});
47 }
48 }
49 }
50
51 sub follow_best_practice {
52 my($self) = @_;
53 my $class = ref $self || $self;
54 *{"${class}::accessor_name_for"} = \&best_practice_accessor_name_for;
55 *{"${class}::mutator_name_for"} = \&best_practice_mutator_name_for;
56 }
57
58
# spent 365µs (251+114) within Class::Accessor::_mk_accessors which was called 3 times, avg 122µs/call: # 3 times (251µs+114µs) by Class::Accessor::mk_accessors at line 19, avg 122µs/call
sub _mk_accessors {
5933µs my($self, $access, @fields) = @_;
6031µs my $class = ref $self || $self;
6132µs my $ra = $access eq 'rw' || $access eq 'ro';
6231µs my $wa = $access eq 'rw' || $access eq 'wo';
63
64314µs foreach my $field (@fields) {
651618µs1616µs my $accessor_name = $self->accessor_name_for($field);
# spent 16µs making 16 calls to Class::Accessor::accessor_name_for, avg 1µs/call
661615µs1612µs my $mutator_name = $self->mutator_name_for($field);
# spent 12µs making 16 calls to Class::Accessor::mutator_name_for, avg 750ns/call
67164µs if( $accessor_name eq 'DESTROY' or $mutator_name eq 'DESTROY' ) {
68 $self->_carp("Having a data accessor named DESTROY in '$class' is unwise.");
69 }
70168µs if ($accessor_name eq $mutator_name) {
7116900ns my $accessor;
721617µs1638µs if ($ra && $wa) {
# spent 38µs making 16 calls to Class::Accessor::make_accessor, avg 2µs/call
73 $accessor = $self->make_accessor($field);
74 } elsif ($ra) {
75 $accessor = $self->make_ro_accessor($field);
76 } else {
77 $accessor = $self->make_wo_accessor($field);
78 }
79167µs my $fullname = "${class}::$accessor_name";
80162µs my $subnamed = 0;
811626µs unless (defined &{$fullname}) {
821672µs1648µs subname($fullname, $accessor) if defined &subname;
# spent 48µs making 16 calls to Sub::Name::subname, avg 3µs/call
83162µs $subnamed = 1;
841618µs *{$fullname} = $accessor;
85 }
86167µs if ($accessor_name eq $field) {
87 # the old behaviour
88168µs my $alias = "${class}::_${field}_accessor";
89163µs subname($alias, $accessor) if defined &subname and not $subnamed;
901633µs *{$alias} = $accessor unless defined &{$alias};
91 }
92 } else {
93 my $fullaccname = "${class}::$accessor_name";
94 my $fullmutname = "${class}::$mutator_name";
95 if ($ra and not defined &{$fullaccname}) {
96 my $accessor = $self->make_ro_accessor($field);
97 subname($fullaccname, $accessor) if defined &subname;
98 *{$fullaccname} = $accessor;
99 }
100 if ($wa and not defined &{$fullmutname}) {
101 my $mutator = $self->make_wo_accessor($field);
102 subname($fullmutname, $mutator) if defined &subname;
103 *{$fullmutname} = $mutator;
104 }
105 }
106 }
107 }
108
109}
110
111sub mk_ro_accessors {
112 my($self, @fields) = @_;
113
114 $self->_mk_accessors('ro', @fields);
115}
116
117sub mk_wo_accessors {
118 my($self, @fields) = @_;
119
120 $self->_mk_accessors('wo', @fields);
121}
122
123sub best_practice_accessor_name_for {
124 my ($class, $field) = @_;
125 return "get_$field";
126}
127
128sub best_practice_mutator_name_for {
129 my ($class, $field) = @_;
130 return "set_$field";
131}
132
133
# spent 16µs within Class::Accessor::accessor_name_for which was called 16 times, avg 1µs/call: # 16 times (16µs+0s) by Class::Accessor::_mk_accessors at line 65, avg 1µs/call
sub accessor_name_for {
134164µs my ($class, $field) = @_;
1351629µs return $field;
136}
137
138
# spent 12µs within Class::Accessor::mutator_name_for which was called 16 times, avg 750ns/call: # 16 times (12µs+0s) by Class::Accessor::_mk_accessors at line 66, avg 750ns/call
sub mutator_name_for {
139163µs my ($class, $field) = @_;
1401620µs return $field;
141}
142
143sub set {
144 my($self, $key) = splice(@_, 0, 2);
145
146 if(@_ == 1) {
147 $self->{$key} = $_[0];
148 }
149 elsif(@_ > 1) {
150 $self->{$key} = [@_];
151 }
152 else {
153 $self->_croak("Wrong number of arguments received");
154 }
155}
156
157sub get {
158 my $self = shift;
159
160 if(@_ == 1) {
161 return $self->{$_[0]};
162 }
163 elsif( @_ > 1 ) {
164 return @{$self}{@_};
165 }
166 else {
167 $self->_croak("Wrong number of arguments received");
168 }
169}
170
171
# spent 38µs within Class::Accessor::make_accessor which was called 16 times, avg 2µs/call: # 16 times (38µs+0s) by Class::Accessor::_mk_accessors at line 72, avg 2µs/call
sub make_accessor {
172163µs my ($class, $field) = @_;
173
174 return sub {
175 my $self = shift;
176
177 if(@_) {
178 return $self->set($field, @_);
179 } else {
180 return $self->get($field);
181 }
1821649µs };
183}
184
185sub make_ro_accessor {
186 my($class, $field) = @_;
187
188 return sub {
189 my $self = shift;
190
191 if (@_) {
192 my $caller = caller;
193 $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
194 }
195 else {
196 return $self->get($field);
197 }
198 };
199}
200
201sub make_wo_accessor {
202 my($class, $field) = @_;
203
204 return sub {
205 my $self = shift;
206
207 unless (@_) {
208 my $caller = caller;
209 $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
210 }
211 else {
212 return $self->set($field, @_);
213 }
214 };
215}
216
217
218279µs14µs
# spent 4µs within Class::Accessor::BEGIN@218 which was called: # once (4µs+0s) by base::import at line 218
use Carp ();
# spent 4µs making 1 call to Class::Accessor::BEGIN@218
219
220sub _carp {
221 my ($self, $msg) = @_;
222 Carp::carp($msg || $self);
223 return;
224}
225
226sub _croak {
227 my ($self, $msg) = @_;
228 Carp::croak($msg || $self);
229 return;
230}
231
23213µs1;
233
234__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.