Skip Menu |
 

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

Report information
The Basics
Id: 27581
Status: new
Priority: 0/
Queue: MARC-Record

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

Bug Information
Severity: Critical
Broken in: (no value)
Fixed in: (no value)



Subject: Suggestion: Handling Errors
Download (untitled) / with headers
text/plain 464b
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
Download Field.pm
text/x-perl 14.7k

Message body is not shown because it is too large.

Subject: Field.pm.diff
Download Field.pm.diff
text/x-diff 4k
--- 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 is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

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