← Index
NYTProf Performance Profile   « block view • line view • sub view »
For conv.pl
  Run on Sun Nov 14 22:50:31 2010
Reported on Sun Nov 14 22:51:21 2010

Filename/usr/share/perl5/MARC/Record.pm
StatementsExecuted 234578 statements in 643ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
500011209ms209msMARC::Record::::_all_parms_are_fieldsMARC::Record::_all_parms_are_fields
100002298.9ms98.9msMARC::Record::::leaderMARC::Record::leader
50001198.4ms98.4msMARC::Record::::set_leader_lengthsMARC::Record::set_leader_lengths
50001173.6ms283msMARC::Record::::append_fieldsMARC::Record::append_fields
50001154.6ms7.85sMARC::Record::::as_usmarcMARC::Record::as_usmarc
50001152.7ms52.7msMARC::Record::::newMARC::Record::new
50001129.6ms29.6msMARC::Record::::fieldsMARC::Record::fields
1112.68ms6.14msMARC::Record::::BEGIN@14MARC::Record::BEGIN@14
11122µs67µsMARC::Record::::BEGIN@26MARC::Record::BEGIN@26
11122µs28µsMARC::Record::::BEGIN@9MARC::Record::BEGIN@9
11118µs60µsMARC::Record::::BEGIN@12MARC::Record::BEGIN@12
11117µs114µsMARC::Record::::BEGIN@27MARC::Record::BEGIN@27
11115µs20µsMARC::Record::::BEGIN@10MARC::Record::BEGIN@10
11115µs52µsMARC::Record::::BEGIN@32MARC::Record::BEGIN@32
11114µs119µsMARC::Record::::BEGIN@15MARC::Record::BEGIN@15
11114µs50µsMARC::Record::::BEGIN@23MARC::Record::BEGIN@23
11113µs79µsMARC::Record::::BEGIN@34MARC::Record::BEGIN@34
0000s0sMARC::Record::::_gripeMARC::Record::_gripe
0000s0sMARC::Record::::_warnMARC::Record::_warn
0000s0sMARC::Record::::add_fieldsMARC::Record::add_fields
0000s0sMARC::Record::::as_formattedMARC::Record::as_formatted
0000s0sMARC::Record::::authorMARC::Record::author
0000s0sMARC::Record::::cloneMARC::Record::clone
0000s0sMARC::Record::::delete_fieldMARC::Record::delete_field
0000s0sMARC::Record::::editionMARC::Record::edition
0000s0sMARC::Record::::encodingMARC::Record::encoding
0000s0sMARC::Record::::fieldMARC::Record::field
0000s0sMARC::Record::::insert_fields_afterMARC::Record::insert_fields_after
0000s0sMARC::Record::::insert_fields_beforeMARC::Record::insert_fields_before
0000s0sMARC::Record::::insert_fields_orderedMARC::Record::insert_fields_ordered
0000s0sMARC::Record::::insert_grouped_fieldMARC::Record::insert_grouped_field
0000s0sMARC::Record::::new_from_usmarcMARC::Record::new_from_usmarc
0000s0sMARC::Record::::publication_dateMARC::Record::publication_date
0000s0sMARC::Record::::subfieldMARC::Record::subfield
0000s0sMARC::Record::::titleMARC::Record::title
0000s0sMARC::Record::::title_properMARC::Record::title_proper
0000s0sMARC::Record::::warningsMARC::Record::warnings
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package MARC::Record;
2
3=head1 NAME
4
- -
9342µs234µs
# spent 28µs (22+6) within MARC::Record::BEGIN@9 which was called: # once (22µs+6µs) by MARC::File::XML::BEGIN@7 at line 9
use strict;
# spent 28µs making 1 call to MARC::Record::BEGIN@9 # spent 6µs making 1 call to strict::import
10346µs225µs
# spent 20µs (15+5) within MARC::Record::BEGIN@10 which was called: # once (15µs+5µs) by MARC::File::XML::BEGIN@7 at line 10
use integer;
# spent 20µs making 1 call to MARC::Record::BEGIN@10 # spent 5µs making 1 call to integer::import
11
12341µs2102µs
# spent 60µs (18+42) within MARC::Record::BEGIN@12 which was called: # once (18µs+42µs) by MARC::File::XML::BEGIN@7 at line 12
use vars qw( $ERROR );
# spent 60µs making 1 call to MARC::Record::BEGIN@12 # spent 42µs making 1 call to vars::import
13
143173µs16.14ms
# spent 6.14ms (2.68+3.46) within MARC::Record::BEGIN@14 which was called: # once (2.68ms+3.46ms) by MARC::File::XML::BEGIN@7 at line 14
use MARC::Field;
# spent 6.14ms making 1 call to MARC::Record::BEGIN@14
15346µs2224µs
# spent 119µs (14+105) within MARC::Record::BEGIN@15 which was called: # once (14µs+105µs) by MARC::File::XML::BEGIN@7 at line 15
use Carp qw(croak);
# spent 119µs making 1 call to MARC::Record::BEGIN@15 # spent 105µs making 1 call to Exporter::import
16
17=head1 VERSION
18
- -
23354µs286µs
# spent 50µs (14+36) within MARC::Record::BEGIN@23 which was called: # once (14µs+36µs) by MARC::File::XML::BEGIN@7 at line 23
use vars qw( $VERSION );
# spent 50µs making 1 call to MARC::Record::BEGIN@23 # spent 36µs making 1 call to vars::import
2412µs$VERSION = '2.0.0';
25
26344µs2112µs
# spent 67µs (22+45) within MARC::Record::BEGIN@26 which was called: # once (22µs+45µs) by MARC::File::XML::BEGIN@7 at line 26
use Exporter;
# spent 67µs making 1 call to MARC::Record::BEGIN@26 # spent 45µs making 1 call to Exporter::import
27371µs2211µs
# spent 114µs (17+97) within MARC::Record::BEGIN@27 which was called: # once (17µs+97µs) by MARC::File::XML::BEGIN@7 at line 27
use vars qw( @ISA @EXPORTS @EXPORT_OK );
# spent 114µs making 1 call to MARC::Record::BEGIN@27 # spent 97µs making 1 call to vars::import
28110µs@ISA = qw( Exporter );
2911µs@EXPORTS = qw();
3012µs@EXPORT_OK = qw( LEADER_LEN );
31
32448µs289µs
# spent 52µs (15+37) within MARC::Record::BEGIN@32 which was called: # once (15µs+37µs) by MARC::File::XML::BEGIN@7 at line 32
use vars qw( $DEBUG ); $DEBUG = 0;
# spent 52µs making 1 call to MARC::Record::BEGIN@32 # spent 37µs making 1 call to vars::import
33
3432.45ms2145µs
# spent 79µs (13+66) within MARC::Record::BEGIN@34 which was called: # once (13µs+66µs) by MARC::File::XML::BEGIN@7 at line 34
use constant LEADER_LEN => 24;
# spent 79µs making 1 call to MARC::Record::BEGIN@34 # spent 66µs making 1 call to constant::import
35
36=head1 DESCRIPTION
37
- -
56
# spent 52.7ms within MARC::Record::new which was called 5000 times, avg 11µs/call: # 5000 times (52.7ms+0s) by MARC::File::XML::decode at line 444 of lib/MARC/File/XML.pm, avg 11µs/call
sub new {
571500058.4ms my $class = shift;
58 my $self = {
59 _leader => ' ' x 24,
60 _fields => [],
61 _warnings => [],
62 };
63 return bless $self, $class;
64} # new()
65
66=head2 new_from_usmarc( $marcblob [, \&filter_func($tagno,$tagdata)] )
67
- -
75sub new_from_usmarc {
76 my $blob = shift;
77 $blob = shift if (ref($blob) || ($blob eq "MARC::Record"));
78
79 require MARC::File::USMARC;
80
81 return MARC::File::USMARC::decode( $blob, @_ );
82}
83
84=head1 COMMON FIELD RETRIEVAL METHODS
85
- -
104sub title() {
105 my $self = shift;
106
107 my $field = $self->field(245);
108 return $field ? $field->as_string : "";
109}
110
111=head2 title_proper()
112
- -
117sub title_proper() {
118 my $self = shift;
119
120 my $field = $self->field(245);
121
122 if ( $field ) {
123 return $field->as_string('anp');
124 } else {
125 return "";
126 }
127}
128
129=head2 author()
130
- -
135sub author() {
136 my $self = shift;
137
138 my $field = $self->field('100|110|111');
139 return $field ? $field->as_string : "";
140}
141
142=head2 edition()
143
- -
148sub edition() {
149 my $self = shift;
150
151 my $str = $self->subfield(250,'a');
152 return defined $str ? $str : "";
153}
154
155=head2 publication_date()
156
- -
161sub publication_date() {
162 my $self = shift;
163
164 my $str = $self->subfield(260,'c');
165 return defined $str ? $str : "";
166}
167
168=head1 FIELD & SUBFIELD ACCESS METHODS
169
- -
177
# spent 29.6ms within MARC::Record::fields which was called 5000 times, avg 6µs/call: # 5000 times (29.6ms+0s) by MARC::File::USMARC::_build_tag_directory at line 270 of MARC/File/USMARC.pm, avg 6µs/call
sub fields() {
1781000035.8ms my $self = shift;
179 return @{$self->{_fields}};
180}
181
182=head2 field( I<tagspec(s)> )
183
- -
19311µsmy %field_regex;
194
195sub field {
196 my $self = shift;
197 my @specs = @_;
198
199 my @list = ();
200 for my $tag ( @specs ) {
201 my $regex = $field_regex{ $tag };
202
203 # Compile & stash it if necessary
204 if ( not defined $regex ) {
205 $regex = qr/^$tag$/;
206 $field_regex{ $tag } = $regex;
207 } # not defined
208
209 for my $maybe ( $self->fields ) {
210 if ( $maybe->tag =~ $regex ) {
211 return $maybe unless wantarray;
212
213 push( @list, $maybe );
214 } # if
215 } # for $maybe
216 } # for $tag
217
218 return unless wantarray;
219 return @list;
220}
221
222=head2 subfield( $tag, $subfield )
223
- -
233sub subfield {
234 my $self = shift;
235 my $tag = shift;
236 my $subfield = shift;
237
238 my $field = $self->field($tag) or return;
239 return $field->subfield($subfield);
240} # subfield()
241
242=for internal
243
- -
246
# spent 209ms within MARC::Record::_all_parms_are_fields which was called 5000 times, avg 42µs/call: # 5000 times (209ms+0s) by MARC::Record::append_fields at line 268, avg 42µs/call
sub _all_parms_are_fields {
2471000037.1ms for ( @_ ) {
24879541179ms return 0 unless ref($_) eq 'MARC::Field';
249 }
250 return 1;
251}
252
253=head2 append_fields( @fields )
254
- -
265
# spent 283ms (73.6+209) within MARC::Record::append_fields which was called 5000 times, avg 57µs/call: # 5000 times (73.6ms+209ms) by MARC::File::XML::decode at line 471 of lib/MARC/File/XML.pm, avg 57µs/call
sub append_fields {
2662000069.3ms my $self = shift;
267
2685000209ms _all_parms_are_fields(@_) or croak('Arguments must be MARC::Field objects');
# spent 209ms making 5000 calls to MARC::Record::_all_parms_are_fields, avg 42µs/call
269
270 push(@{ $self->{_fields} }, @_);
271 return scalar @_;
272}
273
274=head2 insert_fields_before( $before_field, @new_fields )
275
- -
287sub insert_fields_before {
288 my $self = shift;
289
290 _all_parms_are_fields(@_)
291 or croak('All arguments must be MARC::Field objects');
292
293 my ($before,@new) = @_;
294
295 ## find position of $before
296 my $fields = $self->{_fields};
297 my $pos = 0;
298 foreach my $f (@$fields) {
299 last if ($f == $before);
300 $pos++;
301 }
302
303 ## insert before $before
304 if ($pos >= @$fields) {
305 $self->_warn("Couldn't find field to insert before");
306 return;
307 }
308 splice(@$fields,$pos,0,@new);
309 return scalar @new;
310
311}
312
313=head2 insert_fields_after( $after_field, @new_fields )
314
- -
321sub insert_fields_after {
322 my $self = shift;
323
324 _all_parms_are_fields(@_) or croak('All arguments must be MARC::Field objects');
325 my ($after,@new) = @_;
326
327 ## find position of $after
328 my $fields = $self->{_fields};
329 my $pos = 0;
330 foreach my $f (@$fields) {
331 last if ($f == $after);
332 $pos++;
333 }
334
335 ## insert after $after
336 if ($pos+1 >= @$fields) {
337 $self->_warn("Couldn't find field to insert after");
338 return;
339 }
340 splice(@$fields,$pos+1,0,@new);
341 return scalar @new;
342}
343
344=head2 insert_fields_ordered( @new_fields )
345
- -
351sub insert_fields_ordered {
352 my ( $self, @new ) = @_;
353
354 _all_parms_are_fields(@new)
355 or croak('All arguments must be MARC::Field objects');
356
357 ## go through each new field
358 NEW_FIELD: foreach my $newField ( @new ) {
359
360 ## find location before which it should be inserted
361 EXISTING_FIELD: foreach my $field ( @{ $self->{_fields} } ) {
362 if ( $field->tag() >= $newField->tag() ) {
363 $self->insert_fields_before( $field, $newField );
364 next NEW_FIELD;
365 }
366 }
367
368 ## if we fell through then this new field is higher than
369 ## all the existing fields, so we append.
370 $self->append_fields( $newField );
371
372 }
373 return( scalar( @new ) );
374}
375
376=head2 insert_grouped_field( $field )
377
- -
394sub insert_grouped_field {
395 my ($self,$new) = @_;
396 _all_parms_are_fields($new) or croak('Argument must be MARC::Field object');
397
398 ## try to find the end of the field group and insert it there
399 my $limit = int($new->tag() / 100);
400 my $found = 0;
401 foreach my $field ($self->fields()) {
402 if ( int($field->tag() / 100) > $limit ) {
403 $self->insert_fields_before($field,$new);
404 $found = 1;
405 last;
406 }
407 }
408
409 ## if we couldn't find the end of the group, then we must not have
410 ## any tags this high yet, so just append it
411 if (!$found) {
412 $self->append_fields($new);
413 }
414
415 return(1);
416
417}
418
419
420=head2 delete_field( $field )
421
- -
437sub delete_field {
438 my $self = shift;
439 my $deleter = shift;
440 my $list = $self->{_fields};
441
442 my $old_count = @$list;
443 @$list = grep { $_ != $deleter } @$list;
444 return $old_count - @$list;
445}
446
447=head2 as_usmarc()
448
- -
454
# spent 7.85s (54.6ms+7.80) within MARC::Record::as_usmarc which was called 5000 times, avg 1.57ms/call: # 5000 times (54.6ms+7.80s) by main::RUNTIME at line 12 of conv.pl, avg 1.57ms/call
sub as_usmarc() {
4551500047.5ms my $self = shift;
456
457 require MARC::File::USMARC;
458
45950007.80s return MARC::File::USMARC::encode( $self );
# spent 7.80s making 5000 calls to MARC::File::USMARC::encode, avg 1.56ms/call
460}
461
462=head2 as_formatted()
463
- -
468sub as_formatted() {
469 my $self = shift;
470
471 my @lines = ( "LDR " . ($self->{_leader} || "") );
472 for my $field ( @{$self->{_fields}} ) {
473 push( @lines, $field->as_formatted() );
474 }
475
476 return join( "\n", @lines );
477} # as_formatted
478
479
480=head2 leader()
481
- -
487
# spent 98.9ms within MARC::Record::leader which was called 10000 times, avg 10µs/call: # 5000 times (60.9ms+0s) by MARC::File::XML::decode at line 454 of lib/MARC/File/XML.pm, avg 12µs/call # 5000 times (38.1ms+0s) by MARC::File::USMARC::encode at line 315 of MARC/File/USMARC.pm, avg 8µs/call
sub leader {
4884000089.2ms my $self = shift;
489 my $text = shift;
490
4911000019.0ms if ( defined $text ) {
492 (length($text) eq 24)
493 or $self->_warn( "Leader must be 24 bytes long" );
494 $self->{_leader} = $text;
495 } # set the leader
496
497 return $self->{_leader};
498} # leader()
499
500=head2 encoding()
501
- -
521sub encoding {
522 my ($self,$arg) = @_;
523 # we basically report from and modify the leader directly
524 my $leader = $self->leader();
525
526 # when setting
527 if ( defined($arg) ) {
528 if ( $arg =~ /UTF-8/i ) {
529 substr($leader,9,1) = 'a';
530 }
531 elsif ( $arg =~ /MARC-8/i ) {
532 substr($leader,9,1) = ' ';
533 }
534 $self->leader($leader);
535 }
536
537 return substr($leader,9,1) eq 'a' ? 'UTF-8' : 'MARC-8';
538}
539
540=head2 set_leader_lengths( $reclen, $baseaddr )
541
- -
546
# spent 98.4ms within MARC::Record::set_leader_lengths which was called 5000 times, avg 20µs/call: # 5000 times (98.4ms+0s) by MARC::File::USMARC::encode at line 312 of MARC/File/USMARC.pm, avg 20µs/call
sub set_leader_lengths {
54735000105ms my $self = shift;
548 my $reclen = shift;
549 my $baseaddr = shift;
550 substr($self->{_leader},0,5) = sprintf("%05d",$reclen);
551 substr($self->{_leader},12,5) = sprintf("%05d",$baseaddr);
552 # MARC21 defaults: http://www.loc.gov/marc/bibliographic/ecbdldrd.html
553 substr($self->{_leader},10,2) = '22';
554 substr($self->{_leader},20,4) = '4500';
555}
556
557=head2 clone()
558
- -
579sub clone {
580 my $self = shift;
581 my @keeper_tags = @_;
582
583 # create a new object of whatever type we happen to be
584 my $class = ref( $self );
585 my $clone = $class->new();
586
587 $clone->{_leader} = $self->{_leader};
588
589 my $filtered = @keeper_tags ? [$self->field( @keeper_tags )] : undef;
590
591 for my $field ( $self->fields() ) {
592 if ( !$filtered || (grep {$field eq $_} @$filtered ) ) {
593 $clone->append_fields( $field->clone );
594 }
595 }
596
597 # XXX FIX THIS $clone->update_leader();
598
599 return $clone;
600}
601
602=head2 warnings()
603
- -
618sub warnings() {
619 my $self = shift;
620 my @warnings = @{$self->{_warnings}};
621 $self->{_warnings} = [];
622 return @warnings;
623}
624
625=head2 add_fields()
626
- -
665sub add_fields {
666 my $self = shift;
667
668 my $nfields = 0;
669 my $fields = $self->{_fields};
670
671 while ( my $parm = shift ) {
672 # User handed us a list of data (most common possibility)
673 if ( ref($parm) eq "" ) {
674 my $field = MARC::Field->new( $parm, @_ )
675 or return _gripe( $MARC::Field::ERROR );
676 push( @$fields, $field );
677 ++$nfields;
678 last; # Bail out, we're done eating parms
679
680 # User handed us an object.
681 } elsif ( ref($parm) eq "MARC::Field" ) {
682 push( @$fields, $parm );
683 ++$nfields;
684
685 # User handed us an anonymous list of parms
686 } elsif ( ref($parm) eq "ARRAY" ) {
687 my $field = MARC::Field->new(@$parm)
688 or return _gripe( $MARC::Field::ERROR );
689 push( @$fields, $field );
690 ++$nfields;
691
692 } else {
693 croak( "Unknown parm of type", ref($parm), " passed to add_fields()" );
694 } # if
695
696 } # while
697
698 return $nfields;
699}
700
701# NOTE: _warn is an object method
702sub _warn {
703 my $self = shift;
704 push( @{$self->{_warnings}}, join( "", @_ ) );
705 return( $self );
706}
707
708
709# NOTE: _gripe is NOT an object method
710sub _gripe {
711 $ERROR = join( "", @_ );
712
713 warn $ERROR;
714
715 return;
716}
717
718
71918µs1;
720
721__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.