This queue is for tickets about the MARC-Record CPAN distribution.

Report information
The Basics
Id:
27581
Status:
new
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
thienho [...] gmail.com
Cc:
AdminCc:

BugTracker
Severity:
Critical
Broken in:
(no value)
Fixed in:
(no value)



Subject: Suggestion: Handling Errors
Good morning, I have a collection of MARC records with one bad record (tag value has only one character '0'). When MARC::Record reads this record, it exits right away, and will not read successive records. So I wonder if you can just print a warning and adjust the erroneous tag/indicator/code to something else. Attached are the original Field.pm and my patch. Distribution name and version MARC::Record-2.0.0 Perl version: 5.8.8 OS: CentOS 5 Thank you, Thien
Subject: Field.pm
package MARC::Field; use strict; use integer; use Carp; use constant SUBFIELD_INDICATOR => "\x1F"; use constant END_OF_FIELD => "\x1E"; use vars qw( $ERROR ); =head1 NAME MARC::Field - Perl extension for handling MARC fields =head1 SYNOPSIS use MARC::Field; my $field = MARC::Field->new( 245, '1', '0', 'a' => 'Raccoons and ripe corn / ', 'c' => 'Jim Arnosky.' ); $field->add_subfields( "a", "1st ed." ); =head1 DESCRIPTION Defines MARC fields for use in the MARC::Record module. I suppose you could use them on their own, but that wouldn't be very interesting. =head1 EXPORT None by default. Any errors are stored in C<$MARC::Field::ERROR>, which C<$MARC::Record> usually bubbles up to C<$MARC::Record::ERROR>. =head1 METHODS =head2 new() The constructor, which will return a MARC::Field object. Typically you will pass in the tag number, indicator 1, indicator 2, and then a list of any subfield/data pairs. For example: my $field = MARC::Field->new( 245, '1', '0', 'a' => 'Raccoons and ripe corn / ', 'c' => 'Jim Arnosky.' ); Or if you want to add a field < 010 that does not have indicators. my $field = MARC::Field->new( '001', ' 14919759' ); =cut sub new { my $class = shift; $class = $class; ## MARC spec indicates that tags can have alphabetical ## characters in them! If they do appear we assume that ## they have indicators like tags > 010 my $tagno = shift; ($tagno =~ /^[0-9A-Za-z]{3}$/) or croak( "Tag \"$tagno\" is not a valid tag." ); my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10)); my $self = bless { _tag => $tagno, _warnings => [], _is_control_field => $is_control, }, $class; if ( $is_control ) { $self->{_data} = shift; } else { for my $indcode ( qw( _ind1 _ind2 ) ) { my $indicator = shift; if ( $indicator !~ /^[0-9A-Za-z ]$/ ) { $self->_warn( "Invalid indicator \"$indicator\" forced to blank" ) unless ($indicator eq ""); $indicator = " "; } $self->{$indcode} = $indicator; } # for (@_ >= 2) or croak( "Field $tagno must have at least one subfield" ); # Normally, we go thru add_subfields(), but internally we can cheat $self->{_subfields} = [@_]; } return $self; } # new() =head2 tag() Returns the three digit tag for the field. =cut sub tag { my $self = shift; return $self->{_tag}; } =head2 indicator(indno) Returns the specified indicator. Returns C<undef> and sets C<$MARC::Field::ERROR> if the I<indno> is not 1 or 2, or if the tag doesn't have indicators. =cut sub indicator($) { my $self = shift; my $indno = shift; $self->_warn( "Fields below 010 do not have indicators" ) if $self->is_control_field; if ( $indno == 1 ) { return $self->{_ind1}; } elsif ( $indno == 2 ) { return $self->{_ind2}; } else { croak( "Indicator number must be 1 or 2" ); } } =head2 is_control_field() Tells whether this field is one of the control tags from 001-009. =cut sub is_control_field { my $self = shift; return $self->{_is_control_field}; } =head2 subfield(code) When called in a scalar context returns the text from the first subfield matching the subfield code. my $subfield = $field->subfield( 'a' ); Or if you think there might be more than one you can get all of them by calling in a list context: my @subfields = $field->subfield( 'a' ); If no matching subfields are found, C<undef> is returned in a scalar context and an empty list in a list context. If the tag is less than an 010, C<undef> is returned and C<$MARC::Field::ERROR> is set. =cut sub subfield { my $self = shift; my $code_wanted = shift; croak( "Fields below 010 do not have subfields, use data()" ) if $self->is_control_field; my @data = @{$self->{_subfields}}; my @found; while ( defined( my $code = shift @data ) ) { if ( $code eq $code_wanted ) { push( @found, shift @data ); } else { shift @data; } } if ( wantarray() ) { return @found; } return( $found[0] ); } =head2 subfields() Returns all the subfields in the field. What's returned is a list of list refs, where the inner list is a subfield code and the subfield data. For example, this might be the subfields from a 245 field: ( [ 'a', 'Perl in a nutshell :' ], [ 'b', 'A desktop quick reference.' ], ) =cut sub subfields { my $self = shift; $self->_warn( "Fields below 010 do not have subfields" ) if $self->is_control_field; my @list; my @data = @{$self->{_subfields}}; while ( defined( my $code = shift @data ) ) { push( @list, [$code, shift @data] ); } return @list; } =head2 data() Returns the data part of the field, if the tag number is less than 10. =cut sub data { my $self = shift; croak( "data() is only for tags less than 010, use subfield()" ) unless $self->is_control_field; $self->{_data} = $_[0] if @_; return $self->{_data}; } =head2 add_subfields(code,text[,code,text ...]) Adds subfields to the end of the subfield list. $field->add_subfields( 'c' => '1985' ); Returns the number of subfields added, or C<undef> if there was an error. =cut sub add_subfields { my $self = shift; croak( "Subfields are only for tags >= 10" ) if $self->is_control_field; push( @{$self->{_subfields}}, @_ ); return @_/2; } =head2 delete_subfield() delete_subfield() allows you to remove subfields from a field: # delete any subfield a in the field $field->delete_subfield(code => 'a'); # delete any subfield a or u in the field $field->delete_subfield(code => ['a', 'u']); If you want to only delete subfields at a particular position you can use the pos parameter: # delete subfield u at the first position $field->delete_subfield(code => 'u', pos => 0); # delete subfield u at first or second position $field->delete_subfield(code => 'u', pos => [0,1]); You can specify a regex to for only deleting subfields that match: # delete any subfield u that matches zombo.com $field->delete_subfield(code => 'u', match => qr/zombo.com/); =cut sub delete_subfield { my ($self, %options) = @_; my $codes = _normalize_arrayref($options{code}); my $positions = _normalize_arrayref($options{'pos'}); my $match = $options{match}; croak 'match must be a compiled regex' if $match and ref($match) ne 'Regexp'; my @current_subfields = @{$self->{_subfields}}; my @new_subfields = (); my $removed = 0; my $subfield_num = $[ - 1; # users $[ preferences control indexing while (@current_subfields > 0) { $subfield_num += 1; my $subfield_code = shift @current_subfields; my $subfield_value = shift @current_subfields; if ((@$codes==0 or grep {$_ eq $subfield_code} @$codes) and (!$match or $subfield_value =~ $match) and (@$positions==0 or grep {$_ == $subfield_num} @$positions)) { $removed += 1; next; } push( @new_subfields, $subfield_code, $subfield_value); } $self->{_subfields} = \@new_subfields; return $removed; } =head2 delete_subfields() Delete all subfields with a given subfield code. This is here for backwards compatability, you should use the more flexible delete_subfield(). =cut sub delete_subfields { my ($self, $code) = @_; return $self->delete_subfield(code => $code); } =head2 update() Allows you to change the values of the field. You can update indicators and subfields like this: $field->update( ind2 => '4', a => 'The ballad of Abe Lincoln'); If you attempt to update a subfield which does not currently exist in the field, then a new subfield will be appended to the field. If you don't like this auto-vivification you must check for the existence of the subfield prior to update. if ( $field->subfield( 'a' ) ) { $field->update( 'a' => 'Cryptonomicon' ); } If you want to update a field that has no indicators or subfields (000-009) just call update() with one argument, the string that you would like to set the field to. $field = $record->field( '003' ); $field->update('IMchF'); Note: when doing subfield updates be aware that C<update()> will only update the first occurrence. If you need to do anything more complicated you will probably need to create a new field and use C<replace_with()>. Returns the number of items modified. =cut sub update { my $self = shift; ## tags 000 - 009 don't have indicators or subfields if ( $self->is_control_field ) { $self->{_data} = shift; return(1); } ## otherwise we need to update subfields and indicators my @data = @{$self->{_subfields}}; my $changes = 0; while ( @_ ) { my $arg = shift; my $val = shift; ## indicator update if ($arg =~ /^ind[12]$/) { $self->{"_$arg"} = $val; $changes++; } ## subfield update else { my $found = 0; ## update existing subfield for ( my $i=0; $i<@data; $i+=2 ) { if ($data[$i] eq $arg) { $data[$i+1] = $val; $found = 1; $changes++; last; } } # for ## append new subfield if ( !$found ) { push( @data, $arg, $val ); $changes++; } } } # while ## synchronize our subfields $self->{_subfields} = \@data; return($changes); } =head2 replace_with() Allows you to replace an existing field with a new one. You need to pass C<replace()> a MARC::Field object to replace the existing field with. For example: $field = $record->field('245'); my $new_field = new MARC::Field('245','0','4','The ballad of Abe Lincoln.'); $field->replace_with($new_field); Doesn't return a meaningful or reliable value. =cut sub replace_with { my ($self,$new) = @_; ref($new) =~ /^MARC::Field$/ or croak("Must pass a MARC::Field object"); %$self = %$new; } =head2 as_string( [$subfields] ) Returns a string of all subfields run together. A space is added to the result between each subfield. The tag number and subfield character are not included. Subfields appear in the output string in the order in which they occur in the field. If C<$subfields> is specified, then only those subfields will be included. my $field = MARC::Field->new( 245, '1', '0', 'a' => 'Abraham Lincoln', 'h' => '[videorecording] :', 'b' => 'preserving the union /', 'c' => 'A&E Home Video.' ); print $field->as_string( 'abh' ); # Only those three subfields # prints 'Abraham Lincoln [videorecording] : preserving the union /'. Note that subfield h comes before subfield b in the output. =cut sub as_string() { my $self = shift; my $subfields = shift; if ( $self->is_control_field ) { return $self->{_data}; } my @subs; my $subs = $self->{_subfields}; my $nfields = @$subs / 2; for my $i ( 1..$nfields ) { my $offset = ($i-1)*2; my $code = $subs->[$offset]; my $text = $subs->[$offset+1]; push( @subs, $text ) if !$subfields || $code =~ /^[$subfields]$/; } # for return join( " ", @subs ); } =head2 as_formatted() Returns a pretty string for printing in a MARC dump. =cut sub as_formatted() { my $self = shift; my @lines; if ( $self->is_control_field ) { push( @lines, sprintf( "%03s %s", $self->{_tag}, $self->{_data} ) ); } else { my $hanger = sprintf( "%03s %1.1s%1.1s", $self->{_tag}, $self->{_ind1}, $self->{_ind2} ); my $subs = $self->{_subfields}; my $nfields = @$subs / 2; my $offset = 0; for my $i ( 1..$nfields ) { push( @lines, sprintf( "%-6.6s _%1.1s%s", $hanger, $subs->[$offset++], $subs->[$offset++] ) ); $hanger = ""; } # for } return join( "\n", @lines ); } =head2 as_usmarc() Returns a string for putting into a USMARC file. It's really only useful by C<MARC::Record::as_usmarc()>. =cut sub as_usmarc() { my $self = shift; # Tags < 010 are pretty easy if ( $self->is_control_field ) { return $self->data . END_OF_FIELD; } else { my @subs; my @subdata = @{$self->{_subfields}}; while ( @subdata ) { push( @subs, join( "", SUBFIELD_INDICATOR, shift @subdata, shift @subdata ) ); } # while return join( "", $self->indicator(1), $self->indicator(2), @subs, END_OF_FIELD, ); } } =head2 clone() Makes a copy of the field. Note that this is not just the same as saying my $newfield = $field; since that just makes a copy of the reference. To get a new object, you must my $newfield = $field->clone; Returns a MARC::Field record. =cut sub clone { my $self = shift; my $tagno = $self->{_tag}; my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10)); my $clone = bless { _tag => $tagno, _warnings => [], _is_control_field => $is_control, }, ref($self); if ( $is_control ) { $clone->{_data} = $self->{_data}; } else { $clone->{_ind1} = $self->{_ind1}; $clone->{_ind2} = $self->{_ind2}; $clone->{_subfields} = [@{$self->{_subfields}}]; } return $clone; } =head2 warnings() Returns the warnings that were created when the record was read. These are things like "Invalid indicators converted to blanks". The warnings are items that you might be interested in, or might not. It depends on how stringently you're checking data. If you're doing some grunt data analysis, you probably don't care. =cut sub warnings() { my $self = shift; return @{$self->{_warnings}}; } # NOTE: _warn is an object method sub _warn($) { my $self = shift; push( @{$self->{_warnings}}, join( "", @_ ) ); } sub _gripe(@) { $ERROR = join( "", @_ ); warn $ERROR; return; } sub _normalize_arrayref { my $ref = shift; if (ref($ref) eq 'ARRAY') { return $ref } elsif (defined $ref) { return [$ref] } return []; } 1; __END__ =head1 SEE ALSO See the "SEE ALSO" section for L<MARC::Record>. =head1 TODO See the "TODO" section for L<MARC::Record>. =cut =head1 LICENSE This code may be distributed under the same terms as Perl itself. Please note that these modules are not products of or supported by the employers of the various contributors to the code. =head1 AUTHOR Andy Lester, C<< <andy@petdance.com> >> =cut
Subject: Field.pm.diff
--- Field.pm-orig 2007-06-14 10:22:34.000000000 -0400 +++ Field.pm 2007-06-14 10:23:27.000000000 -0400 @@ -57,13 +57,27 @@ my $class = shift; $class = $class; + my $is_control = (@_ == 2); ## MARC spec indicates that tags can have alphabetical ## characters in them! If they do appear we assume that ## they have indicators like tags > 010 my $tagno = shift; - ($tagno =~ /^[0-9A-Za-z]{3}$/) - or croak( "Tag \"$tagno\" is not a valid tag." ); - my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10)); + if ($tagno !~ /^[0-9A-Za-z]{3}$/) { + warn "Tag '$tagno' is not a valid tag."; + + $tagno = ($is_control) ? '000' : 'err'; + } + elsif ($is_control && $tagno >= 10) { + warn "Tag '$tagno' is not a valid control field tag."; + $tagno = '000'; + } + elsif (!$is_control && $tagno < 10) { + warn "Tag '$tagno' is not a valid data field tag."; + $tagno = 'err'; + } +# ($tagno =~ /^[0-9A-Za-z]{3}$/) +# or croak( "Tag \"$tagno\" is not a valid tag." ); +# my $is_control = (($tagno =~ /^\d+$/) && ($tagno < 10)); my $self = bless { _tag => $tagno, @@ -83,8 +97,8 @@ $self->{$indcode} = $indicator; } # for - (@_ >= 2) - or croak( "Field $tagno must have at least one subfield" ); +# (@_ >= 2) +# or croak( "Field $tagno must have at least one subfield" ); # Normally, we go thru add_subfields(), but internally we can cheat $self->{_subfields} = [@_]; @@ -125,7 +139,9 @@ } elsif ( $indno == 2 ) { return $self->{_ind2}; } else { - croak( "Indicator number must be 1 or 2" ); + warn "Indicator number must be 1 or 2\n"; + return; +# croak( "Indicator number must be 1 or 2" ); } } @@ -164,8 +180,13 @@ my $self = shift; my $code_wanted = shift; - croak( "Fields below 010 do not have subfields, use data()" ) - if $self->is_control_field; + if ($self->is_control_field) { + warn "Fields below 010 do not have subfields, use data()"; + return; + } + +# croak( "Fields below 010 do not have subfields, use data()" ) +# if $self->is_control_field; my @data = @{$self->{_subfields}}; my @found; @@ -217,8 +238,13 @@ sub data { my $self = shift; - croak( "data() is only for tags less than 010, use subfield()" ) - unless $self->is_control_field; + if (!$self->is_control_field) { + warn "data() is only for tags less than 010, use subfield()"; + return; + } + +# croak( "data() is only for tags less than 010, use subfield()" ) +# unless $self->is_control_field; $self->{_data} = $_[0] if @_; @@ -238,8 +264,13 @@ sub add_subfields { my $self = shift; - croak( "Subfields are only for tags >= 10" ) - if $self->is_control_field; + if ($self->is_control_field) { + warn "Subfields are only for tags >= 10"; + return; + } + +# croak( "Subfields are only for tags >= 10" ) +# if $self->is_control_field; push( @{$self->{_subfields}}, @_ ); return @_/2; @@ -276,9 +307,14 @@ my $codes = _normalize_arrayref($options{code}); my $positions = _normalize_arrayref($options{'pos'}); my $match = $options{match}; + + if ($match and ref($match) ne 'Regexp') { + warn 'match must be a compiled regex'; + return; + } - croak 'match must be a compiled regex' - if $match and ref($match) ne 'Regexp'; +# croak 'match must be a compiled regex' +# if $match and ref($match) ne 'Regexp'; my @current_subfields = @{$self->{_subfields}}; my @new_subfields = (); @@ -411,13 +447,17 @@ =cut sub replace_with { - my ($self,$new) = @_; - ref($new) =~ /^MARC::Field$/ - or croak("Must pass a MARC::Field object"); - %$self = %$new; + if (ref($new) ne 'MARC::Field') { + warn "Must pass a MARC::Field object"; + return; + } +# ref($new) =~ /^MARC::Field$/ +# or croak("Must pass a MARC::Field object"); + + %$self = %$new; }


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.