← 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/Record.pm
StatementsExecuted 29 statements in 2.86ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.63ms4.02msMARC::Record::::BEGIN@15MARC::Record::BEGIN@15
11127µs37µsMARC::Record::::BEGIN@9MARC::Record::BEGIN@9
11110µs14µsMARC::Record::::BEGIN@10MARC::Record::BEGIN@10
1118µs29µsMARC::Record::::BEGIN@13MARC::Record::BEGIN@13
1118µs36µsMARC::Record::::BEGIN@16MARC::Record::BEGIN@16
1118µs21µsMARC::Record::::BEGIN@27MARC::Record::BEGIN@27
1118µs24µsMARC::Record::::BEGIN@24MARC::Record::BEGIN@24
1117µs9µsMARC::Record::::BEGIN@11MARC::Record::BEGIN@11
1117µs56µsMARC::Record::::BEGIN@28MARC::Record::BEGIN@28
1116µs20µsMARC::Record::::BEGIN@33MARC::Record::BEGIN@33
1116µs31µsMARC::Record::::BEGIN@35MARC::Record::BEGIN@35
0000s0sMARC::Record::::_all_parms_are_fieldsMARC::Record::_all_parms_are_fields
0000s0sMARC::Record::::_gripeMARC::Record::_gripe
0000s0sMARC::Record::::_warnMARC::Record::_warn
0000s0sMARC::Record::::add_fieldsMARC::Record::add_fields
0000s0sMARC::Record::::append_fieldsMARC::Record::append_fields
0000s0sMARC::Record::::as_formattedMARC::Record::as_formatted
0000s0sMARC::Record::::as_usmarcMARC::Record::as_usmarc
0000s0sMARC::Record::::authorMARC::Record::author
0000s0sMARC::Record::::cloneMARC::Record::clone
0000s0sMARC::Record::::delete_fieldMARC::Record::delete_field
0000s0sMARC::Record::::delete_fieldsMARC::Record::delete_fields
0000s0sMARC::Record::::editionMARC::Record::edition
0000s0sMARC::Record::::encodingMARC::Record::encoding
0000s0sMARC::Record::::fieldMARC::Record::field
0000s0sMARC::Record::::fieldsMARC::Record::fields
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::::leaderMARC::Record::leader
0000s0sMARC::Record::::newMARC::Record::new
0000s0sMARC::Record::::new_from_usmarcMARC::Record::new_from_usmarc
0000s0sMARC::Record::::publication_dateMARC::Record::publication_date
0000s0sMARC::Record::::set_leader_lengthsMARC::Record::set_leader_lengths
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
5MARC::Record - Perl extension for handling MARC records
6
7=cut
8
9223µs247µs
# spent 37µs (27+10) within MARC::Record::BEGIN@9 which was called: # once (27µs+10µs) by C4::Biblio::BEGIN@27 at line 9
use strict;
# spent 37µs making 1 call to MARC::Record::BEGIN@9 # spent 10µs making 1 call to strict::import
10219µs218µs
# spent 14µs (10+4) within MARC::Record::BEGIN@10 which was called: # once (10µs+4µs) by C4::Biblio::BEGIN@27 at line 10
use warnings;
# spent 14µs making 1 call to MARC::Record::BEGIN@10 # spent 4µs making 1 call to warnings::import
11223µs211µs
# spent 9µs (7+2) within MARC::Record::BEGIN@11 which was called: # once (7µs+2µs) by C4::Biblio::BEGIN@27 at line 11
use integer;
# spent 9µs making 1 call to MARC::Record::BEGIN@11 # spent 2µs making 1 call to integer::import
12
13225µs249µs
# spent 29µs (8+20) within MARC::Record::BEGIN@13 which was called: # once (8µs+20µs) by C4::Biblio::BEGIN@27 at line 13
use vars qw( $ERROR );
# spent 29µs making 1 call to MARC::Record::BEGIN@13 # spent 20µs making 1 call to vars::import
14
152724µs14.02ms
# spent 4.02ms (2.63+1.39) within MARC::Record::BEGIN@15 which was called: # once (2.63ms+1.39ms) by C4::Biblio::BEGIN@27 at line 15
use MARC::Field;
# spent 4.02ms making 1 call to MARC::Record::BEGIN@15
16228µs264µs
# spent 36µs (8+28) within MARC::Record::BEGIN@16 which was called: # once (8µs+28µs) by C4::Biblio::BEGIN@27 at line 16
use Carp qw(croak carp);
# spent 36µs making 1 call to MARC::Record::BEGIN@16 # spent 28µs making 1 call to Exporter::import
17
18=head1 VERSION
19
20Version 2.0.6
21
22=cut
23
24227µs240µs
# spent 24µs (8+16) within MARC::Record::BEGIN@24 which was called: # once (8µs+16µs) by C4::Biblio::BEGIN@27 at line 24
use vars qw( $VERSION );
# spent 24µs making 1 call to MARC::Record::BEGIN@24 # spent 16µs making 1 call to vars::import
251400ns$VERSION = '2.0.6';
26
272245µs233µs
# spent 21µs (8+13) within MARC::Record::BEGIN@27 which was called: # once (8µs+13µs) by C4::Biblio::BEGIN@27 at line 27
use Exporter;
# spent 21µs making 1 call to MARC::Record::BEGIN@27 # spent 13µs making 1 call to Exporter::import
28241µs2105µs
# spent 56µs (7+49) within MARC::Record::BEGIN@28 which was called: # once (7µs+49µs) by C4::Biblio::BEGIN@27 at line 28
use vars qw( @ISA @EXPORTS @EXPORT_OK );
# spent 56µs making 1 call to MARC::Record::BEGIN@28 # spent 49µs making 1 call to vars::import
2916µs@ISA = qw( Exporter );
301200ns@EXPORTS = qw();
311400ns@EXPORT_OK = qw( LEADER_LEN );
32
33326µs234µs
# spent 20µs (6+14) within MARC::Record::BEGIN@33 which was called: # once (6µs+14µs) by C4::Biblio::BEGIN@27 at line 33
use vars qw( $DEBUG ); $DEBUG = 0;
# spent 20µs making 1 call to MARC::Record::BEGIN@33 # spent 14µs making 1 call to vars::import
34
3521.67ms255µs
# spent 31µs (6+25) within MARC::Record::BEGIN@35 which was called: # once (6µs+25µs) by C4::Biblio::BEGIN@27 at line 35
use constant LEADER_LEN => 24;
# spent 31µs making 1 call to MARC::Record::BEGIN@35 # spent 24µs making 1 call to constant::import
36
37=head1 DESCRIPTION
38
39Module for handling MARC records as objects. The file-handling stuff is
40in MARC::File::*.
41
42=head1 ERROR HANDLING
43
44Any errors generated are stored in C<$MARC::Record::ERROR>.
45Warnings are kept with the record and accessible in the C<warnings()> method.
46
47=head1 CONSTRUCTORS
48
49=head2 new()
50
51Base constructor for the class. It just returns a completely empty record.
52To get real data, you'll need to populate it with fields, or use one of
53the MARC::File::* modules to read from a file.
54
55=cut
56
57sub new {
58 my $class = shift;
59 my $self = {
60 _leader => ' ' x 24,
61 _fields => [],
62 _warnings => [],
63 };
64 return bless $self, $class;
65} # new()
66
67=head2 new_from_usmarc( $marcblob [, \&filter_func($tagno,$tagdata)] )
68
69This is a wrapper around C<MARC::File::USMARC::decode()> for compatibility with
70older versions of MARC::Record.
71
72The C<wanted_func()> is optional. See L<MARC::File::USMARC>::decode for details.
73
74=cut
75
76sub new_from_usmarc {
77 my $blob = shift;
78 $blob = shift if (ref($blob) || ($blob eq "MARC::Record"));
79
80 require MARC::File::USMARC;
81
82 return MARC::File::USMARC::decode( $blob, @_ );
83}
84
85=head1 COMMON FIELD RETRIEVAL METHODS
86
87Following are a number of convenience methods for commonly-retrieved
88data fields. Please note that they each return strings, not MARC::Field
89objects. They return empty strings if the appropriate field or subfield
90is not found. This is as opposed to the C<field()>/C<subfield()> methods
91which return C<undef> if something's not found. My assumption is that
92these methods are used for quick & dirty reports and you don't want to
93mess around with noting if something is undef.
94
95Also note that no punctuation cleanup is done. If the 245a is
96"Programming Perl / ", then that's what you'll get back, rather than
97"Programming Perl".
98
99=head2 title()
100
101Returns the title from the 245 tag.
102
103=cut
104
105sub title {
106 my $self = shift;
107
108 my $field = $self->field(245);
109 return $field ? $field->as_string : "";
110}
111
112=head2 title_proper()
113
114Returns the title proper from the 245 tag, subfields a, n and p.
115
116=cut
117
118sub title_proper {
119 my $self = shift;
120
121 my $field = $self->field(245);
122
123 if ( $field ) {
124 return $field->as_string('anp');
125 } else {
126 return "";
127 }
128}
129
130=head2 author()
131
132Returns the author from the 100, 110 or 111 tag.
133
134=cut
135
136sub author {
137 my $self = shift;
138
139 my $field = $self->field('100|110|111');
140 return $field ? $field->as_string : "";
141}
142
143=head2 edition()
144
145Returns the edition from the 250 tag, subfield a.
146
147=cut
148
149sub edition {
150 my $self = shift;
151
152 my $str = $self->subfield(250,'a');
153 return defined $str ? $str : "";
154}
155
156=head2 publication_date()
157
158Returns the publication date from the 260 tag, subfield c.
159
160=cut
161
162sub publication_date {
163 my $self = shift;
164
165 my $str = $self->subfield(260,'c');
166 return defined $str ? $str : "";
167}
168
169=head1 FIELD & SUBFIELD ACCESS METHODS
170
171=head2 fields()
172
173Returns a list of all the fields in the record. The list contains
174a MARC::Field object for each field in the record.
175
176=cut
177
178sub fields {
179 my $self = shift;
180 return @{$self->{_fields}};
181}
182
183=head2 field( I<tagspec(s)> )
184
185Returns a list of tags that match the field specifier, or an empty
186list if nothing matched. In scalar context, returns the first
187matching tag, or undef if nothing matched.
188
189The field specifier can be a simple number (i.e. "245"), or use the "."
190notation of wildcarding (i.e. subject tags are "6..").
191
192=cut
193
1941200nsmy %field_regex;
195
196sub field {
197 my $self = shift;
198 my @specs = @_;
199
200 my @list = ();
201 for my $tag ( @specs ) {
202 my $regex = $field_regex{ $tag };
203
204 # Compile & stash it if necessary
205 if ( not defined $regex ) {
206 $regex = qr/^$tag$/;
207 $field_regex{ $tag } = $regex;
208 } # not defined
209
210 for my $maybe ( $self->fields ) {
211 if ( $maybe->tag =~ $regex ) {
212 return $maybe unless wantarray;
213
214 push( @list, $maybe );
215 } # if
216 } # for $maybe
217 } # for $tag
218
219 return unless wantarray;
220 return @list;
221}
222
223=head2 subfield( $tag, $subfield )
224
225Shortcut method for getting just a subfield for a tag. These are equivalent:
226
227 my $title = $marc->field('245')->subfield("a");
228 my $title = $marc->subfield('245',"a");
229
230If either the field or subfield can't be found, C<undef> is returned.
231
232=cut
233
234sub subfield {
235 my $self = shift;
236 my $tag = shift;
237 my $subfield = shift;
238
239 my $field = $self->field($tag) or return;
240 return $field->subfield($subfield);
241} # subfield()
242
243=for internal
244
245=cut
246
247sub _all_parms_are_fields {
248 for ( @_ ) {
249 return 0 unless UNIVERSAL::isa($_, 'MARC::Field');
250 }
251 return 1;
252}
253
254=head2 append_fields( @fields )
255
256Appends the field specified by C<$field> to the end of the record.
257C<@fields> need to be MARC::Field objects.
258
259 my $field = MARC::Field->new('590','','','a' => 'My local note.');
260 $record->append_fields($field);
261
262Returns the number of fields appended.
263
264=cut
265
266sub append_fields {
267 my $self = shift;
268
269 _all_parms_are_fields(@_) or croak('Arguments must be MARC::Field objects');
270
271 push(@{ $self->{_fields} }, @_);
272 return scalar @_;
273}
274
275=head2 insert_fields_before( $before_field, @new_fields )
276
277Inserts the field specified by C<$new_field> before the field C<$before_field>.
278Returns the number of fields inserted, or undef on failures.
279Both C<$before_field> and all C<@new_fields> need to be MARC::Field objects.
280If they are not an exception will be thrown.
281
282 my $before_field = $record->field('260');
283 my $new_field = MARC::Field->new('250','','','a' => '2nd ed.');
284 $record->insert_fields_before($before_field,$new_field);
285
286=cut
287
288sub insert_fields_before {
289 my $self = shift;
290
291 _all_parms_are_fields(@_)
292 or croak('All arguments must be MARC::Field objects');
293
294 my ($before,@new) = @_;
295
296 ## find position of $before
297 my $fields = $self->{_fields};
298 my $pos = 0;
299 foreach my $f (@$fields) {
300 last if ($f == $before);
301 $pos++;
302 }
303
304 ## insert before $before
305 if ($pos >= @$fields) {
306 $self->_warn("Couldn't find field to insert before");
307 return;
308 }
309 splice(@$fields,$pos,0,@new);
310 return scalar @new;
311
312}
313
314=head2 insert_fields_after( $after_field, @new_fields )
315
316Identical to C<insert_fields_before()>, but fields are added after
317C<$after_field>. Remember, C<$after_field> and any new fields must be
318valid MARC::Field objects or else an exception will be thrown.
319
320=cut
321
322sub insert_fields_after {
323 my $self = shift;
324
325 _all_parms_are_fields(@_) or croak('All arguments must be MARC::Field objects');
326 my ($after,@new) = @_;
327
328 ## find position of $after
329 my $fields = $self->{_fields};
330 my $pos = 0;
331 my $found = 0;
332 foreach my $f (@$fields) {
333 if ($f == $after) {
334 $found = 1;
335 last;
336 }
337 $pos++;
338 }
339
340 ## insert after $after
341 unless ($found) {
342 $self->_warn("Couldn't find field to insert after");
343 return;
344 }
345 splice(@$fields,$pos+1,0,@new);
346 return scalar @new;
347}
348
349=head2 insert_fields_ordered( @new_fields )
350
351Will insert fields in strictly numerical order. So a 008 will be filed
352after a 001 field. See C<insert_grouped_field()> for an additional ordering.
353
354=cut
355
356sub insert_fields_ordered {
357 my ( $self, @new ) = @_;
358
359 _all_parms_are_fields(@new)
360 or croak('All arguments must be MARC::Field objects');
361
362 ## go through each new field
363 NEW_FIELD: foreach my $newField ( @new ) {
364
365 ## find location before which it should be inserted
366 EXISTING_FIELD: foreach my $field ( @{ $self->{_fields} } ) {
367 if ( $field->tag() >= $newField->tag() ) {
368 $self->insert_fields_before( $field, $newField );
369 next NEW_FIELD;
370 }
371 }
372
373 ## if we fell through then this new field is higher than
374 ## all the existing fields, so we append.
375 $self->append_fields( $newField );
376
377 }
378 return( scalar( @new ) );
379}
380
381=head2 insert_grouped_field( $field )
382
383Will insert the specified MARC::Field object into the record in grouped
384order and return true (1) on success, and false (undef) on failure.
385
386 my $field = MARC::Field->new( '510', 'Indexed by Google.' );
387 $record->insert_grouped_field( $field );
388
389For example, if a '650' field is inserted with C<insert_grouped_field()>
390it will be inserted at the end of the 6XX group of tags. After discussion
391most people wanted the ability to add a new field to the end of the
392hundred group where it belonged. The reason is that according to the MARC
393format, fields within a record are supposed to be grouped by block
394(hundred groups). This means that fields may not necessarily be in tag
395order.
396
397=cut
398
399sub insert_grouped_field {
400 my ($self,$new) = @_;
401 _all_parms_are_fields($new) or croak('Argument must be MARC::Field object');
402
403 ## try to find the end of the field group and insert it there
404 my $limit = int($new->tag() / 100);
405 my $found = 0;
406 foreach my $field ($self->fields()) {
407 if ( int($field->tag() / 100) > $limit ) {
408 $self->insert_fields_before($field,$new);
409 $found = 1;
410 last;
411 }
412 }
413
414 ## if we couldn't find the end of the group, then we must not have
415 ## any tags this high yet, so just append it
416 if (!$found) {
417 $self->append_fields($new);
418 }
419
420 return(1);
421
422}
423
424
425=head2 delete_fields( $field )
426
427Deletes a given list of MARC::Field objects from the the record.
428
429 # delete all note fields
430 my @notes = $record->field('5..');
431 $record->delete_fields(@notes);
432
433delete_fields() will return the number of fields that were deleted.
434
435=cut
436
437sub delete_fields {
438 my $self = shift;
439 _all_parms_are_fields(@_) or croak('Arguments must be MARC::Field object');
440 my @fields = @{$self->{_fields}};
441 my $original_count = @fields;
442
443 foreach my $deleter (@_) {
444 @fields = grep { $_ != $deleter } @fields;
445 }
446 $self->{_fields} = \@fields;
447
448 return $original_count - @fields;
449}
450
451=head2 delete_field()
452
453Same thing as delete_fields() but only expects a single MARC::Field to be passed
454in. Mainly here for backwards compatibility.
455
456=cut
457
458sub delete_field {
459 return delete_fields(@_);
460}
461
462=head2 as_usmarc()
463
464This is a wrapper around C<MARC::File::USMARC::encode()> for compatibility with
465older versions of MARC::Record.
466
467=cut
468
469sub as_usmarc {
470 my $self = shift;
471
472 require MARC::File::USMARC;
473
474 return MARC::File::USMARC::encode( $self );
475}
476
477=head2 as_formatted()
478
479Returns a pretty string for printing in a MARC dump.
480
481=cut
482
483sub as_formatted {
484 my $self = shift;
485
486 my @lines = ( "LDR " . ($self->{_leader} || "") );
487 for my $field ( @{$self->{_fields}} ) {
488 push( @lines, $field->as_formatted() );
489 }
490
491 return join( "\n", @lines );
492} # as_formatted
493
494
495=head2 leader()
496
497Returns the leader for the record. Sets the leader if I<text> is defined.
498No error checking is done on the validity of the leader.
499
500=cut
501
502sub leader {
503 my $self = shift;
504 my $text = shift;
505
506 if ( defined $text ) {
507 (length($text) eq 24)
508 or $self->_warn( "Leader must be 24 bytes long" );
509 $self->{_leader} = $text;
510 } # set the leader
511
512 return $self->{_leader};
513} # leader()
514
515=head2 encoding()
516
517A method for getting/setting the encoding for a record. The encoding for a
518record is determined by position 09 in the leader, which is blank for MARC-8
519encoding, and 'a' for UCS/Unicode. encoding() will return a string, either
520'MARC-8' or 'UTF-8' appropriately.
521
522If you want to set the encoding for a MARC::Record object you can use the
523string values:
524
525 $record->encoding( 'UTF-8' );
526
527NOTE: MARC::Record objects created from scratch have an a default encoding
528of MARC-8, which has been the standard for years...but many online catlogs
529and record vendors are migrating to UTF-8.
530
531WARNING: you should be sure your record really does contain valid UTF-8 data
532when you manually set the encoding.
533
534=cut
535
536sub encoding {
537 my ($self,$arg) = @_;
538 # we basically report from and modify the leader directly
539 my $leader = $self->leader();
540
541 # when setting
542 if ( defined($arg) ) {
543 if ( $arg =~ /UTF-?8/i ) {
544 substr($leader,9,1) = 'a';
545 }
546 elsif ( $arg =~ /MARC-?8/i ) {
547 substr($leader,9,1) = ' ';
548 }
549 $self->leader($leader);
550 }
551
552 return substr($leader,9,1) eq 'a' ? 'UTF-8' : 'MARC-8';
553}
554
555=head2 set_leader_lengths( $reclen, $baseaddr )
556
557Internal function for updating the leader's length and base address.
558
559=cut
560
561sub set_leader_lengths {
562 my $self = shift;
563 my $reclen = shift;
564 my $baseaddr = shift;
565 if ($reclen > 99999) {
566 carp( "Record length of $reclen is larger than the MARC spec allows (99999 bytes)." );
567 $reclen = 99999;
568 }
569 substr($self->{_leader},0,5) = sprintf("%05d",$reclen);
570 substr($self->{_leader},12,5) = sprintf("%05d",$baseaddr);
571 # MARC21 defaults: http://www.loc.gov/marc/bibliographic/ecbdldrd.html
572 substr($self->{_leader},10,2) = '22';
573 substr($self->{_leader},20,4) = '4500';
574}
575
576=head2 clone()
577
578The C<clone()> method makes a copy of an existing MARC record and returns
579the new version. Note that you cannot just say:
580
581 my $newmarc = $oldmarc;
582
583This just makes a copy of the reference, not a new object. You must use
584the C<clone()> method like so:
585
586 my $newmarc = $oldmarc->clone;
587
588You can also specify field specs to filter down only a
589certain subset of fields. For instance, if you only wanted the
590title and ISBN tags from a record, you could do this:
591
592 my $small_marc = $marc->clone( 245, '020' );
593
594The order of the fields is preserved as it was in the original record.
595
596=cut
597
598sub clone {
599 my $self = shift;
600 my @keeper_tags = @_;
601
602 # create a new object of whatever type we happen to be
603 my $class = ref( $self );
604 my $clone = $class->new();
605
606 $clone->{_leader} = $self->{_leader};
607
608 my $filtered = @keeper_tags ? [$self->field( @keeper_tags )] : undef;
609
610 for my $field ( $self->fields() ) {
611 if ( !$filtered || (grep {$field eq $_} @$filtered ) ) {
612 $clone->append_fields( $field->clone );
613 }
614 }
615
616 # XXX FIX THIS $clone->update_leader();
617
618 return $clone;
619}
620
621=head2 warnings()
622
623Returns the warnings (as a list) that were created when the record was read.
624These are things like "Invalid indicators converted to blanks".
625
626 my @warnings = $record->warnings();
627
628The warnings are items that you might be interested in, or might
629not. It depends on how stringently you're checking data. If
630you're doing some grunt data analysis, you probably don't care.
631
632A side effect of calling warnings() is that the warning buffer will
633be cleared.
634
635=cut
636
637sub warnings {
638 my $self = shift;
639 my @warnings = @{$self->{_warnings}};
640 $self->{_warnings} = [];
641 return @warnings;
642}
643
644=head2 add_fields()
645
646C<add_fields()> is now deprecated, and users are encouraged to use
647C<append_fields()>, C<insert_fields_after()>, and C<insert_fields_before()>
648since they do what you want probably. It is still here though, for backwards
649compatibility.
650
651C<add_fields()> adds MARC::Field objects to the end of the list. Returns the
652number of fields added, or C<undef> if there was an error.
653
654There are three ways of calling C<add_fields()> to add data to the record.
655
656=over 4
657
658=item 1 Create a MARC::Field object and add it
659
660 my $author = MARC::Field->new(
661 100, "1", " ", a => "Arnosky, Jim."
662 );
663 $marc->add_fields( $author );
664
665=item 2 Add the data fields directly, and let C<add_fields()> take care of the objectifying.
666
667 $marc->add_fields(
668 245, "1", "0",
669 a => "Raccoons and ripe corn /",
670 c => "Jim Arnosky.",
671 );
672
673=item 3 Same as #2 above, but pass multiple fields of data in anonymous lists
674
675 $marc->add_fields(
676 [ 250, " ", " ", a => "1st ed." ],
677 [ 650, "1", " ", a => "Raccoons." ],
678 );
679
680=back
681
682=cut
683
684sub add_fields {
685 my $self = shift;
686
687 my $nfields = 0;
688 my $fields = $self->{_fields};
689
690 while ( my $parm = shift ) {
691 # User handed us a list of data (most common possibility)
692 if ( ref($parm) eq "" ) {
693 my $field = MARC::Field->new( $parm, @_ )
694 or return _gripe( $MARC::Field::ERROR );
695 push( @$fields, $field );
696 ++$nfields;
697 last; # Bail out, we're done eating parms
698
699 # User handed us an object.
700 } elsif ( UNIVERSAL::isa($parm, 'MARC::Field') ) {
701 push( @$fields, $parm );
702 ++$nfields;
703
704 # User handed us an anonymous list of parms
705 } elsif ( ref($parm) eq "ARRAY" ) {
706 my $field = MARC::Field->new(@$parm)
707 or return _gripe( $MARC::Field::ERROR );
708 push( @$fields, $field );
709 ++$nfields;
710
711 } else {
712 croak( "Unknown parm of type", ref($parm), " passed to add_fields()" );
713 } # if
714
715 } # while
716
717 return $nfields;
718}
719
720# NOTE: _warn is an object method
721sub _warn {
722 my $self = shift;
723 push( @{$self->{_warnings}}, join( "", @_ ) );
724 return( $self );
725}
726
727
728# NOTE: _gripe is NOT an object method
729sub _gripe {
730 $ERROR = join( "", @_ );
731
732 warn $ERROR;
733
734 return;
735}
736
737
73814µs1;
739
740__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.