[libcatmandu-mab2-perl] 16/35: warn and skip faulty fields
Jonas Smedegaard
dr at jones.dk
Fri Oct 27 17:54:41 UTC 2017
This is an automated email from the git hooks/post-receive script.
js pushed a commit to annotated tag debian/0.21-1
in repository libcatmandu-mab2-perl.
commit 0d7fec67ef3fb3191afac5b2109598e698d8104f
Author: Johann Rolschewski <jorol at cpan.org>
Date: Thu Oct 12 13:15:39 2017 +0200
warn and skip faulty fields
---
lib/MAB2/Parser/Disk.pm | 71 ++++++++++++++++++++++++-------------------------
lib/MAB2/Parser/RAW.pm | 57 ++++++++++++++++++++++-----------------
2 files changed, 68 insertions(+), 60 deletions(-)
diff --git a/lib/MAB2/Parser/Disk.pm b/lib/MAB2/Parser/Disk.pm
index cfde790..3caddef 100644
--- a/lib/MAB2/Parser/Disk.pm
+++ b/lib/MAB2/Parser/Disk.pm
@@ -5,14 +5,13 @@ our $VERSION = '0.20';
use strict;
use warnings;
use charnames qw< :full >;
-use Carp qw(croak);
+use Carp qw(carp croak);
use Readonly;
Readonly my $SUBFIELD_INDICATOR => qq{\N{INFORMATION SEPARATOR ONE}};
Readonly my $END_OF_FIELD => qq{\N{LINE FEED}};
Readonly my $END_OF_RECORD => q{};
-
sub new {
my $class = shift;
my $file = shift;
@@ -40,7 +39,6 @@ sub new {
return ( bless $self, $class );
}
-
sub next {
my $self = shift;
local $/ = $END_OF_RECORD;
@@ -55,57 +53,58 @@ sub next {
return;
}
-
sub _decode {
my $reader = shift;
chomp($reader);
my @record;
- my @fields = split($END_OF_FIELD, $reader);
+ my @fields = split( $END_OF_FIELD, $reader );
my $leader = shift @fields;
- if( $leader =~ m/^\N{NUMBER SIGN}{3}\s(\d{5}[cdnpu]M2.0\d{7}\s{6}\w)/xms ){
+ if ($leader =~ m/^\N{NUMBER SIGN}{3}\s(\d{5}[cdnpu]M2.0\d{7}\s{6}\w)/xms )
+ {
push( @record, [ 'LDR', '', '_', $1 ] );
}
- else{
- croak "record leader not valid: $leader";
+ else {
+ carp "faulty record leader: $leader";
}
- # ToDo: skip faulty fields
foreach my $field (@fields) {
- croak "incomplete field: \"$field\"" if length($field) <= 4;
- my $tag = substr( $field, 0, 3 );
- my $ind = substr( $field, 3, 1 );
- my $data = substr( $field, 4 );
-
- # check for a 3-digit numeric tag
- ( $tag =~ m/^[0-9]{3}$/xms ) or croak "Invalid tag: \"$tag\"";
-
- # check if indicator is an single alphabetic character
- ( $ind =~ m/^[a-z\s]$/xms ) or croak "Invalid indicator: \"$ind\"";
-
- # check if data contains subfield indicators
- if ( $data =~ m/^\s*($SUBFIELD_INDICATOR|\$)(.*)/ ) {
- my $subfield_indicator = $1;
- my @subfields = split( $subfield_indicator, $2 );
- ( @subfields ) or croak "no subfield data found: \"$tag$ind$data\"";
- push(
- @record,
- [ $tag,
+
+ if ( length $field <= 4 ) {
+ carp "faulty field: \"$field\"";
+ next;
+ }
+
+ if ( my ( $tag, $ind, $data )
+ = $field =~ m/(\d{3})([A-Za-z0-9\s])(.*)/ )
+ {
+ # check if data contains subfield indicators
+ if ( $data =~ m/\s*($SUBFIELD_INDICATOR|\$)(.*)/ ) {
+ my $subfield_indicator = $1;
+ push
+ @record,
+ [
+ $tag,
$ind,
- map { substr( $_, 0, 1 ), substr( $_, 1 ) } @subfields
- ]
- );
+ map { ( substr( $_, 0, 1 ), substr( $_, 1 ) ) }
+ split /$subfield_indicator/,
+ $1
+ ];
+ }
+ else {
+ push @record, [ $tag, $ind, '_', $data ];
+ }
}
else {
- push( @record, [ $tag, $ind, '_', $data ] );
+ carp "faulty field structure: \"$field\"";
+ next;
}
}
- return \@record;
+ return \@record;
}
-
1; # End of MAB2::Parser::Disk
__END__
@@ -122,8 +121,8 @@ MAB2::Parser::Disk - MAB2 Diskette format parser
L<MAB2::Parser::Disk> is a parser for MAB2 Diskette records.
-L<MAB2::Parser::Disk> expects UTF-8 encoded files as input. Otherwise provide a
-filehande with a specified I/O layer.
+L<MAB2::Parser::Disk> expects UTF-8 encoded files as input. Otherwise
+provide a filehande with a specified I/O layer.
use MAB2::Parser::Disk;
diff --git a/lib/MAB2/Parser/RAW.pm b/lib/MAB2/Parser/RAW.pm
index 83d70fd..7f628e0 100644
--- a/lib/MAB2/Parser/RAW.pm
+++ b/lib/MAB2/Parser/RAW.pm
@@ -5,7 +5,7 @@ our $VERSION = '0.20';
use strict;
use warnings;
use charnames qw< :full >;
-use Carp qw(croak);
+use Carp qw(carp croak);
use Readonly;
Readonly my $LEADER_LEN => 24;
@@ -13,7 +13,6 @@ Readonly my $SUBFIELD_INDICATOR => qq{\N{INFORMATION SEPARATOR ONE}};
Readonly my $END_OF_FIELD => qq{\N{INFORMATION SEPARATOR TWO}};
Readonly my $END_OF_RECORD => qq{\N{INFORMATION SEPARATOR THREE}};
-
sub new {
my $class = shift;
my $file = shift;
@@ -41,7 +40,6 @@ sub new {
return ( bless $self, $class );
}
-
sub next {
my $self = shift;
if ( my $line = $self->{reader}->getline() ) {
@@ -55,49 +53,60 @@ sub next {
return;
}
-
sub _decode {
my $reader = shift;
- chomp($reader);
+ chomp $reader;
if ( substr( $reader, -1, 1 ) ne $END_OF_RECORD ) {
- croak("record terminator not found.");
+ carp "record terminator not found";
}
my @record;
- if ( substr( $reader, 0, $LEADER_LEN ) =~ m/(\d{5}\wM2.0\d*\s*\w)/ ) {
- push( @record, [ 'LDR', '', '_', $1 ] );
+ my $leader = substr $reader, 0, $LEADER_LEN;
+ if ( $leader =~ m/(\d{5}\wM2.0\d*\s*\w)/ ) {
+ push @record, [ 'LDR', '', '_', $leader ];
}
else {
- croak("no valid record leader found.");
+ carp "faulty record leader: \"$leader\"";
}
- my @fields = split( $END_OF_FIELD, substr( $reader, $LEADER_LEN, -1 ) );
+ my @fields = split $END_OF_FIELD, substr( $reader, $LEADER_LEN, -1 );
for my $field (@fields) {
- my ( $tag, $ind, $data ) = $field =~ m/(\d{3})([A-Za-z0-9\s])(.*)/
- or croak("no valid field structure found.");
-
- if ( $data =~ m/\s*$SUBFIELD_INDICATOR(.*)/ ) {
- push(
- @record,
- [ $tag,
- $ind,
- map { ( substr( $_, 0, 1 ), substr( $_, 1 ) ) }
- split( /$SUBFIELD_INDICATOR/, $1 )
- ]
- );
+ if ( length $field <= 4 ) {
+ carp "faulty field: \"$field\"";
+ next;
+ }
+
+ if ( my ( $tag, $ind, $data )
+ = $field =~ m/(\d{3})([A-Za-z0-9\s])(.*)/ )
+ {
+ if ( $data =~ m/\s*$SUBFIELD_INDICATOR(.*)/ ) {
+ push(
+ @record,
+ [ $tag,
+ $ind,
+ map { ( substr( $_, 0, 1 ), substr( $_, 1 ) ) }
+ split /$SUBFIELD_INDICATOR/,
+ $1
+ ]
+ );
+ }
+ else {
+ push @record, [ $tag, $ind, '_', $data ];
+ }
}
else {
- push( @record, [ $tag, $ind, '_', $data ] );
+ carp "faulty field structure: \"$field\"";
+ next;
}
+
}
return \@record;
}
-
1; # End of MAB2::Parser::RAW
__END__
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-mab2-perl.git
More information about the Pkg-perl-cvs-commits
mailing list