| File | /usr/share/perl5/MARC/Field.pm |
| Statements Executed | 19 |
| Total Time | 0.0021888 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 0 | 0 | 0 | 0s | 0s | MARC::Field::BEGIN |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::_gripe |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::_normalize_arrayref |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::_warn |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::add_subfields |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::as_formatted |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::as_string |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::as_usmarc |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::clone |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::data |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::delete_subfield |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::delete_subfields |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::indicator |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::is_control_field |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::new |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::replace_with |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::subfield |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::subfields |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::tag |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::update |
| 0 | 0 | 0 | 0s | 0s | MARC::Field::warnings |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package MARC::Field; | |||
| 2 | ||||
| 3 | 3 | 24µs | 8µs | use strict; # spent 9µs making 1 call to strict::import |
| 4 | 3 | 24µs | 8µs | use integer; # spent 9µs making 1 call to integer::import |
| 5 | 3 | 44µs | 15µs | use Carp; # spent 67µs making 1 call to Exporter::import |
| 6 | ||||
| 7 | 3 | 45µs | 15µs | use constant SUBFIELD_INDICATOR => "\x1F"; # spent 53µs making 1 call to constant::import |
| 8 | 3 | 28µs | 9µs | use constant END_OF_FIELD => "\x1E"; # spent 41µs making 1 call to constant::import |
| 9 | ||||
| 10 | 3 | 2.02ms | 674µs | use vars qw( $ERROR ); # spent 25µs making 1 call to vars::import |
| 11 | ||||
| 12 | =head1 NAME | |||
| 13 | ||||
| 14 | MARC::Field - Perl extension for handling MARC fields | |||
| 15 | ||||
| 16 | =head1 SYNOPSIS | |||
| 17 | ||||
| 18 | use MARC::Field; | |||
| 19 | ||||
| 20 | my $field = MARC::Field->new( 245, '1', '0', | |||
| 21 | 'a' => 'Raccoons and ripe corn / ', | |||
| 22 | 'c' => 'Jim Arnosky.' | |||
| 23 | ); | |||
| 24 | $field->add_subfields( "a", "1st ed." ); | |||
| 25 | ||||
| 26 | =head1 DESCRIPTION | |||
| 27 | ||||
| 28 | Defines MARC fields for use in the MARC::Record module. I suppose | |||
| 29 | you could use them on their own, but that wouldn't be very interesting. | |||
| 30 | ||||
| 31 | =head1 EXPORT | |||
| 32 | ||||
| 33 | None by default. Any errors are stored in C<$MARC::Field::ERROR>, which | |||
| 34 | C<$MARC::Record> usually bubbles up to C<$MARC::Record::ERROR>. | |||
| 35 | ||||
| 36 | =head1 METHODS | |||
| 37 | ||||
| 38 | =head2 new() | |||
| 39 | ||||
| 40 | The constructor, which will return a MARC::Field object. Typically you will | |||
| 41 | pass in the tag number, indicator 1, indicator 2, and then a list of any | |||
| 42 | subfield/data pairs. For example: | |||
| 43 | ||||
| 44 | my $field = MARC::Field->new( | |||
| 45 | 245, '1', '0', | |||
| 46 | 'a' => 'Raccoons and ripe corn / ', | |||
| 47 | 'c' => 'Jim Arnosky.' | |||
| 48 | ); | |||
| 49 | ||||
| 50 | Or if you want to add a field < 010 that does not have indicators. | |||
| 51 | ||||
| 52 | my $field = MARC::Field->new( '001', ' 14919759' ); | |||
| 53 | ||||
| 54 | =cut | |||
| 55 | ||||
| 56 | sub new { | |||
| 57 | 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; | |||
| 64 | ($tagno =~ /^[0-9A-Za-z]{3}$/) | |||
| 65 | or croak( "Tag \"$tagno\" is not a valid tag." ); | |||
| 66 | my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10)); | |||
| 67 | ||||
| 68 | my $self = bless { | |||
| 69 | _tag => $tagno, | |||
| 70 | _warnings => [], | |||
| 71 | _is_control_field => $is_control, | |||
| 72 | }, $class; | |||
| 73 | ||||
| 74 | if ( $is_control ) { | |||
| 75 | $self->{_data} = shift; | |||
| 76 | } else { | |||
| 77 | for my $indcode ( qw( _ind1 _ind2 ) ) { | |||
| 78 | my $indicator = shift; | |||
| 79 | if ( $indicator !~ /^[0-9A-Za-z ]$/ ) { | |||
| 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 | ||||
| 99 | Returns the three digit tag for the field. | |||
| 100 | ||||
| 101 | =cut | |||
| 102 | ||||
| 103 | sub tag { | |||
| 104 | my $self = shift; | |||
| 105 | return $self->{_tag}; | |||
| 106 | } | |||
| 107 | ||||
| 108 | =head2 indicator(indno) | |||
| 109 | ||||
| 110 | Returns the specified indicator. Returns C<undef> and sets | |||
| 111 | C<$MARC::Field::ERROR> if the I<indno> is not 1 or 2, or if | |||
| 112 | the tag doesn't have indicators. | |||
| 113 | ||||
| 114 | =cut | |||
| 115 | ||||
| 116 | sub indicator($) { | |||
| 117 | my $self = shift; | |||
| 118 | my $indno = shift; | |||
| 119 | ||||
| 120 | $self->_warn( "Fields below 010 do not have indicators" ) | |||
| 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 | ||||
| 134 | Tells whether this field is one of the control tags from 001-009. | |||
| 135 | ||||
| 136 | =cut | |||
| 137 | ||||
| 138 | sub is_control_field { | |||
| 139 | my $self = shift; | |||
| 140 | return $self->{_is_control_field}; | |||
| 141 | } | |||
| 142 | ||||
| 143 | =head2 subfield(code) | |||
| 144 | ||||
| 145 | When called in a scalar context returns the text from the first subfield | |||
| 146 | matching the subfield code. | |||
| 147 | ||||
| 148 | my $subfield = $field->subfield( 'a' ); | |||
| 149 | ||||
| 150 | Or if you think there might be more than one you can get all of them by | |||
| 151 | calling in a list context: | |||
| 152 | ||||
| 153 | my @subfields = $field->subfield( 'a' ); | |||
| 154 | ||||
| 155 | If no matching subfields are found, C<undef> is returned in a scalar context | |||
| 156 | and an empty list in a list context. | |||
| 157 | ||||
| 158 | If the tag is less than an 010, C<undef> is returned and | |||
| 159 | C<$MARC::Field::ERROR> is set. | |||
| 160 | ||||
| 161 | =cut | |||
| 162 | ||||
| 163 | sub 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 | ||||
| 185 | Returns all the subfields in the field. What's returned is a list of | |||
| 186 | list refs, where the inner list is a subfield code and the subfield data. | |||
| 187 | ||||
| 188 | For example, this might be the subfields from a 245 field: | |||
| 189 | ||||
| 190 | ( | |||
| 191 | [ 'a', 'Perl in a nutshell :' ], | |||
| 192 | [ 'b', 'A desktop quick reference.' ], | |||
| 193 | ) | |||
| 194 | ||||
| 195 | =cut | |||
| 196 | ||||
| 197 | sub 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 | ||||
| 213 | Returns the data part of the field, if the tag number is less than 10. | |||
| 214 | ||||
| 215 | =cut | |||
| 216 | ||||
| 217 | sub data { | |||
| 218 | my $self = shift; | |||
| 219 | ||||
| 220 | croak( "data() is only for tags less than 010, use subfield()" ) | |||
| 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 | ||||
| 230 | Adds subfields to the end of the subfield list. | |||
| 231 | ||||
| 232 | $field->add_subfields( 'c' => '1985' ); | |||
| 233 | ||||
| 234 | Returns the number of subfields added, or C<undef> if there was an error. | |||
| 235 | ||||
| 236 | =cut | |||
| 237 | ||||
| 238 | sub 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 | ||||
| 250 | delete_subfield() allows you to remove subfields from a field: | |||
| 251 | ||||
| 252 | # delete any subfield a in the field | |||
| 253 | $field->delete_subfield(code => 'a'); | |||
| 254 | ||||
| 255 | # delete any subfield a or u in the field | |||
| 256 | $field->delete_subfield(code => ['a', 'u']); | |||
| 257 | ||||
| 258 | If you want to only delete subfields at a particular position you can | |||
| 259 | use the pos parameter: | |||
| 260 | ||||
| 261 | # delete subfield u at the first position | |||
| 262 | $field->delete_subfield(code => 'u', pos => 0); | |||
| 263 | ||||
| 264 | # delete subfield u at first or second position | |||
| 265 | $field->delete_subfield(code => 'u', pos => [0,1]); | |||
| 266 | ||||
| 267 | You can specify a regex to for only deleting subfields that match: | |||
| 268 | ||||
| 269 | # delete any subfield u that matches zombo.com | |||
| 270 | $field->delete_subfield(code => 'u', match => qr/zombo.com/); | |||
| 271 | ||||
| 272 | =cut | |||
| 273 | ||||
| 274 | sub 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 | ||||
| 306 | Delete all subfields with a given subfield code. This is here for backwards | |||
| 307 | compatability, you should use the more flexible delete_subfield(). | |||
| 308 | ||||
| 309 | =cut | |||
| 310 | ||||
| 311 | sub delete_subfields { | |||
| 312 | my ($self, $code) = @_; | |||
| 313 | return $self->delete_subfield(code => $code); | |||
| 314 | } | |||
| 315 | ||||
| 316 | =head2 update() | |||
| 317 | ||||
| 318 | Allows you to change the values of the field. You can update indicators | |||
| 319 | and subfields like this: | |||
| 320 | ||||
| 321 | $field->update( ind2 => '4', a => 'The ballad of Abe Lincoln'); | |||
| 322 | ||||
| 323 | If you attempt to update a subfield which does not currently exist in the field, | |||
| 324 | then a new subfield will be appended to the field. If you don't like this | |||
| 325 | auto-vivification you must check for the existence of the subfield prior to | |||
| 326 | update. | |||
| 327 | ||||
| 328 | if ( $field->subfield( 'a' ) ) { | |||
| 329 | $field->update( 'a' => 'Cryptonomicon' ); | |||
| 330 | } | |||
| 331 | ||||
| 332 | If you want to update a field that has no indicators or subfields (000-009) | |||
| 333 | just call update() with one argument, the string that you would like to | |||
| 334 | set the field to. | |||
| 335 | ||||
| 336 | $field = $record->field( '003' ); | |||
| 337 | $field->update('IMchF'); | |||
| 338 | ||||
| 339 | Note: when doing subfield updates be aware that C<update()> will only | |||
| 340 | update the first occurrence. If you need to do anything more complicated | |||
| 341 | you will probably need to create a new field and use C<replace_with()>. | |||
| 342 | ||||
| 343 | Returns the number of items modified. | |||
| 344 | ||||
| 345 | =cut | |||
| 346 | ||||
| 347 | sub 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 | ||||
| 401 | Allows you to replace an existing field with a new one. You need to pass | |||
| 402 | C<replace()> a MARC::Field object to replace the existing field with. For | |||
| 403 | example: | |||
| 404 | ||||
| 405 | $field = $record->field('245'); | |||
| 406 | my $new_field = new MARC::Field('245','0','4','The ballad of Abe Lincoln.'); | |||
| 407 | $field->replace_with($new_field); | |||
| 408 | ||||
| 409 | Doesn't return a meaningful or reliable value. | |||
| 410 | ||||
| 411 | =cut | |||
| 412 | ||||
| 413 | sub 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 | ||||
| 426 | Returns a string of all subfields run together. A space is added to | |||
| 427 | the result between each subfield. The tag number and subfield | |||
| 428 | character are not included. | |||
| 429 | ||||
| 430 | Subfields appear in the output string in the order in which they | |||
| 431 | occur in the field. | |||
| 432 | ||||
| 433 | If C<$subfields> is specified, then only those subfields will be included. | |||
| 434 | ||||
| 435 | my $field = MARC::Field->new( | |||
| 436 | 245, '1', '0', | |||
| 437 | 'a' => 'Abraham Lincoln', | |||
| 438 | 'h' => '[videorecording] :', | |||
| 439 | 'b' => 'preserving the union /', | |||
| 440 | 'c' => 'A&E Home Video.' | |||
| 441 | ); | |||
| 442 | print $field->as_string( 'abh' ); # Only those three subfields | |||
| 443 | # prints 'Abraham Lincoln [videorecording] : preserving the union /'. | |||
| 444 | ||||
| 445 | Note that subfield h comes before subfield b in the output. | |||
| 446 | ||||
| 447 | =cut | |||
| 448 | ||||
| 449 | sub 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 | ||||
| 474 | Returns a pretty string for printing in a MARC dump. | |||
| 475 | ||||
| 476 | =cut | |||
| 477 | ||||
| 478 | sub 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 | ||||
| 503 | Returns a string for putting into a USMARC file. It's really only | |||
| 504 | useful by C<MARC::Record::as_usmarc()>. | |||
| 505 | ||||
| 506 | =cut | |||
| 507 | ||||
| 508 | sub as_usmarc() { | |||
| 509 | my $self = shift; | |||
| 510 | ||||
| 511 | # Tags < 010 are pretty easy | |||
| 512 | if ( $self->is_control_field ) { | |||
| 513 | return $self->data . END_OF_FIELD; | |||
| 514 | } else { | |||
| 515 | my @subs; | |||
| 516 | my @subdata = @{$self->{_subfields}}; | |||
| 517 | while ( @subdata ) { | |||
| 518 | push( @subs, join( "", SUBFIELD_INDICATOR, shift @subdata, shift @subdata ) ); | |||
| 519 | } # while | |||
| 520 | ||||
| 521 | return | |||
| 522 | join( "", | |||
| 523 | $self->indicator(1), | |||
| 524 | $self->indicator(2), | |||
| 525 | @subs, | |||
| 526 | END_OF_FIELD, ); | |||
| 527 | } | |||
| 528 | } | |||
| 529 | ||||
| 530 | =head2 clone() | |||
| 531 | ||||
| 532 | Makes a copy of the field. Note that this is not just the same as saying | |||
| 533 | ||||
| 534 | my $newfield = $field; | |||
| 535 | ||||
| 536 | since that just makes a copy of the reference. To get a new object, you must | |||
| 537 | ||||
| 538 | my $newfield = $field->clone; | |||
| 539 | ||||
| 540 | Returns a MARC::Field record. | |||
| 541 | ||||
| 542 | =cut | |||
| 543 | ||||
| 544 | sub 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 | ||||
| 570 | Returns the warnings that were created when the record was read. | |||
| 571 | These are things like "Invalid indicators converted to blanks". | |||
| 572 | ||||
| 573 | The warnings are items that you might be interested in, or might | |||
| 574 | not. It depends on how stringently you're checking data. If | |||
| 575 | you're doing some grunt data analysis, you probably don't care. | |||
| 576 | ||||
| 577 | =cut | |||
| 578 | ||||
| 579 | sub warnings() { | |||
| 580 | my $self = shift; | |||
| 581 | ||||
| 582 | return @{$self->{_warnings}}; | |||
| 583 | } | |||
| 584 | ||||
| 585 | # NOTE: _warn is an object method | |||
| 586 | sub _warn($) { | |||
| 587 | my $self = shift; | |||
| 588 | ||||
| 589 | push( @{$self->{_warnings}}, join( "", @_ ) ); | |||
| 590 | } | |||
| 591 | ||||
| 592 | sub _gripe(@) { | |||
| 593 | $ERROR = join( "", @_ ); | |||
| 594 | ||||
| 595 | warn $ERROR; | |||
| 596 | ||||
| 597 | return; | |||
| 598 | } | |||
| 599 | ||||
| 600 | sub _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 | ||||
| 608 | 1 | 3µs | 3µs | 1; |
| 609 | ||||
| 610 | __END__ | |||
| 611 | ||||
| 612 | =head1 SEE ALSO | |||
| 613 | ||||
| 614 | See the "SEE ALSO" section for L<MARC::Record>. | |||
| 615 | ||||
| 616 | =head1 TODO | |||
| 617 | ||||
| 618 | See the "TODO" section for L<MARC::Record>. | |||
| 619 | ||||
| 620 | =cut | |||
| 621 | ||||
| 622 | =head1 LICENSE | |||
| 623 | ||||
| 624 | This code may be distributed under the same terms as Perl itself. | |||
| 625 | ||||
| 626 | Please note that these modules are not products of or supported by the | |||
| 627 | employers of the various contributors to the code. | |||
| 628 | ||||
| 629 | =head1 AUTHOR | |||
| 630 | ||||
| 631 | Andy Lester, C<< <andy@petdance.com> >> | |||
| 632 | ||||
| 633 | =cut |