← 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:48 2015

Filename/usr/share/perl5/MARC/Field.pm
StatementsExecuted 18 statements in 3.02ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.06ms1.22msMARC::Field::::BEGIN@456MARC::Field::BEGIN@456
11110µs20µsMARC::Field::::BEGIN@3MARC::Field::BEGIN@3
1118µs42µsMARC::Field::::BEGIN@8MARC::Field::BEGIN@8
1117µs40µsMARC::Field::::BEGIN@6MARC::Field::BEGIN@6
1116µs23µsMARC::Field::::BEGIN@11MARC::Field::BEGIN@11
1116µs10µsMARC::Field::::BEGIN@4MARC::Field::BEGIN@4
1116µs7µsMARC::Field::::BEGIN@5MARC::Field::BEGIN@5
1115µs26µsMARC::Field::::BEGIN@9MARC::Field::BEGIN@9
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::::allow_controlfield_tagsMARC::Field::allow_controlfield_tags
0000s0sMARC::Field::::as_formattedMARC::Field::as_formatted
0000s0sMARC::Field::::as_stringMARC::Field::as_string
0000s0sMARC::Field::::as_usmarcMARC::Field::as_usmarc
0000s0sMARC::Field::::cloneMARC::Field::clone
0000s0sMARC::Field::::dataMARC::Field::data
0000s0sMARC::Field::::delete_subfieldMARC::Field::delete_subfield
0000s0sMARC::Field::::delete_subfieldsMARC::Field::delete_subfields
0000s0sMARC::Field::::disallow_controlfield_tagsMARC::Field::disallow_controlfield_tags
0000s0sMARC::Field::::indicatorMARC::Field::indicator
0000s0sMARC::Field::::is_control_fieldMARC::Field::is_control_field
0000s0sMARC::Field::::is_controlfield_tagMARC::Field::is_controlfield_tag
0000s0sMARC::Field::::is_valid_indicatorMARC::Field::is_valid_indicator
0000s0sMARC::Field::::is_valid_tagMARC::Field::is_valid_tag
0000s0sMARC::Field::::newMARC::Field::new
0000s0sMARC::Field::::replace_withMARC::Field::replace_with
0000s0sMARC::Field::::set_indicatorMARC::Field::set_indicator
0000s0sMARC::Field::::set_tagMARC::Field::set_tag
0000s0sMARC::Field::::subfieldMARC::Field::subfield
0000s0sMARC::Field::::subfieldsMARC::Field::subfields
0000s0sMARC::Field::::tagMARC::Field::tag
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
3221µs230µs
# spent 20µs (10+10) within MARC::Field::BEGIN@3 which was called: # once (10µs+10µs) by MARC::Record::BEGIN@15 at line 3
use strict;
# spent 20µs making 1 call to MARC::Field::BEGIN@3 # spent 10µs making 1 call to strict::import
4218µs214µs
# spent 10µs (6+4) within MARC::Field::BEGIN@4 which was called: # once (6µs+4µs) by MARC::Record::BEGIN@15 at line 4
use warnings;
# spent 10µs making 1 call to MARC::Field::BEGIN@4 # spent 4µs making 1 call to warnings::import
5222µs29µs
# spent 7µs (6+1) within MARC::Field::BEGIN@5 which was called: # once (6µs+1µs) by MARC::Record::BEGIN@15 at line 5
use integer;
# spent 7µs making 1 call to MARC::Field::BEGIN@5 # spent 1µs making 1 call to integer::import
6231µs274µs
# spent 40µs (7+33) within MARC::Field::BEGIN@6 which was called: # once (7µs+33µs) by MARC::Record::BEGIN@15 at line 6
use Carp;
# spent 40µs making 1 call to MARC::Field::BEGIN@6 # spent 33µs making 1 call to Exporter::import
7
8227µs276µs
# spent 42µs (8+34) within MARC::Field::BEGIN@8 which was called: # once (8µs+34µs) by MARC::Record::BEGIN@15 at line 8
use constant SUBFIELD_INDICATOR => "\x1F";
# spent 42µs making 1 call to MARC::Field::BEGIN@8 # spent 34µs making 1 call to constant::import
9222µs246µs
# spent 26µs (5+20) within MARC::Field::BEGIN@9 which was called: # once (5µs+20µs) by MARC::Record::BEGIN@15 at line 9
use constant END_OF_FIELD => "\x1E";
# spent 26µs making 1 call to MARC::Field::BEGIN@9 # spent 20µs making 1 call to constant::import
10
112995µs240µs
# spent 23µs (6+17) within MARC::Field::BEGIN@11 which was called: # once (6µs+17µs) by MARC::Record::BEGIN@15 at line 11
use vars qw( $ERROR );
# spent 23µs making 1 call to MARC::Field::BEGIN@11 # spent 17µs making 1 call to vars::import
12
13=head1 NAME
14
15MARC::Field - Perl extension for handling MARC fields
16
17=head1 SYNOPSIS
18
19 use MARC::Field;
20
21 # If your system uses wacky control field tags, add them
22 MARC::Field->allow_controlfield_tags('FMT', 'LLE');
23
24 my $field = MARC::Field->new( 245, '1', '0',
25 'a' => 'Raccoons and ripe corn / ',
26 'c' => 'Jim Arnosky.'
27 );
28 $field->add_subfields( "a", "1st ed." );
29
30=head1 DESCRIPTION
31
32Defines MARC fields for use in the MARC::Record module. I suppose
33you could use them on their own, but that wouldn't be very interesting.
34
35=head1 EXPORT
36
37None by default. Any errors are stored in C<$MARC::Field::ERROR>, which
38C<$MARC::Record> usually bubbles up to C<$MARC::Record::ERROR>.
39
40=head1 CLASS VARIABLES
41
42B<extra_controlfield_tags>: Some systems (notably Ex Libris's Aleph) throw
43extra control fields in their MARC (e.g., Aleph's MARC-XML tends to have a
44C<FMT> control field). We keep a class-level hash to track to track them; it can
45be manipulated with C<allow_controlfield_tags> and c<disallow_controlfield_tags>.
46
47=cut
48
491700nsmy %extra_controlfield_tags = ();
50
51
52=head1 METHODS
53
54=head2 new()
55
56The constructor, which will return a MARC::Field object. Typically you will
57pass in the tag number, indicator 1, indicator 2, and then a list of any
58subfield/data pairs. For example:
59
60 my $field = MARC::Field->new(
61 245, '1', '0',
62 'a' => 'Raccoons and ripe corn / ',
63 'c' => 'Jim Arnosky.'
64 );
65
66Or if you want to add a control field (< 010) that does not have indicators.
67
68 my $field = MARC::Field->new( '001', ' 14919759' );
69
70=cut
71
72sub new {
73 my $class = shift;
74 $class = $class;
75
76 ## MARC spec indicates that tags can have alphabetical
77 ## characters in them! If they do appear we assume that
78 ## they have indicators like tags > 010 unless they've
79 ## been previously defined as control tags using
80 ## add_controlfield
81
82 my $tagno = shift;
83 $class->is_valid_tag($tagno)
84 or croak( "Tag \"$tagno\" is not a valid tag." );
85 my $is_control = $class->is_controlfield_tag($tagno);
86
87 my $self = bless {
88 _tag => $tagno,
89 _warnings => [],
90 _is_control_field => $is_control,
91 }, $class;
92
93 if ( $is_control ) {
94 $self->{_data} = shift;
95 $self->_warn("Too much data for control field '$tagno'") if (@_);
96 } else {
97 for my $indcode ( qw( _ind1 _ind2 ) ) {
98 my $indicator = shift;
99 defined($indicator) or croak("Field $tagno must have indicators (use ' ' for empty indicators)");
100 unless ($self->is_valid_indicator($indicator)) {
101 $self->_warn( "Invalid indicator \"$indicator\" forced to blank" ) unless ($indicator eq "");
102 $indicator = " ";
103 }
104 $self->{$indcode} = $indicator;
105 } # for
106
107 (@_ >= 2)
108 or croak( "Field $tagno must have at least one subfield" );
109
110 # Normally, we go thru add_subfields(), but internally we can cheat
111 $self->{_subfields} = [@_];
112 }
113
114 return $self;
115} # new()
116
117
118=head2 tag()
119
120Returns the three digit tag for the field.
121
122=cut
123
124sub tag {
125 my $self = shift;
126 return $self->{_tag};
127}
128
129=head2 set_tag(tag)
130
131Changes the tag number of this field. Updates the control status accordingly.
132Will C<croak> if an invalid value is passed in.
133
134=cut
135
136sub set_tag {
137 my ( $self, $tagno ) = @_;
138
139 $self->is_valid_tag($tagno)
140 or croak("Tag \"$tagno\" is not a valid tag.");
141 $self->{_tag} = $tagno;
142 $self->{_is_control_field} = $self->is_controlfield_tag($tagno);
143}
144
145=head2 indicator(indno)
146
147Returns the specified indicator. Returns C<undef> and logs
148a warning if field is a control field and thus doesn't have
149indicators. If the field is not a control field, croaks
150if the I<indno> is not 1 or 2.
151
152=cut
153
154sub indicator {
155 my $self = shift;
156 my $indno = shift;
157
158 if ($self->is_control_field) {
159 $self->_warn( "Control fields (generally, those with tags below 010) do not have indicators" );
160 return;
161 }
162
163 if ( $indno == 1 ) {
164 return $self->{_ind1};
165 } elsif ( $indno == 2 ) {
166 return $self->{_ind2};
167 } else {
168 croak( "Indicator number must be 1 or 2" );
169 }
170}
171
172=head2 set_indicator($indno, $indval)
173
174Set the indicator position I<$indno> to the value
175specified by I<$indval>. Croaks if the indicator position,
176is invalid, the field is a control field and thus
177doesn't have indicators, or if the new indicator value
178is invalid.
179
180=cut
181
182sub set_indicator {
183 my $self = shift;
184 my $indno = shift;
185 my $indval = shift;
186
187 croak('Indicator number must be 1 or 2')
188 unless defined $indno && $indno =~ /^[12]$/;
189 croak('Cannot set indicator for control field')
190 if $self->is_control_field;
191 croak('Indicator value is invalid') unless $self->is_valid_indicator($indval);
192
193 $self->{"_ind$indno"} = $indval;
194}
195
196=head2 allow_controlfield_tags($tag, $tag2, ...)
197
198Add $tags to class-level list of strings to consider valid control fields tags (in addition to 001 through 009).
199Tags must have three characters.
200
201=cut
202
203sub allow_controlfield_tags {
204 my $self = shift;
205 foreach my $tag (@_) {
206 $extra_controlfield_tags{$tag} = 1;
207 }
208}
209
210=head2 disallow_controlfield_tags($tag, $tag2, ...)
211=head2 disallow_controlfield_tags('*')
212
213Revoke the validity of a control field tag previously added with allow_controlfield_tags. As a special case,
214if you pass the string '*' it will clear out all previously-added tags.
215
216NOTE that this will only deal with stuff added with allow_controlfield_tags; you can't disallow '001'.
217
218=cut
219
220sub disallow_controlfield_tags {
221 my $self = shift;
222 if ($_[0] eq '*') {
223 %extra_controlfield_tags = ();
224 return;
225 }
226 foreach my $tag (@_) {
227 delete $extra_controlfield_tags{$tag};
228 }
229}
230
231=head2 is_valid_tag($tag) -- is the given tag valid?
232
233Generally called as a class method (e.g., MARC::Field->is_valid_tag('001'))
234
235=cut
236
237sub is_valid_tag {
238 my $self = shift;
239 my $tag = shift;
240 return 1 if defined $tag && $tag =~ /^[0-9A-Za-z]{3}$/;
241 return 0;
242}
243
244=head2 is_valid_indicator($indval) -- is the given indicator value valid?
245
246Generally called as a class method (e.g., MARC::Field->is_valid_indicator('4'))
247
248=cut
249
250sub is_valid_indicator {
251 my $self = shift;
252 my $indval = shift;
253 return 1 if defined $indval && $indval =~ /^[0-9A-Za-z ]$/;
254 return 0;
255}
256
257=head2 is_controlfield_tag($tag) -- does the given tag denote a control field?
258
259Generally called as a class method (e.g., MARC::Field->is_controlfield_tag('001'))
260
261=cut
262
263sub is_controlfield_tag
264{
265 my $self = shift;
266 my $tag = shift;
267 return 1 if ($extra_controlfield_tags{$tag});
268 return 1 if (($tag =~ /^\d+$/) && ($tag < 10));
269 return 0; # otherwise, it's not a control field
270}
271
272
273=head2 is_control_field()
274
275Tells whether this field is one of the control tags from 001-009.
276
277=cut
278
279sub is_control_field {
280 my $self = shift;
281 return $self->{_is_control_field};
282}
283
284=head2 subfield(code)
285
286When called in a scalar context returns the text from the first subfield
287matching the subfield code.
288
289 my $subfield = $field->subfield( 'a' );
290
291Or if you think there might be more than one you can get all of them by
292calling in a list context:
293
294 my @subfields = $field->subfield( 'a' );
295
296If no matching subfields are found, C<undef> is returned in a scalar context
297and an empty list in a list context.
298
299If the tag is a control field, C<undef> is returned and
300C<$MARC::Field::ERROR> is set.
301
302=cut
303
304sub subfield {
305 my $self = shift;
306 my $code_wanted = shift;
307
308 croak( "Control fields (generally, just tags below 010) do not have subfields, use data()" )
309 if $self->is_control_field;
310
311 my @data = @{$self->{_subfields}};
312 my @found;
313 while ( defined( my $code = shift @data ) ) {
314 if ( $code eq $code_wanted ) {
315 push( @found, shift @data );
316 } else {
317 shift @data;
318 }
319 }
320 if ( wantarray() ) { return @found; }
321 return( $found[0] );
322}
323
324=head2 subfields()
325
326Returns all the subfields in the field. What's returned is a list of
327list refs, where the inner list is a subfield code and the subfield data.
328
329For example, this might be the subfields from a 245 field:
330
331 (
332 [ 'a', 'Perl in a nutshell :' ],
333 [ 'b', 'A desktop quick reference.' ],
334 )
335
336=cut
337
338sub subfields {
339 my $self = shift;
340
341 if ($self->is_control_field) {
342 $self->_warn( "Control fields (generally, just tags below 010) do not have subfields" );
343 return;
344 }
345
346 my @list;
347 my @data = @{$self->{_subfields}};
348 while ( defined( my $code = shift @data ) ) {
349 push( @list, [$code, shift @data] );
350 }
351 return @list;
352}
353
354=head2 data()
355
356Returns the data part of the field, if the tag number is less than 10.
357
358=cut
359
360sub data {
361 my $self = shift;
362
363 croak( "data() is only for control fields (generally, just tags below 010) , use subfield()" )
364 unless $self->is_control_field;
365
366 $self->{_data} = $_[0] if @_;
367
368 return $self->{_data};
369}
370
371=head2 add_subfields(code,text[,code,text ...])
372
373Adds subfields to the end of the subfield list.
374
375 $field->add_subfields( 'c' => '1985' );
376
377Returns the number of subfields added, or C<undef> if there was an error.
378
379=cut
380
381sub add_subfields {
382 my $self = shift;
383
384 croak( "Subfields are only for data fields (generally, just tags >= 010)" )
385 if $self->is_control_field;
386
387 push( @{$self->{_subfields}}, @_ );
388 return @_/2;
389}
390
391=head2 delete_subfield()
392
393delete_subfield() allows you to remove subfields from a field:
394
395 # delete any subfield a in the field
396 $field->delete_subfield(code => 'a');
397
398 # delete any subfield a or u in the field
399 $field->delete_subfield(code => ['a', 'u']);
400
401 # delete any subfield code matching a compiled regular expression
402 $field->delete_subfield(code => qr/[^a-z0-9]/);
403
404If you want to only delete subfields at a particular position you can
405use the pos parameter:
406
407 # delete subfield u at the first position
408 $field->delete_subfield(code => 'u', pos => 0);
409
410 # delete subfield u at first or second position
411 $field->delete_subfield(code => 'u', pos => [0,1]);
412
413 # delete the second subfield, no matter what it is
414 $field->delete_subfield(pos => 1);
415
416You can specify a regex to for only deleting subfields that match:
417
418 # delete any subfield u that matches zombo.com
419 $field->delete_subfield(code => 'u', match => qr/zombo.com/);
420
421 # delete any subfield that matches quux
422 $field->delete_subfield(match => qr/quux/);
423
424You can also pass a single subfield label:
425
426 # delete all subfield u
427 $field->delete_subfield('u');
428
429=cut
430
431sub delete_subfield {
432 my ($self, @options) = @_;
433
434 my %options;
435 if (scalar(@options) == 1) {
436 $options{code} = $options[0];
437 } elsif (0 == scalar(@options) % 2) {
438 %options = @options;
439 } else {
440 croak 'delete_subfield must be called with single scalar or a hash';
441 }
442
443 my $codes = _normalize_arrayref($options{code});
444 my $positions = _normalize_arrayref($options{'pos'});
445 my $match = $options{match};
446
447 croak 'match must be a compiled regex'
448 if $match and ref($match) ne 'Regexp';
449
450 croak 'must supply subfield code(s) and/or subfield position(s) and/or match patterns to delete_subfield'
451 unless $match or (@$codes > 0) or (@$positions > 0);
452
453 my @current_subfields = @{$self->{_subfields}};
454 my @new_subfields = ();
455 my $removed = 0;
45621.88ms11.22ms
# spent 1.22ms (1.06+162µs) within MARC::Field::BEGIN@456 which was called: # once (1.06ms+162µs) by MARC::Record::BEGIN@15 at line 456
my $subfield_num = $[ - 1; # users $[ preferences control indexing
# spent 1.22ms making 1 call to MARC::Field::BEGIN@456
457
458 while (@current_subfields > 0) {
459 $subfield_num += 1;
460 my $subfield_code = shift @current_subfields;
461 my $subfield_value = shift @current_subfields;
462 if ((@$codes==0 or
463 grep {
464 (ref($_) eq 'Regexp' && $subfield_code =~ $_) ||
465 (ref($_) ne 'Regexp' && $_ eq $subfield_code)
466 } @$codes)
467 and (!$match or $subfield_value =~ $match)
468 and (@$positions==0 or grep {$_ == $subfield_num} @$positions)) {
469 $removed += 1;
470 next;
471 }
472 push( @new_subfields, $subfield_code, $subfield_value);
473 }
474 $self->{_subfields} = \@new_subfields;
475 return $removed;
476}
477
478=head2 delete_subfields()
479
480Delete all subfields with a given subfield code. This is here for backwards
481compatibility, you should use the more flexible delete_subfield().
482
483=cut
484
485sub delete_subfields {
486 my ($self, $code) = @_;
487 return $self->delete_subfield(code => $code);
488}
489
490=head2 update()
491
492Allows you to change the values of the field. You can update indicators
493and subfields like this:
494
495 $field->update( ind2 => '4', a => 'The ballad of Abe Lincoln');
496
497If you attempt to update a subfield which does not currently exist in the field,
498then a new subfield will be appended to the field. If you don't like this
499auto-vivification you must check for the existence of the subfield prior to
500update.
501
502 if ( $field->subfield( 'a' ) ) {
503 $field->update( 'a' => 'Cryptonomicon' );
504 }
505
506If you want to update a field that has no indicators or subfields (000-009)
507just call update() with one argument, the string that you would like to
508set the field to.
509
510 $field = $record->field( '003' );
511 $field->update('IMchF');
512
513Note: when doing subfield updates be aware that C<update()> will only
514update the first occurrence. If you need to do anything more complicated
515you will probably need to create a new field and use C<replace_with()>.
516
517Returns the number of items modified.
518
519=cut
520
521sub update {
522 my $self = shift;
523
524 ## tags 000 - 009 don't have indicators or subfields
525 if ( $self->is_control_field ) {
526 $self->{_data} = shift;
527 return(1);
528 }
529
530 ## otherwise we need to update subfields and indicators
531 my @data = @{$self->{_subfields}};
532 my $changes = 0;
533
534 while ( @_ ) {
535
536 my $arg = shift;
537 my $val = shift;
538
539 ## indicator update
540 if ($arg =~ /^ind[12]$/) {
541 $self->{"_$arg"} = $val;
542 $changes++;
543 }
544
545 ## subfield update
546 else {
547 my $found = 0;
548 ## update existing subfield
549 for ( my $i=0; $i<@data; $i+=2 ) {
550 if ($data[$i] eq $arg) {
551 $data[$i+1] = $val;
552 $found = 1;
553 $changes++;
554 last;
555 }
556 } # for
557
558 ## append new subfield
559 if ( !$found ) {
560 push( @data, $arg, $val );
561 $changes++;
562 }
563 }
564
565 } # while
566
567 ## synchronize our subfields
568 $self->{_subfields} = \@data;
569 return($changes);
570
571}
572
573=head2 replace_with()
574
575Allows you to replace an existing field with a new one. You need to pass
576C<replace()> a MARC::Field object to replace the existing field with. For
577example:
578
579 $field = $record->field('245');
580 my $new_field = new MARC::Field('245','0','4','The ballad of Abe Lincoln.');
581 $field->replace_with($new_field);
582
583Doesn't return a meaningful or reliable value.
584
585=cut
586
587sub replace_with {
588
589 my ($self,$new) = @_;
590 ref($new) =~ /^MARC::Field$/
591 or croak("Must pass a MARC::Field object");
592
593 %$self = %$new;
594
595}
596
597
598=head2 as_string( [$subfields] [, $delimiter] )
599
600Returns a string of all subfields run together. A space is added to
601the result between each subfield, unless the delimiter parameter is
602passed. The tag number and subfield character are not included.
603
604Subfields appear in the output string in the order in which they
605occur in the field.
606
607If C<$subfields> is specified, then only those subfields will be included.
608
609 my $field = MARC::Field->new(
610 245, '1', '0',
611 'a' => 'Abraham Lincoln',
612 'h' => '[videorecording] :',
613 'b' => 'preserving the union /',
614 'c' => 'A&E Home Video.'
615 );
616 print $field->as_string( 'abh' ); # Only those three subfields
617 # prints 'Abraham Lincoln [videorecording] : preserving the union /'.
618 print $field->as_string( 'ab', '--' ); # Only those two subfields, with a delimiter
619 # prints 'Abraham Lincoln--preserving the union /'.
620
621Note that subfield h comes before subfield b in the output.
622
623=cut
624
625sub as_string {
626 my $self = shift;
627 my $subfields = shift;
628 my $delimiter = shift;
629 $delimiter = " " unless defined $delimiter;
630
631 if ( $self->is_control_field ) {
632 return $self->{_data};
633 }
634
635 my @subs;
636
637 my $subs = $self->{_subfields};
638 my $nfields = @$subs / 2;
639 for my $i ( 1..$nfields ) {
640 my $offset = ($i-1)*2;
641 my $code = $subs->[$offset];
642 my $text = $subs->[$offset+1];
643 push( @subs, $text ) if !defined($subfields) || $code =~ /^[$subfields]$/;
644 } # for
645
646 return join( $delimiter, @subs );
647}
648
649
650=head2 as_formatted()
651
652Returns a pretty string for printing in a MARC dump.
653
654=cut
655
656sub as_formatted {
657 my $self = shift;
658
659 my @lines;
660
661 if ( $self->is_control_field ) {
662 push( @lines, sprintf( "%03s %s", $self->{_tag}, $self->{_data} ) );
663 } else {
664 my $hanger = sprintf( "%03s %1.1s%1.1s", $self->{_tag}, $self->{_ind1}, $self->{_ind2} );
665
666 my $subs = $self->{_subfields};
667 my $nfields = @$subs / 2;
668 my $offset = 0;
669 for my $i ( 1..$nfields ) {
670 push( @lines, sprintf( "%-6.6s _%1.1s%s", $hanger, $subs->[$offset++], $subs->[$offset++] ) );
671 $hanger = "";
672 } # for
673 }
674
675 return join( "\n", @lines );
676}
677
678
679=head2 as_usmarc()
680
681Returns a string for putting into a USMARC file. It's really only
682useful for C<MARC::Record::as_usmarc()>.
683
684=cut
685
686sub as_usmarc {
687 my $self = shift;
688
689 # Control fields are pretty easy
690 if ( $self->is_control_field ) {
691 return $self->data . END_OF_FIELD;
692 } else {
693 my @subs;
694 my @subdata = @{$self->{_subfields}};
695 while ( @subdata ) {
696 push( @subs, join( "", SUBFIELD_INDICATOR, shift @subdata, shift @subdata ) );
697 } # while
698
699 return
700 join( "",
701 $self->indicator(1),
702 $self->indicator(2),
703 @subs,
704 END_OF_FIELD, );
705 }
706}
707
708=head2 clone()
709
710Makes a copy of the field. Note that this is not just the same as saying
711
712 my $newfield = $field;
713
714since that just makes a copy of the reference. To get a new object, you must
715
716 my $newfield = $field->clone;
717
718Returns a MARC::Field record.
719
720=cut
721
722sub clone {
723 my $self = shift;
724
725 my $tagno = $self->{_tag};
726 my $is_control = $self->is_controlfield_tag($tagno);
727
728 my $clone =
729 bless {
730 _tag => $tagno,
731 _warnings => [],
732 _is_control_field => $is_control,
733 }, ref($self);
734
735 if ( $is_control ) {
736 $clone->{_data} = $self->{_data};
737 } else {
738 $clone->{_ind1} = $self->{_ind1};
739 $clone->{_ind2} = $self->{_ind2};
740 $clone->{_subfields} = [@{$self->{_subfields}}];
741 }
742
743 return $clone;
744}
745
746=head2 warnings()
747
748Returns the warnings that were created when the record was read.
749These are things like "Invalid indicators converted to blanks".
750
751The warnings are items that you might be interested in, or might
752not. It depends on how stringently you're checking data. If
753you're doing some grunt data analysis, you probably don't care.
754
755=cut
756
757sub warnings {
758 my $self = shift;
759
760 return @{$self->{_warnings}};
761}
762
763# NOTE: _warn is an object method
764sub _warn {
765 my $self = shift;
766
767 push( @{$self->{_warnings}}, join( "", @_ ) );
768}
769
770sub _gripe {
771 $ERROR = join( "", @_ );
772
773 warn $ERROR;
774
775 return;
776}
777
778sub _normalize_arrayref {
779 my $ref = shift;
780 if (ref($ref) eq 'ARRAY') { return $ref }
781 elsif (defined $ref) { return [$ref] }
782 return [];
783}
784
785
78612µs1;
787
788__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.