← 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:40 2013

Filename/usr/share/perl5/Business/ISBN.pm
StatementsExecuted 33 statements in 3.16ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.65ms3.88msBusiness::ISBN::::BEGIN@75Business::ISBN::BEGIN@75
111695µs1.26msBusiness::ISBN::::BEGIN@133Business::ISBN::BEGIN@133
111661µs1.39msBusiness::ISBN::::BEGIN@132Business::ISBN::BEGIN@132
111247µs292µsBusiness::ISBN::::BEGIN@61Business::ISBN::BEGIN@61
11184µs84µsBusiness::ISBN::::CORE:sortBusiness::ISBN::CORE:sort (opcode)
11122µs29µsBusiness::ISBN::::BEGIN@4Business::ISBN::BEGIN@4
11121µs116µsBusiness::ISBN::::BEGIN@73Business::ISBN::BEGIN@73
11115µs114µsBusiness::ISBN::::BEGIN@72Business::ISBN::BEGIN@72
11114µs137µsBusiness::ISBN::::BEGIN@69Business::ISBN::BEGIN@69
11113µs13µsBusiness::ISBN::::BEGIN@99Business::ISBN::BEGIN@99
0000s0sBusiness::ISBN::::_check_validityBusiness::ISBN::_check_validity
0000s0sBusiness::ISBN::::_checksum_posBusiness::ISBN::_checksum_pos
0000s0sBusiness::ISBN::::_common_formatBusiness::ISBN::_common_format
0000s0sBusiness::ISBN::::_get_xisbnBusiness::ISBN::_get_xisbn
0000s0sBusiness::ISBN::::_group_code_lengthBusiness::ISBN::_group_code_length
0000s0sBusiness::ISBN::::_group_dataBusiness::ISBN::_group_data
0000s0sBusiness::ISBN::::_hyphen_positionsBusiness::ISBN::_hyphen_positions
0000s0sBusiness::ISBN::::_initBusiness::ISBN::_init
0000s0sBusiness::ISBN::::_max_group_code_lengthBusiness::ISBN::_max_group_code_length
0000s0sBusiness::ISBN::::_max_publisher_code_lengthBusiness::ISBN::_max_publisher_code_length
0000s0sBusiness::ISBN::::_parse_article_codeBusiness::ISBN::_parse_article_code
0000s0sBusiness::ISBN::::_parse_checksumBusiness::ISBN::_parse_checksum
0000s0sBusiness::ISBN::::_parse_group_codeBusiness::ISBN::_parse_group_code
0000s0sBusiness::ISBN::::_parse_isbnBusiness::ISBN::_parse_isbn
0000s0sBusiness::ISBN::::_parse_publisher_codeBusiness::ISBN::_parse_publisher_code
0000s0sBusiness::ISBN::::_prefix_lengthBusiness::ISBN::_prefix_length
0000s0sBusiness::ISBN::::_publisher_code_lengthBusiness::ISBN::_publisher_code_length
0000s0sBusiness::ISBN::::_publisher_rangesBusiness::ISBN::_publisher_ranges
0000s0sBusiness::ISBN::::_set_article_codeBusiness::ISBN::_set_article_code
0000s0sBusiness::ISBN::::_set_checksumBusiness::ISBN::_set_checksum
0000s0sBusiness::ISBN::::_set_group_codeBusiness::ISBN::_set_group_code
0000s0sBusiness::ISBN::::_set_group_code_stringBusiness::ISBN::_set_group_code_string
0000s0sBusiness::ISBN::::_set_is_validBusiness::ISBN::_set_is_valid
0000s0sBusiness::ISBN::::_set_isbnBusiness::ISBN::_set_isbn
0000s0sBusiness::ISBN::::_set_prefixBusiness::ISBN::_set_prefix
0000s0sBusiness::ISBN::::_set_publisher_codeBusiness::ISBN::_set_publisher_code
0000s0sBusiness::ISBN::::_set_publisher_code_stringBusiness::ISBN::_set_publisher_code_string
0000s0sBusiness::ISBN::::_set_typeBusiness::ISBN::_set_type
0000s0sBusiness::ISBN::::_xisbn_urlBusiness::ISBN::_xisbn_url
0000s0sBusiness::ISBN::::article_codeBusiness::ISBN::article_code
0000s0sBusiness::ISBN::::as_isbn10Business::ISBN::as_isbn10
0000s0sBusiness::ISBN::::as_isbn13Business::ISBN::as_isbn13
0000s0sBusiness::ISBN::::as_stringBusiness::ISBN::as_string
0000s0sBusiness::ISBN::::checksumBusiness::ISBN::checksum
0000s0sBusiness::ISBN::::common_dataBusiness::ISBN::common_data
0000s0sBusiness::ISBN::::errorBusiness::ISBN::error
0000s0sBusiness::ISBN::::fix_checksumBusiness::ISBN::fix_checksum
0000s0sBusiness::ISBN::::groupBusiness::ISBN::group
0000s0sBusiness::ISBN::::group_codeBusiness::ISBN::group_code
0000s0sBusiness::ISBN::::input_isbnBusiness::ISBN::input_isbn
0000s0sBusiness::ISBN::::is_validBusiness::ISBN::is_valid
0000s0sBusiness::ISBN::::is_valid_checksumBusiness::ISBN::is_valid_checksum
0000s0sBusiness::ISBN::::isbnBusiness::ISBN::isbn
0000s0sBusiness::ISBN::::newBusiness::ISBN::new
0000s0sBusiness::ISBN::::png_barcodeBusiness::ISBN::png_barcode
0000s0sBusiness::ISBN::::prefixBusiness::ISBN::prefix
0000s0sBusiness::ISBN::::publisher_codeBusiness::ISBN::publisher_code
0000s0sBusiness::ISBN::::typeBusiness::ISBN::type
0000s0sBusiness::ISBN::::valid_isbn_checksumBusiness::ISBN::valid_isbn_checksum
0000s0sBusiness::ISBN::::xisbnBusiness::ISBN::xisbn
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# $Revision: 2.16 $
2# $Id: ISBN.pm,v 2.16 2008/08/09 04:29:55 comdog Exp $
3package Business::ISBN;
4355µs236µs
# spent 29µs (22+7) within Business::ISBN::BEGIN@4 which was called: # once (22µs+7µs) by C4::Search::BEGIN@36 at line 4
use strict;
# spent 29µs making 1 call to Business::ISBN::BEGIN@4 # spent 7µs making 1 call to strict::import
5
6=head1 NAME
7
- -
58# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
59# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
60# # Boring set up stuff
61145µs
# spent 292µs (247+45) within Business::ISBN::BEGIN@61 which was called: # once (247µs+45µs) by C4::Search::BEGIN@36 at line 68
use subs qw(
# spent 45µs making 1 call to subs::import
62 _common_format
63 INVALID_GROUP_CODE
64 INVALID_PUBLISHER_CODE
65 BAD_CHECKSUM
66 GOOD_ISBN
67 BAD_ISBN
683213µs1292µs );
# spent 292µs making 1 call to Business::ISBN::BEGIN@61
691123µs
# spent 137µs (14+123) within Business::ISBN::BEGIN@69 which was called: # once (14µs+123µs) by C4::Search::BEGIN@36 at line 70
use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS $debug %group_data
# spent 123µs making 1 call to vars::import
70338µs1137µs $MAX_GROUP_CODE_LENGTH %ERROR_TEXT );
# spent 137µs making 1 call to Business::ISBN::BEGIN@69
71
72339µs2213µs
# spent 114µs (15+99) within Business::ISBN::BEGIN@72 which was called: # once (15µs+99µs) by C4::Search::BEGIN@36 at line 72
use Carp qw(carp croak cluck);
# spent 114µs making 1 call to Business::ISBN::BEGIN@72 # spent 99µs making 1 call to Exporter::import
73352µs2211µs
# spent 116µs (21+95) within Business::ISBN::BEGIN@73 which was called: # once (21µs+95µs) by C4::Search::BEGIN@36 at line 73
use base qw(Exporter);
# spent 116µs making 1 call to Business::ISBN::BEGIN@73 # spent 95µs making 1 call to base::import
74
753440µs23.89ms
# spent 3.88ms (3.65+222µs) within Business::ISBN::BEGIN@75 which was called: # once (3.65ms+222µs) by C4::Search::BEGIN@36 at line 75
use Business::ISBN::Data 20081208; # now a separate module
# spent 3.88ms making 1 call to Business::ISBN::BEGIN@75 # spent 19µs making 1 call to UNIVERSAL::VERSION
76# ugh, hack
7713µs*group_data = *Business::ISBN::country_data;
78sub _group_data { $group_data{ $_[1] } }
79
80sub _max_group_code_length { $Business::ISBN::MAX_COUNTRY_CODE_LENGTH };
81sub _max_publisher_code_length {
82 $_[0]->_max_length
83
84 - $_[0]->_prefix_length # prefix
85
86 - $_[0]->_group_code_length # group
87 - 1 # article
88 - 1; # checksum
89 };
90
91sub _publisher_ranges
92 {
93 my $self = shift;
94 [ @{ $self->_group_data( $self->group_code )->[1] } ];
95 }
96
971500nsmy $debug = 0;
98
99
# spent 13µs within Business::ISBN::BEGIN@99 which was called: # once (13µs+0s) by C4::Search::BEGIN@36 at line 111
BEGIN {
100211µs @EXPORT_OK = qw(
101 INVALID_GROUP_CODE INVALID_PUBLISHER_CODE
102 BAD_CHECKSUM GOOD_ISBN BAD_ISBN
103 INVALID_PREFIX
104 %ERROR_TEXT
105 valid_isbn_checksum
106 );
107
108 %EXPORT_TAGS = (
109 'all' => \@EXPORT_OK,
110 );
1111109µs113µs };
# spent 13µs making 1 call to Business::ISBN::BEGIN@99
112
1131400ns$VERSION = "2.05";
114
115sub INVALID_PREFIX () { -4 };
116sub INVALID_GROUP_CODE () { -2 };
117sub INVALID_PUBLISHER_CODE () { -3 };
118sub BAD_CHECKSUM () { -1 };
119sub GOOD_ISBN () { 1 };
120sub BAD_ISBN () { 0 };
121
122
12317µs%ERROR_TEXT = (
124 0 => "Bad ISBN",
125 1 => "Good ISBN",
126 -1 => "Bad ISBN checksum",
127 -2 => "Invalid group code",
128 -3 => "Invalid publisher code",
129 -4 => "Invalid prefix (must be 978 or 979)",
130 );
131
1323162µs21.41ms
# spent 1.39ms (661µs+727µs) within Business::ISBN::BEGIN@132 which was called: # once (661µs+727µs) by C4::Search::BEGIN@36 at line 132
use Business::ISBN10;
# spent 1.39ms making 1 call to Business::ISBN::BEGIN@132 # spent 26µs making 1 call to Exporter::import
13332.01ms21.29ms
# spent 1.26ms (695µs+564µs) within Business::ISBN::BEGIN@133 which was called: # once (695µs+564µs) by C4::Search::BEGIN@36 at line 133
use Business::ISBN13;
# spent 1.26ms making 1 call to Business::ISBN::BEGIN@133 # spent 26µs making 1 call to Exporter::import
134
135=head2 Function interface
136
- -
157sub valid_isbn_checksum
158 {
159 my $isbn = shift;
160
161 my $obj = Business::ISBN->new( $isbn );
162
163 return 1 if $obj->is_valid_checksum == GOOD_ISBN;
164 return 0 if $obj->is_valid_checksum == BAD_CHECKSUM;
165 return;
166 }
167
168=head2 Object interface
169
- -
224# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
225# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
226sub new
227 {
228 my $class = shift;
229 my $input_data = shift;
230 my $common_data = _common_format $input_data;
231
232 return unless $common_data;
233
234 my $self = {
235 input_isbn => $input_data,
236 common_data => $common_data
237 };
238
239 my $isbn = do {
240 if( length( $common_data ) == 10 )
241 {
242 bless $self, 'Business::ISBN10';
243 }
244 elsif( length( $common_data ) == 13 )
245 {
246 bless $self, 'Business::ISBN13';
247 }
248 else
249 {
250 return BAD_ISBN;
251 }
252 };
253
254 $self->_init( $common_data );
255 $self->_parse_isbn( $common_data );
256
257 return $isbn;
258 }
259
260=back
261
- -
273sub input_isbn { $_[0]->{'input_isbn'} }
274
275=item common_data
276
- -
282sub common_data { $_[0]->{'common_data'} }
283
284
285=item isbn
286
- -
295sub isbn { $_[0]->{'isbn'} }
296
297=item error
298
- -
304sub error { $_[0]->{'valid'} }
305
306=item is_valid
307
- -
314sub is_valid { $_[0]->{'valid'} eq GOOD_ISBN }
315
316=item type
317
- -
322sub type { $_[0]->{'type'} }
323
324
325=item prefix
326
- -
333sub prefix { $_[0]->{'prefix'} }
334sub _prefix_length { length $_[0]->{'prefix'} }
335
336=item group_code
337
- -
344sub group_code { $_[0]->{'group_code'} }
345
346=item group
347
- -
354sub group { $_[0]->_group_data( $_[0]->group_code )->[0] }
355
356sub _group_code_length {
357 length(
358 defined $_[0]->{'group_code'} ? $_[0]->{'group_code'} : ''
359 );
360 }
361
362=item publisher_code
363
- -
369sub publisher_code { $_[0]->{'publisher_code'} }
370sub _publisher_code_length {
371 length(
372 defined $_[0]->{'publisher_code'} ? $_[0]->{'publisher_code'} : ''
373 );
374 }
375
376=item article_code
377
- -
383sub article_code { $_[0]->{'article_code'} }
384
385=item checksum
386
- -
392sub checksum { $_[0]->{'checksum'} }
393sub _checksum_pos { length( $_[0]->isbn ) - 1 }
394
395
396=item is_valid_checksum
397
- -
404sub is_valid_checksum
405 {
406 my $self = shift;
407
408 cluck "is_valid_checksum: Didn't get object!" unless ref $self;
409
410 return GOOD_ISBN if $self->checksum eq $self->_checksum;
411
412 return BAD_CHECKSUM;
413 }
414
415=item fix_checksum
416
- -
421sub fix_checksum
422 {
423 my $self = shift;
424
425 my $last_char = substr($self->isbn, $self->_checksum_pos, 1);
426 my $checksum = $self->_checksum;
427
428 my $isbn = $self->isbn;
429 substr($isbn, $self->_checksum_pos, 1) = $checksum;
430
431 $self->_set_isbn( $isbn );
432 $self->_set_checksum( $checksum );
433
434 $self->_check_validity;
435
436 return 0 if $last_char eq $checksum;
437 return 1;
438 }
439
440
441=item as_string(), as_string([])
442
- -
465sub as_string
466 {
467 my $self = shift;
468 my $array_ref = shift;
469
470 #this allows one to override the positions settings from the
471 #constructor
472 $array_ref = $self->_hyphen_positions unless ref $array_ref eq ref [];
473
474# print STDERR Data::Dumper->Dump( [$array_ref], [qw(array_ref)] );
475# print STDERR Data::Dumper->Dump( [$self], [qw(self)] );
476
477 return unless $self->is_valid eq GOOD_ISBN;
478 my $isbn = $self->isbn;
479
480 foreach my $position ( sort { $b <=> $a } @$array_ref )
481 {
482 next if $position > 12 or $position < 1;
483 substr($isbn, $position, 0) = '-';
484 }
485
486 return $isbn;
487 }
488
489=item as_isbn10
490
- -
497sub as_isbn10
498 {
499 croak "as_isbn10() must be implemented in Business::ISBN subclass"
500 }
501
502=item as_isbn13
503
- -
510sub as_isbn13
511 {
512 croak "as_isbn13() must be implemented in Business::ISBN subclass"
513 }
514
515=item xisbn
516
- -
524sub xisbn
525 {
526 my $self = shift;
527
528 my $data = $self->_get_xisbn;
529 $data =~ tr/x/X/;
530
531 my @isbns = $data =~ m|<isbn>(.*?)</isbn>|ig;
532 shift @isbns;
533 wantarray ? @isbns : \@isbns;
534 }
535
536sub _get_xisbn
537 {
538 my $self = shift;
539
540 eval "use LWP::Simple";
541 if( $@ ) { carp "You need LWP::Simple to use xisbn()"; return; }
542
543 my $data = LWP::Simple::get( $self->_xisbn_url );
544
545 carp "Could not fetch xISBN data" unless defined $data;
546
547 return $data;
548 }
549
550sub _xisbn_url
551 {
552 my $self = shift;
553 my $isbn = $self->as_string([]);
554
555 return "http://labs.oclc.org/xisbn/$isbn";
556 }
557
558=item png_barcode
559
- -
568sub png_barcode
569 {
570 my $self = shift;
571
572 my $ean = $self->as_isbn13->as_string([]);
573
574 eval "use GD::Barcode::EAN13";
575 if( $@ )
576 {
577 carp "Need GD::Barcode::EAN13 to use png_barcode!";
578 return;
579 }
580
581 my $image = GD::Barcode::EAN13->new($ean)->plot->png;
582
583 return $image;
584 }
585
586=back
587
- -
590sub _set_isbn { $_[0]->{'isbn'} = $_[1]; }
591
592sub _set_is_valid { $_[0]->{'valid'} = $_[1]; }
593
594sub _set_prefix
595 {
596 croak "_set_prefix() must be implemented in Business::ISBN subclass"
597 }
598
599sub _set_group_code { $_[0]->{'group_code'} = $_[1]; }
600
601sub _set_group_code_string { $_[0]->{'group_code_string'} = $_[1]; }
602
603sub _set_publisher_code { $_[0]->{'publisher_code'} = $_[1]; }
604
605sub _set_publisher_code_string { $_[0]->{'publisher_code_string'} = $_[1]; }
606
607sub _set_article_code { $_[0]->{'article_code'} = $_[1]; }
608
609sub _set_checksum { $_[0]->{'checksum'} = $_[1]; }
610
611sub _set_type
612 {
613 croak "_set_type() must be implemented in Business::ISBN subclass"
614 }
615
616
617# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
618# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
619# # internal methods. you don't get to use this one.
620sub _common_format
621 {
622 #we want uppercase X's
623 my $data = uc shift;
624
625 #get rid of everything except decimal digits and X
626 $data =~ s/[^0-9X]//g;
627
628 return $1 if $data =~ m/
629 \A #anchor at start
630 (
631 (?:\d\d\d)?
632 \d{9}[0-9X]
633 )
634 \z #anchor at end
635 /x;
636
637 return;
638 }
639
640sub _init
641 {
642 my $self = shift;
643 my $common_data = shift;
644
645 my $class = ref $self =~ m/.*::(.*)/g;
646
647 $self->_set_type;
648 $self->_set_isbn( $common_data );
649
650 # we don't know if we have a valid group code yet
651 # so let's assume that we don't
652 $self->_set_is_valid( INVALID_GROUP_CODE );
653 }
654
655{
65627µsmy @methods = (
657 [ qw( prefix ), INVALID_PREFIX ],
658 [ qw( group_code ), INVALID_GROUP_CODE ],
659 [ qw( publisher_code ), INVALID_PUBLISHER_CODE ],
660 [ qw( article_code ), BAD_ISBN ],
661 [ qw( checksum ), BAD_CHECKSUM ],
662 );
663
664sub _parse_isbn
665 {
666 my $self = shift;
667
668 foreach my $pair ( @methods )
669 {
670 my( $method, $error_code ) = @$pair;
671
672 my $parser = "_parse_$method";
673 my $result = $self->$parser;
674
675 unless( defined $result )
676 {
677 $self->_set_is_valid( $error_code );
678 #print STDERR "Got bad result for $method [$$self{isbn}]\n";
679 return;
680 }
681
682 $method = "_set_$method";
683 $self->$method( $result );
684 }
685
686 $self->_set_is_valid( $self->is_valid_checksum );
687
688 return $self;
689 }
690}
691
692sub _parse_group_code
693 {
694 my $self = shift;
695
696 my $trial; # try this to see what we get
697 my $group_code_length = 0;
698
699 my $count = 1;
700
701 GROUP_CODE:
702 while( defined( $trial= substr($self->isbn, $self->_prefix_length, $count++) ) )
703 {
704 if( defined $self->_group_data( $trial ) )
705 {
706 return $trial;
707 last GROUP_CODE;
708 }
709
710 # if we've past the point of finding a group
711 # code we're pretty much stuffed.
712 return if $count > $self->_max_group_code_length;
713 }
714
715 return; #failed if I got this far
716 }
717
718sub _parse_publisher_code
719 {
720 my $self = shift;
721
722 my $pairs = $self->_publisher_ranges;
723
724 # get the longest possible publisher code
725 # I'll try substrs of this to get the real one
726 my $longest = substr(
727 $self->isbn,
728 $self->_prefix_length + $self->_group_code_length,
729 $self->_max_publisher_code_length,
730 );
731
732 #print STDERR "Trying to parse publisher: longest [$longest]\n";
733 while( @$pairs )
734 {
735 my $lower = shift @$pairs;
736 my $upper = shift @$pairs;
737
738 my $trial = substr( $longest, 0, length $lower );
739 #print STDERR "Trying [$trial] with $lower <-> $upper [$$self{isbn}]\n";
740
741 # this has to be a sring comparison because there are
742 # possibly leading 0s
743 if( $trial ge $lower and $trial le $upper )
744 {
745 #print STDERR "Returning $trial\n";
746 return $trial;
747 }
748
749 }
750
751 return; #failed if I got this far
752 }
753
754sub _parse_article_code
755 {
756 my $self = shift;
757
758 my $head = $self->_prefix_length +
759 $self->_group_code_length +
760 $self->_publisher_code_length;
761 my $length = length( $self->isbn ) - $head - 1;
762
763 substr( $self->isbn, $head, $length );
764 }
765
766sub _parse_checksum
767 {
768 my $self = shift;
769
770 substr( $self->isbn, -1, 1 );
771 }
772
773sub _check_validity
774 {
775 my $self = shift;
776
777 if( $self->is_valid_checksum eq GOOD_ISBN and
778 defined $self->group_code and
779 defined $self->publisher_code and
780 defined $self->prefix
781 )
782 {
783 $self->_set_is_valid( GOOD_ISBN );
784 }
785 else
786 {
787 $self->_set_is_valid( INVALID_PUBLISHER_CODE )
788 unless defined $self->publisher_code;
789 $self->_set_is_valid( INVALID_GROUP_CODE )
790 unless defined $self->group_code;
791 $self->_set_is_valid( INVALID_PREFIX )
792 unless defined $self->prefix;
793 $self->_set_is_valid( GOOD_ISBN )
794 unless $self->is_valid_checksum ne GOOD_ISBN;
795 }
796 }
797
798sub _hyphen_positions
799 {
800 croak "hyphen_positions() must be implemented in Business::ISBN subclass"
801 }
802
803
80418µs1;
805
806__END__
 
# spent 84µs within Business::ISBN::CORE:sort which was called: # once (84µs+0s) by Business::ISBN::BEGIN@75 at line 272 of Business/ISBN/Data.pm
sub Business::ISBN::CORE:sort; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.