← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:31 2013

Filename/usr/share/perl5/Library/CallNumber/LC.pm
StatementsExecuted 1287 statements in 3.21ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11117.7ms32.5msLibrary::CallNumber::LC::::BEGIN@5Library::CallNumber::LC::BEGIN@5
11161µs80µsLibrary::CallNumber::LC::::_normalizeLibrary::CallNumber::LC::_normalize
11124µs65µsLibrary::CallNumber::LC::::BEGIN@241Library::CallNumber::LC::BEGIN@241
11117µs41µsLibrary::CallNumber::LC::::BEGIN@277Library::CallNumber::LC::BEGIN@277
11117µs37µsLibrary::CallNumber::LC::::BEGIN@247Library::CallNumber::LC::BEGIN@247
11116µs28µsLibrary::CallNumber::LC::::BEGIN@3Library::CallNumber::LC::BEGIN@3
11116µs16µsLibrary::CallNumber::LC::::newLibrary::CallNumber::LC::new
22112µs12µsLibrary::CallNumber::LC::::CORE:qrLibrary::CallNumber::LC::CORE:qr (opcode)
72112µs12µsLibrary::CallNumber::LC::::CORE:matchLibrary::CallNumber::LC::CORE:match (opcode)
1119µs16µsLibrary::CallNumber::LC::::BEGIN@4Library::CallNumber::LC::BEGIN@4
1117µs87µsLibrary::CallNumber::LC::::normalizeLibrary::CallNumber::LC::normalize
1113µs3µsLibrary::CallNumber::LC::::topperLibrary::CallNumber::LC::topper
5512µs2µsLibrary::CallNumber::LC::::CORE:substLibrary::CallNumber::LC::CORE:subst (opcode)
1112µs2µsLibrary::CallNumber::LC::::CORE:regcompLibrary::CallNumber::LC::CORE:regcomp (opcode)
0000s0sLibrary::CallNumber::LC::::bottomerLibrary::CallNumber::LC::bottomer
0000s0sLibrary::CallNumber::LC::::call_numberLibrary::CallNumber::LC::call_number
0000s0sLibrary::CallNumber::LC::::componentsLibrary::CallNumber::LC::components
0000s0sLibrary::CallNumber::LC::::end_of_rangeLibrary::CallNumber::LC::end_of_range
0000s0sLibrary::CallNumber::LC::::start_of_rangeLibrary::CallNumber::LC::start_of_range
0000s0sLibrary::CallNumber::LC::::toLongIntLibrary::CallNumber::LC::toLongInt
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Library::CallNumber::LC;
2
3329µs240µs
# spent 28µs (16+12) within Library::CallNumber::LC::BEGIN@3 which was called: # once (16µs+12µs) by C4::ClassSortRoutine::LCC::BEGIN@23 at line 3
use warnings;
# spent 28µs making 1 call to Library::CallNumber::LC::BEGIN@3 # spent 12µs making 1 call to warnings::import
4326µs222µs
# spent 16µs (9+6) within Library::CallNumber::LC::BEGIN@4 which was called: # once (9µs+6µs) by C4::ClassSortRoutine::LCC::BEGIN@23 at line 4
use strict;
# spent 16µs making 1 call to Library::CallNumber::LC::BEGIN@4 # spent 6µs making 1 call to strict::import
531.01ms246.4ms
# spent 32.5ms (17.7+14.9) within Library::CallNumber::LC::BEGIN@5 which was called: # once (17.7ms+14.9ms) by C4::ClassSortRoutine::LCC::BEGIN@23 at line 5
use Math::BigInt;
# spent 32.5ms making 1 call to Library::CallNumber::LC::BEGIN@5 # spent 13.8ms making 1 call to Math::BigInt::import
6
7=head1 NAME
8
- -
1711µsour $VERSION = '0.22';
18
19
20=head1 SYNOPSIS
21
- -
59# Set up the prefix mapping for longints
601400nsmy %intmap;
611500nsmy $i = 0;
6219µsforeach my $prefix (qw(a aa ab abc ac ae ag ah ai al am an anl ao ap aq arx as at aug aw awo ay az b bc bd bf bg bh bj bl bm bn bp bq br bs bt bu bv bx c cb cc cd ce cg cis cj cmh cmm cn cr cs ct cz d da daa daw db dc dd de df dff dg dh dj djk dk dkj dl doc dp dq dr ds dt dth du dx e ea eb ec ed ee ek ep epa ex f fb fc fem fg fj fnd fp fsd ft ful g ga gb gc gda ge gf gh gn gr gs gt gv h ha hb hc hcg hd he hf hfs hg hh hhg hj hjc hm hmk hn hq hs ht hv hx i ia ib iid ill ilm in ioe ip j ja jan jb jc jf jg jh jhe jj jk jkc jl jln jn jq js jv jx jz k kb kbm kbp kbq kbr kbu kc kd kdc kde kdg kdk kds kdz ke kea keb kem ken keo keq kes kf kfa kfc kfd kff kfg kfh kfi kfk kfl kfm kfn kfo kfp kfr kfs kft kfu kfv kfw kfx kfz kg kga kgb kgc kgd kge kgf kgg kgh kgj kgk kgl kgn kgq kgs kgt kgv kgx kh kha khc khd khf khh khk khp khq khu khw kit kj kja kjc kje kjg kjj kjk kjm kjn kjp kjq kjr kjs kjt kjv kjw kk kka kkb kkc kke kkf kkg kkh kki kkj kkm kkn kkp kkq kkr kks kkt kkv kkw kkx kky kkz kl kla klb kld kle klf klg klh klm kln klp klr kls klt klv klw km kmc kme kmf kmh kmj kmk kml kmm kmn kmo kmp kmq kmt kmu kmv kmx kn knc knd kne knf kng knh knk knl knm knn knp knq knr kns knt knu knw knx kny kp kpa kpc kpe kpf kpg kph kpj kpk kpl kpm kpp kps kpt kpv kpw kq kqc kqe kqg kqj kqk kqp kqw krb krc krg krm krn krp krr krs kru krv krx ks ksa ksc ksh ksj ksk ksl ksp kss kst ksv ksw ksx ksy kta ktd ktg ktj ktk ktl ktq ktr ktt ktu ktv ktw ktx kty ktz ku kuc kuq kvc kvf kvm kvn kvp kvq kvr kvs kvw kwc kwg kwh kwl kwp kwr kww kwx kz kza kzd l la law lb lc ld le lf lg lh lj ll ln lrm lt lv m may mb mc me mf mh mkl ml mpc mr ms mt my n na nat nax nb nc nd nda nds ne ner new ng nh nk nl nmb nn no nt nv nx ok onc p pa pb pc pcr pd pe pf pg ph phd pj pjc pk pl pm pn pnb pp pq pr ps pt pz q qa qb qc qd qe qh qk ql qm qp qr qry qu qv r ra rb rbw rc rcc rd re ref res rf rg rh rj rk rl rm rn rp rs rt rv rx rz s sb sd see sf sfk sgv sh sk sn sql sw t ta tc td tdd te tf tg tgg th tj tk tl tn tnj to tp tr ts tt tx tz u ua ub uc ud ue uf ug uh un use v va vb vc vd ve vf vg vk vla vm w wq x xp xx y yh yl yy z za zhn zz zzz)) {
631216775µs $intmap{$prefix} = $i;
64 $i++;
65}
66
67# Regexp constants to deal with matching LC and variants
68
69122µs111µsmy $lcregex = qr/^
# spent 11µs making 1 call to Library::CallNumber::LC::CORE:qr
70 \s*
71 (?:VIDEO-D)? # for video stuff
72 (?:DVD-ROM)? # DVDs, obviously
73 (?:CD-ROM)? # CDs
74 (?:TAPE-C)? # Tapes
75 \s*
76 ([A-Z]{1,3}) # alpha
77 \s*
78 (?: # optional numbers with optional decimal point
79 (\d+)
80 (?:\s*?\.\s*?(\d+))?
81 )?
82 \s*
83 (\d+[stndrh]*)? # optional extra numbering including suffixes (1st, 2nd, etc.)
84 \s*
85 (?: # optional cutter
86 \.? \s*
87 ([A-Z]) # cutter letter
88 \s*
89 (\d+ | \Z)? # cutter numbers
90 )?
91 \s*
92 (?: # optional cutter
93 \.? \s*
94 ([A-Z]) # cutter letter
95 \s*
96 (\d+ | \Z)? # cutter numbers
97 )?
98 \s*
99 (?: # optional cutter
100 \.? \s*
101 ([A-Z]) # cutter letter
102 \s*
103 (\d+ | \Z)? # cutter numbers
104 )?
105 (\s+.+?)? # everthing else
106 \s*$
107 /x;
108
- -
11114µs12µsmy $weird = qr/
# spent 2µs making 1 call to Library::CallNumber::LC::CORE:qr
112 ^
113 \s*[A-Z]+\s*\d+\.\d+\.\d+
114/x;
115
116# Class variables for top/bottom sort chars
1171500nsmy $Topper = ' '; # must sort before 'A'
1181400nsmy $Bottomer = '~'; # must sort after 'Z' and '9'
119
120
121=head1 CONSTRUCTORS
122
- -
127
# spent 16µs within Library::CallNumber::LC::new which was called: # once (16µs+0s) by C4::ClassSortRoutine::LCC::get_class_sort_key at line 55 of /usr/share/koha/lib/C4/ClassSortRoutine/LCC.pm
sub new {
128922µs my $proto = shift;
129 my $class = ref($proto) || $proto;
130 my $lc = shift || '';
131 my $topper = shift;
132 $topper = $Topper if !defined($topper); # ZERO is false but might be a reasonable value, so we need this more specific check
133 my $bottomer = shift || $Bottomer;
134 my $self = {
135 callno => uc($lc),
136 topper => $topper,
137 bottomer => $bottomer
138 };
139 bless $self, $class;
140 return $self;
141}
142
143
144=head1 BASIC ACCESSORS
145
- -
152sub call_number {
153 my $self = shift;
154 if (@_) { $self->{callno} = uc(shift) }
155 return $self->{callno};
156}
157
158=head2 topper([character])
159
- -
164
# spent 3µs within Library::CallNumber::LC::topper which was called: # once (3µs+0s) by Library::CallNumber::LC::_normalize at line 270
sub topper {
16531µs my $self = shift;
166 my $topper = shift;
16725µs if (ref $self) {
168 $self->{topper} = $topper if $topper; # just myself
169 return $self->{topper};
170 } else {
171 $Topper = $topper if $topper; # whole class
172 return $Topper;
173 }
174}
175
176=head2 bottomer([character])
177
- -
182sub bottomer {
183 my $self = shift;
184 my $bottomer = shift;
185 if (ref $self) {
186 $self->{bottomer} = $bottomer if $bottomer; # just myself
187 return $self->{bottomer};
188 } else {
189 $Bottomer = $bottomer if $bottomer; # whole class
190 return $Bottomer;
191 }
192}
193
194=head1 OTHER METHODS
195
- -
224sub components {
225 my $self = shift;
226 my $returnAll = shift;
227 my $lc = $self->{callno};
228
229 return undef if ($lc =~ $weird);
230 return undef unless ($lc =~ $lcregex);
231
232
233 my ($alpha, $num, $dec, $othernum, $c1alpha, $c1num, $c2alpha, $c2num, $c3alpha, $c3num, $extra) = ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11);
234
235 #combine stuff if need be
236
237 if ($dec) {
238 $num .= '.' . $dec;
239 }
240
2413148µs2106µs
# spent 65µs (24+41) within Library::CallNumber::LC::BEGIN@241 which was called: # once (24µs+41µs) by C4::ClassSortRoutine::LCC::BEGIN@23 at line 241
no warnings;
# spent 65µs making 1 call to Library::CallNumber::LC::BEGIN@241 # spent 41µs making 1 call to warnings::unimport
242 my $c1 = join('', $c1alpha, $c1num);
243 my $c2 = join('', $c2alpha, $c2num);
244 my $c3 = join('', $c3alpha, $c3num);
245
246 $c1 = '.' . $c1 if ($c1 =~ /\S/);
2473196µs256µs
# spent 37µs (17+20) within Library::CallNumber::LC::BEGIN@247 which was called: # once (17µs+20µs) by C4::ClassSortRoutine::LCC::BEGIN@23 at line 247
use warnings;
# spent 37µs making 1 call to Library::CallNumber::LC::BEGIN@247 # spent 20µs making 1 call to warnings::import
248
249 my @return;
250 foreach my $comp ($alpha, $num, $othernum, $c1, $c2, $c3, $extra) {
251 $comp = '' unless (defined $comp);
252 next unless ($comp =~ /\S/ or $returnAll);
253 $comp =~ m/^\s*(.*?)\s*$/;
254 $comp = $1;
255 push @return, $comp;
256 }
257 return @return;
258}
259
260=head2 _normalize(call_number_text)
261
- -
266
# spent 80µs (61+19) within Library::CallNumber::LC::_normalize which was called: # once (61µs+19µs) by Library::CallNumber::LC::normalize at line 310
sub _normalize {
2671862µs my $self = shift;
268 my $lc = uc(shift);
269
27013µs my $topper = $self->topper;
# spent 3µs making 1 call to Library::CallNumber::LC::topper
271
272# return undef if ($lc =~ $weird);
273211µs return undef unless ($lc =~ $lcregex);
# spent 9µs making 1 call to Library::CallNumber::LC::CORE:match # spent 2µs making 1 call to Library::CallNumber::LC::CORE:regcomp
274
275 my ($alpha, $num, $dec, $othernum, $c1alpha, $c1num, $c2alpha, $c2num, $c3alpha, $c3num, $extra) = ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11);
276
2773775µs265µs
# spent 41µs (17+24) within Library::CallNumber::LC::BEGIN@277 which was called: # once (17µs+24µs) by C4::ClassSortRoutine::LCC::BEGIN@23 at line 277
no warnings;
# spent 41µs making 1 call to Library::CallNumber::LC::BEGIN@277 # spent 24µs making 1 call to warnings::unimport
278 my $class = $alpha;
279 $class .= sprintf('%04s', $num) if $num;
280 $class .= $dec if $dec;
281 my $c1 = $c1alpha.$c1num;
282 my $c2 = $c2alpha.$c2num;
283 my $c3 = $c3alpha.$c3num;
284
285 # normalize extra (most commonly years/numbering, benefits from padding)
286 # this could be reduced to a four digit pad, as very, very few numbers
287 # reach 10000, but we'll be conservative here (for now)
2881700ns $extra =~ s/^\s+//g;
# spent 700ns making 1 call to Library::CallNumber::LC::CORE:subst
2891400ns $extra =~ s/\.\s+/./g;
# spent 400ns making 1 call to Library::CallNumber::LC::CORE:subst
2901300ns $extra =~ s/(\d)\s*-\s*(\d)/$1-$2/g;
# spent 300ns making 1 call to Library::CallNumber::LC::CORE:subst
2911300ns $extra =~ s/(\d+)/sprintf("%05s", $1)/ge;
# spent 300ns making 1 call to Library::CallNumber::LC::CORE:subst
292 $extra = $topper . $extra if ($extra ne ''); # give the extra less 'weight' for falling down the list
293
294 # pad out othernum (again, conservatively)
2951300ns $othernum =~ s/(\d+)/sprintf("%05s", $1)/ge;
# spent 300ns making 1 call to Library::CallNumber::LC::CORE:subst
296
297614µs63µs return join($topper, grep {/\S/} ($class, $othernum, $c1, $c2, $c3, $extra));
# spent 3µs making 6 calls to Library::CallNumber::LC::CORE:match, avg 567ns/call
298}
299
300=head2 normalize([call_number_text])
301
- -
306
# spent 87µs (7+80) within Library::CallNumber::LC::normalize which was called: # once (7µs+80µs) by C4::ClassSortRoutine::LCC::get_class_sort_key at line 57 of /usr/share/koha/lib/C4/ClassSortRoutine/LCC.pm
sub normalize {
30748µs my $self = shift;
308 my $lc = shift;
309 $lc = $lc? uc($lc) : $self->{callno};
310180µs return $self->_normalize($lc)
# spent 80µs making 1 call to Library::CallNumber::LC::_normalize
311}
312
313=head2 start_of_range([call_number_text])
314
- -
319sub start_of_range {
320 my $self = shift;
321 return $self->normalize(@_);
322}
323
324=head2 end_of_range([call_number_text])
325
- -
330sub end_of_range {
331 my $self = shift;
332 my $lc = shift;
333 $lc = $lc? uc($lc) : $self->{callno};
334 my $bottomer = $self->bottomer;
335 return $self->_normalize($lc) . $bottomer;
336}
337
338=head2 toLongInt(call_number_text, num_digits)
339
- -
34417µs1260µsmy $minval = new Math::BigInt('0'); # set to zero until this code matures
# spent 260µs making 1 call to Math::BigInt::new
34514µs135µsmy $minvalstring = $minval->bstr;
# spent 35µs making 1 call to Math::BigInt::bstr
346
347# this is a work in progress, with room for improvement in both exception
348# logic and overall economy of bits
349sub toLongInt {
350 my $self = shift;
351 my $lc = shift;
352 my $num_digits = shift || 19; # 19 is a max-fit for 64-bits within our scope
353
354 my $topper = $self->topper;
355 my $bottomer = $self->bottomer;
356
357 #print "$lc\n";
358 my $topper_ord = ord($topper);
359 my $long = $self->normalize($lc);
360
361 return $minvalstring unless ($long);
362
363 my ($alpha, $num, $rest);
364 if ($long =~ /^([A-Z]+)(\d{4})(.*)$/) { # we have a 'full' call number
365 ($alpha, $num, $rest) = (lc($1), $2, $3);
366 } elsif ($long =~ /^([A-Z]+)(.*)$/) { # numberless class; generally invalid, but let it slide for now
367 ($alpha, $rest) = (lc($1), $2);
368 if ($rest =~ /^$bottomer/) { # bottomed-out class
369 $num = '9999';
370 } else {
371 $num = '0000';
372 }
373 }
374 my $class_int_string = '';
375 if (defined($intmap{$alpha})) {
376 $class_int_string .= $intmap{$alpha} . $num;
377 } else {
378 warn "Unknown prefix '$alpha'\n";
379 return $minvalstring;
380 }
381 my $rest_int_string = '';
382 my $bottomout;
383 foreach my $char (split('', $rest)) {
384 if ($char eq $bottomer) {
385 $bottomout = 1;
386 last;
387 }
388 $rest_int_string .= sprintf('%02d', ord($char) - $topper_ord);
389 }
390
391 $rest_int_string = substr($rest_int_string, 0, $num_digits - 7); # Reserve first seven digits for $alpha and $num
392 if ($bottomout) {
393 $rest_int_string .= '9' x (($num_digits - 7) - length($rest_int_string)); # pad it if need be
394 } else {
395 $rest_int_string .= '0' x (($num_digits - 7) - length($rest_int_string)); # pad it if need be
396 }
397
398# print " $long => ", join('', @rv), "\n";
399 my $longint = Math::BigInt->new($class_int_string . $rest_int_string);
400 $longint->badd($minval);
401# warn "\n\n".$self->_normalize($lc)." = ".$longint->bstr." ( $class_int_string + $rest_int_string) \n\n";
402 return $longint->bstr;
403
404}
405
- -
408=head1 AUTHOR
409
- -
445192µs1; # End of Library::CallNumber::LC
 
# spent 12µs within Library::CallNumber::LC::CORE:match which was called 7 times, avg 2µs/call: # 6 times (3µs+0s) by Library::CallNumber::LC::_normalize at line 297, avg 567ns/call # once (9µs+0s) by Library::CallNumber::LC::_normalize at line 273
sub Library::CallNumber::LC::CORE:match; # opcode
# spent 12µs within Library::CallNumber::LC::CORE:qr which was called 2 times, avg 6µs/call: # once (11µs+0s) by C4::ClassSortRoutine::LCC::BEGIN@23 at line 69 # once (2µs+0s) by C4::ClassSortRoutine::LCC::BEGIN@23 at line 111
sub Library::CallNumber::LC::CORE:qr; # opcode
# spent 2µs within Library::CallNumber::LC::CORE:regcomp which was called: # once (2µs+0s) by Library::CallNumber::LC::_normalize at line 273
sub Library::CallNumber::LC::CORE:regcomp; # opcode
# spent 2µs within Library::CallNumber::LC::CORE:subst which was called 5 times, avg 400ns/call: # once (700ns+0s) by Library::CallNumber::LC::_normalize at line 288 # once (400ns+0s) by Library::CallNumber::LC::_normalize at line 289 # once (300ns+0s) by Library::CallNumber::LC::_normalize at line 291 # once (300ns+0s) by Library::CallNumber::LC::_normalize at line 295 # once (300ns+0s) by Library::CallNumber::LC::_normalize at line 290
sub Library::CallNumber::LC::CORE:subst; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.