← 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/Field.pm
StatementsExecuted 2817879 statements in 8.91s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
79541213.12s3.68sMARC::Field::::newMARC::Field::new
79541112.10s4.61sMARC::Field::::as_usmarcMARC::Field::as_usmarc
119082111.31s1.84sMARC::Field::::indicatorMARC::Field::indicator
21862331977ms977msMARC::Field::::is_control_fieldMARC::Field::is_control_field
27816431548ms561msMARC::Field::::CORE:matchMARC::Field::CORE:match (opcode)
7954111375ms375msMARC::Field::::tagMARC::Field::tag
2000011223ms310msMARC::Field::::dataMARC::Field::data
1111.53ms1.61msMARC::Field::::BEGIN@5MARC::Field::BEGIN@5
1111.10ms1.67msMARC::Field::::BEGIN@7MARC::Field::BEGIN@7
11122µs28µsMARC::Field::::BEGIN@3MARC::Field::BEGIN@3
11116µs19µsMARC::Field::::BEGIN@4MARC::Field::BEGIN@4
11114µs50µsMARC::Field::::BEGIN@10MARC::Field::BEGIN@10
11114µs78µsMARC::Field::::BEGIN@8MARC::Field::BEGIN@8
0000s0sMARC::Field::::_gripeMARC::Field::_gripe
0000s0sMARC::Field::::_normalize_arrayrefMARC::Field::_normalize_arrayref
0000s0sMARC::Field::::_warnMARC::Field::_warn
0000s0sMARC::Field::::add_subfieldsMARC::Field::add_subfields
0000s0sMARC::Field::::as_formattedMARC::Field::as_formatted
0000s0sMARC::Field::::as_stringMARC::Field::as_string
0000s0sMARC::Field::::cloneMARC::Field::clone
0000s0sMARC::Field::::delete_subfieldMARC::Field::delete_subfield
0000s0sMARC::Field::::delete_subfieldsMARC::Field::delete_subfields
0000s0sMARC::Field::::replace_withMARC::Field::replace_with
0000s0sMARC::Field::::subfieldMARC::Field::subfield
0000s0sMARC::Field::::subfieldsMARC::Field::subfields
0000s0sMARC::Field::::updateMARC::Field::update
0000s0sMARC::Field::::warningsMARC::Field::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::Field;
2
3349µs234µs
# spent 28µs (22+6) within MARC::Field::BEGIN@3 which was called: # once (22µs+6µs) by MARC::Record::BEGIN@14 at line 3
use strict;
# spent 28µs making 1 call to MARC::Field::BEGIN@3 # spent 6µs making 1 call to strict::import
4337µs222µs
# spent 19µs (16+3) within MARC::Field::BEGIN@4 which was called: # once (16µs+3µs) by MARC::Record::BEGIN@14 at line 4
use integer;
# spent 19µs making 1 call to MARC::Field::BEGIN@4 # spent 3µs making 1 call to integer::import
53577µs21.70ms
# spent 1.61ms (1.53+86µs) within MARC::Field::BEGIN@5 which was called: # once (1.53ms+86µs) by MARC::Record::BEGIN@14 at line 5
use Carp;
# spent 1.61ms making 1 call to MARC::Field::BEGIN@5 # spent 86µs making 1 call to Exporter::import
6
73166µs21.83ms
# spent 1.67ms (1.10+570µs) within MARC::Field::BEGIN@7 which was called: # once (1.10ms+570µs) by MARC::Record::BEGIN@14 at line 7
use constant SUBFIELD_INDICATOR => "\x1F";
# spent 1.67ms making 1 call to MARC::Field::BEGIN@7 # spent 160µs making 1 call to constant::import
8352µs2142µs
# spent 78µs (14+64) within MARC::Field::BEGIN@8 which was called: # once (14µs+64µs) by MARC::Record::BEGIN@14 at line 8
use constant END_OF_FIELD => "\x1E";
# spent 78µs making 1 call to MARC::Field::BEGIN@8 # spent 64µs making 1 call to constant::import
9
1032.38ms286µs
# spent 50µs (14+36) within MARC::Field::BEGIN@10 which was called: # once (14µs+36µs) by MARC::Record::BEGIN@14 at line 10
use vars qw( $ERROR );
# spent 50µs making 1 call to MARC::Field::BEGIN@10 # spent 36µs making 1 call to vars::import
11
12=head1 NAME
13
- -
56
# spent 3.68s (3.12+561ms) within MARC::Field::new which was called 79541 times, avg 46µs/call: # 59541 times (2.68s+466ms) by MARC::File::XML::decode at line 463 of lib/MARC/File/XML.pm, avg 53µs/call # 20000 times (437ms+95.2ms) by MARC::File::XML::decode at line 449 of lib/MARC/File/XML.pm, avg 27µs/call
sub new {
576363282.15s my $class = shift;
58 $class = $class;
59
60 ## MARC spec indicates that tags can have alphabetical
61 ## characters in them! If they do appear we assume that
62 ## they have indicators like tags > 010
63 my $tagno = shift;
6479541191ms ($tagno =~ /^[0-9A-Za-z]{3}$/)
# spent 191ms making 79541 calls to MARC::Field::CORE:match, avg 2µs/call
65 or croak( "Tag \"$tagno\" is not a valid tag." );
663300µs79542153ms my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10));
# spent 150ms making 79541 calls to MARC::Field::CORE:match, avg 2µs/call # spent 2.43ms making 1 call to utf8::AUTOLOAD
67
68 my $self = bless {
69 _tag => $tagno,
70 _warnings => [],
71 _is_control_field => $is_control,
72 }, $class;
73
74178623388ms if ( $is_control ) {
75 $self->{_data} = shift;
76 } else {
77 for my $indcode ( qw( _ind1 _ind2 ) ) {
783572461.22s my $indicator = shift;
79119082219ms if ( $indicator !~ /^[0-9A-Za-z ]$/ ) {
# spent 219ms making 119082 calls to MARC::Field::CORE:match, avg 2µs/call
80 $self->_warn( "Invalid indicator \"$indicator\" forced to blank" ) unless ($indicator eq "");
81 $indicator = " ";
82 }
83 $self->{$indcode} = $indicator;
84 } # for
85
86 (@_ >= 2)
87 or croak( "Field $tagno must have at least one subfield" );
88
89 # Normally, we go thru add_subfields(), but internally we can cheat
90 $self->{_subfields} = [@_];
91 }
92
93 return $self;
94} # new()
95
96
97=head2 tag()
98
- -
103
# spent 375ms within MARC::Field::tag which was called 79541 times, avg 5µs/call: # 79541 times (375ms+0s) by MARC::File::USMARC::_build_tag_directory at line 278 of MARC/File/USMARC.pm, avg 5µs/call
sub tag {
104159082472ms my $self = shift;
105 return $self->{_tag};
106}
107
108=head2 indicator(indno)
109
- -
116
# spent 1.84s (1.31+532ms) within MARC::Field::indicator which was called 119082 times, avg 15µs/call: # 119082 times (1.31s+532ms) by MARC::Field::as_usmarc at line 522, avg 15µs/call
sub indicator($) {
1174763281.23s my $self = shift;
118 my $indno = shift;
119
120119082532ms $self->_warn( "Fields below 010 do not have indicators" )
# spent 532ms making 119082 calls to MARC::Field::is_control_field, avg 4µs/call
121 if $self->is_control_field;
122
123 if ( $indno == 1 ) {
124 return $self->{_ind1};
125 } elsif ( $indno == 2 ) {
126 return $self->{_ind2};
127 } else {
128 croak( "Indicator number must be 1 or 2" );
129 }
130}
131
132=head2 is_control_field()
133
- -
138
# spent 977ms within MARC::Field::is_control_field which was called 218623 times, avg 4µs/call: # 119082 times (532ms+0s) by MARC::Field::indicator at line 120, avg 4µs/call # 79541 times (358ms+0s) by MARC::Field::as_usmarc at line 512, avg 5µs/call # 20000 times (86.4ms+0s) by MARC::Field::data at line 220, avg 4µs/call
sub is_control_field {
1394372461.28s my $self = shift;
140 return $self->{_is_control_field};
141}
142
143=head2 subfield(code)
144
- -
163sub subfield {
164 my $self = shift;
165 my $code_wanted = shift;
166
167 croak( "Fields below 010 do not have subfields, use data()" )
168 if $self->is_control_field;
169
170 my @data = @{$self->{_subfields}};
171 my @found;
172 while ( defined( my $code = shift @data ) ) {
173 if ( $code eq $code_wanted ) {
174 push( @found, shift @data );
175 } else {
176 shift @data;
177 }
178 }
179 if ( wantarray() ) { return @found; }
180 return( $found[0] );
181}
182
183=head2 subfields()
184
- -
197sub subfields {
198 my $self = shift;
199
200 $self->_warn( "Fields below 010 do not have subfields" )
201 if $self->is_control_field;
202
203 my @list;
204 my @data = @{$self->{_subfields}};
205 while ( defined( my $code = shift @data ) ) {
206 push( @list, [$code, shift @data] );
207 }
208 return @list;
209}
210
211=head2 data()
212
- -
217
# spent 310ms (223+86.4) within MARC::Field::data which was called 20000 times, avg 15µs/call: # 20000 times (223ms+86.4ms) by MARC::Field::as_usmarc at line 512, avg 15µs/call
sub data {
21880000213ms my $self = shift;
219
2202000086.4ms croak( "data() is only for tags less than 010, use subfield()" )
# spent 86.4ms making 20000 calls to MARC::Field::is_control_field, avg 4µs/call
221 unless $self->is_control_field;
222
223 $self->{_data} = $_[0] if @_;
224
225 return $self->{_data};
226}
227
228=head2 add_subfields(code,text[,code,text ...])
229
- -
238sub add_subfields {
239 my $self = shift;
240
241 croak( "Subfields are only for tags >= 10" )
242 if $self->is_control_field;
243
244 push( @{$self->{_subfields}}, @_ );
245 return @_/2;
246}
247
248=head2 delete_subfield()
249
- -
274sub delete_subfield {
275 my ($self, %options) = @_;
276 my $codes = _normalize_arrayref($options{code});
277 my $positions = _normalize_arrayref($options{'pos'});
278 my $match = $options{match};
279
280 croak 'match must be a compiled regex'
281 if $match and ref($match) ne 'Regexp';
282
283 my @current_subfields = @{$self->{_subfields}};
284 my @new_subfields = ();
285 my $removed = 0;
286 my $subfield_num = $[ - 1; # users $[ preferences control indexing
287
288 while (@current_subfields > 0) {
289 $subfield_num += 1;
290 my $subfield_code = shift @current_subfields;
291 my $subfield_value = shift @current_subfields;
292 if ((@$codes==0 or grep {$_ eq $subfield_code} @$codes)
293 and (!$match or $subfield_value =~ $match)
294 and (@$positions==0 or grep {$_ == $subfield_num} @$positions)) {
295 $removed += 1;
296 next;
297 }
298 push( @new_subfields, $subfield_code, $subfield_value);
299 }
300 $self->{_subfields} = \@new_subfields;
301 return $removed;
302}
303
304=head2 delete_subfields()
305
- -
311sub delete_subfields {
312 my ($self, $code) = @_;
313 return $self->delete_subfield(code => $code);
314}
315
316=head2 update()
317
- -
347sub update {
348 my $self = shift;
349
350 ## tags 000 - 009 don't have indicators or subfields
351 if ( $self->is_control_field ) {
352 $self->{_data} = shift;
353 return(1);
354 }
355
356 ## otherwise we need to update subfields and indicators
357 my @data = @{$self->{_subfields}};
358 my $changes = 0;
359
360 while ( @_ ) {
361
362 my $arg = shift;
363 my $val = shift;
364
365 ## indicator update
366 if ($arg =~ /^ind[12]$/) {
367 $self->{"_$arg"} = $val;
368 $changes++;
369 }
370
371 ## subfield update
372 else {
373 my $found = 0;
374 ## update existing subfield
375 for ( my $i=0; $i<@data; $i+=2 ) {
376 if ($data[$i] eq $arg) {
377 $data[$i+1] = $val;
378 $found = 1;
379 $changes++;
380 last;
381 }
382 } # for
383
384 ## append new subfield
385 if ( !$found ) {
386 push( @data, $arg, $val );
387 $changes++;
388 }
389 }
390
391 } # while
392
393 ## synchronize our subfields
394 $self->{_subfields} = \@data;
395 return($changes);
396
397}
398
399=head2 replace_with()
400
- -
413sub replace_with {
414
415 my ($self,$new) = @_;
416 ref($new) =~ /^MARC::Field$/
417 or croak("Must pass a MARC::Field object");
418
419 %$self = %$new;
420
421}
422
423
424=head2 as_string( [$subfields] )
425
- -
449sub as_string() {
450 my $self = shift;
451 my $subfields = shift;
452
453 if ( $self->is_control_field ) {
454 return $self->{_data};
455 }
456
457 my @subs;
458
459 my $subs = $self->{_subfields};
460 my $nfields = @$subs / 2;
461 for my $i ( 1..$nfields ) {
462 my $offset = ($i-1)*2;
463 my $code = $subs->[$offset];
464 my $text = $subs->[$offset+1];
465 push( @subs, $text ) if !$subfields || $code =~ /^[$subfields]$/;
466 } # for
467
468 return join( " ", @subs );
469}
470
471
472=head2 as_formatted()
473
- -
478sub as_formatted() {
479 my $self = shift;
480
481 my @lines;
482
483 if ( $self->is_control_field ) {
484 push( @lines, sprintf( "%03s %s", $self->{_tag}, $self->{_data} ) );
485 } else {
486 my $hanger = sprintf( "%03s %1.1s%1.1s", $self->{_tag}, $self->{_ind1}, $self->{_ind2} );
487
488 my $subs = $self->{_subfields};
489 my $nfields = @$subs / 2;
490 my $offset = 0;
491 for my $i ( 1..$nfields ) {
492 push( @lines, sprintf( "%-6.6s _%1.1s%s", $hanger, $subs->[$offset++], $subs->[$offset++] ) );
493 $hanger = "";
494 } # for
495 }
496
497 return join( "\n", @lines );
498}
499
500
501=head2 as_usmarc()
502
- -
508
# spent 4.61s (2.10+2.51) within MARC::Field::as_usmarc which was called 79541 times, avg 58µs/call: # 79541 times (2.10s+2.51s) by MARC::File::USMARC::_build_tag_directory at line 272 of MARC/File/USMARC.pm, avg 58µs/call
sub as_usmarc() {
509159082548ms my $self = shift;
510
511 # Tags < 010 are pretty easy
5122381641.09s99541668ms if ( $self->is_control_field ) {
# spent 358ms making 79541 calls to MARC::Field::is_control_field, avg 5µs/call # spent 310ms making 20000 calls to MARC::Field::data, avg 15µs/call
513 return $self->data . END_OF_FIELD;
514 } else {
515 my @subs;
516 my @subdata = @{$self->{_subfields}};
517 while ( @subdata ) {
51895758330ms push( @subs, join( "", SUBFIELD_INDICATOR, shift @subdata, shift @subdata ) );
519 } # while
520
521 return
5221190821.84s join( "",
# spent 1.84s making 119082 calls to MARC::Field::indicator, avg 15µs/call
523 $self->indicator(1),
524 $self->indicator(2),
525 @subs,
526 END_OF_FIELD, );
527 }
528}
529
530=head2 clone()
531
- -
544sub clone {
545 my $self = shift;
546
547 my $tagno = $self->{_tag};
548 my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10));
549
550 my $clone =
551 bless {
552 _tag => $tagno,
553 _warnings => [],
554 _is_control_field => $is_control,
555 }, ref($self);
556
557 if ( $is_control ) {
558 $clone->{_data} = $self->{_data};
559 } else {
560 $clone->{_ind1} = $self->{_ind1};
561 $clone->{_ind2} = $self->{_ind2};
562 $clone->{_subfields} = [@{$self->{_subfields}}];
563 }
564
565 return $clone;
566}
567
568=head2 warnings()
569
- -
579sub warnings() {
580 my $self = shift;
581
582 return @{$self->{_warnings}};
583}
584
585# NOTE: _warn is an object method
586sub _warn($) {
587 my $self = shift;
588
589 push( @{$self->{_warnings}}, join( "", @_ ) );
590}
591
592sub _gripe(@) {
593 $ERROR = join( "", @_ );
594
595 warn $ERROR;
596
597 return;
598}
599
600sub _normalize_arrayref {
601 my $ref = shift;
602 if (ref($ref) eq 'ARRAY') { return $ref }
603 elsif (defined $ref) { return [$ref] }
604 return [];
605}
606
607
60814µs1;
609
610__END__
 
# spent 561ms (548+13.1) within MARC::Field::CORE:match which was called 278164 times, avg 2µs/call: # 119082 times (219ms+0s) by MARC::Field::new at line 79, avg 2µs/call # 79541 times (191ms+0s) by MARC::Field::new at line 64, avg 2µs/call # 79541 times (137ms+13.1ms) by MARC::Field::new at line 66, avg 2µs/call
sub MARC::Field::CORE:match; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.