[libcatmandu-marc-perl] 18/208: atmandu::Importer::MARC cannot import from string reference, or IO::String #23

Jonas Smedegaard dr at jones.dk
Sat Oct 28 03:42:30 UTC 2017


This is an automated email from the git hooks/post-receive script.

js pushed a commit to annotated tag upstream/1.19
in repository libcatmandu-marc-perl.

commit 5ce1898b53457da2bcd8ea8c5c437e6be8e48bc1
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Thu Jun 23 16:35:45 2016 +0200

    atmandu::Importer::MARC cannot import from string reference, or IO::String #23
---
 lib/Catmandu/Importer/MARC/Decoder.pm   | 15 ++++++++++++++-
 lib/Catmandu/Importer/MARC/Lint.pm      |  2 ++
 lib/Catmandu/Importer/MARC/MARCMaker.pm |  2 ++
 lib/Catmandu/Importer/MARC/MiJ.pm       |  3 +++
 lib/Catmandu/Importer/MARC/MicroLIF.pm  |  2 ++
 lib/Catmandu/Importer/MARC/USMARC.pm    | 10 ++++++++++
 lib/Catmandu/Importer/MARC/XML.pm       |  4 ++++
 t/19-io-string.t                        | 25 +++++++++++++++++++++++++
 8 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/lib/Catmandu/Importer/MARC/Decoder.pm b/lib/Catmandu/Importer/MARC/Decoder.pm
index edb86a2..b126b41 100644
--- a/lib/Catmandu/Importer/MARC/Decoder.pm
+++ b/lib/Catmandu/Importer/MARC/Decoder.pm
@@ -5,6 +5,19 @@ use Moo;
 
 our $VERSION = '0.218';
 
+sub fake_marc_file {
+    my ($self,$fh,$class) = @_;
+
+    my $obj = {
+        filename    => scalar($fh),
+        fh          => $fh,
+        recnum      => 0,
+        warnings    => [],
+    };
+
+    return( bless $obj , $class );
+}
+
 sub decode {
     my ($self, $record, $id) = @_;
     return unless eval { $record->isa('MARC::Record') };
@@ -46,4 +59,4 @@ sub decode {
     return { _id => $sysid , record => \@result };
 }
 
-1;
\ No newline at end of file
+1;
diff --git a/lib/Catmandu/Importer/MARC/Lint.pm b/lib/Catmandu/Importer/MARC/Lint.pm
index b9df4a6..3c95a37 100644
--- a/lib/Catmandu/Importer/MARC/Lint.pm
+++ b/lib/Catmandu/Importer/MARC/Lint.pm
@@ -95,6 +95,8 @@ sub generator {
     my ($self) = @_;
     my $lint = MARC::Lint->new;
     my $file = MARC::File::USMARC->in($self->fh);
+    # MARC::File doesn't provide support for inline files
+    $file = $self->decoder->fake_marc_file($self->fh,'MARC::File::USMARC') unless $file;
     sub  {
        my $marc = $file->next();
        my $doc  = $self->decoder->decode($marc,$self->id);
diff --git a/lib/Catmandu/Importer/MARC/MARCMaker.pm b/lib/Catmandu/Importer/MARC/MARCMaker.pm
index 10a669f..b076390 100644
--- a/lib/Catmandu/Importer/MARC/MARCMaker.pm
+++ b/lib/Catmandu/Importer/MARC/MARCMaker.pm
@@ -85,6 +85,8 @@ has decoder   => (
 sub generator {
     my ($self) = @_;
     my $file = MARC::File::MARCMaker->in($self->fh);
+    # MARC::File doesn't provide support for inline files
+    $file = $self->decoder->fake_marc_file($self->fh,'MARC::File::MARCMaker') unless $file;
     sub  {
       $self->decoder->decode($file->next(),$self->id);
     }
diff --git a/lib/Catmandu/Importer/MARC/MiJ.pm b/lib/Catmandu/Importer/MARC/MiJ.pm
index 3e96f75..bbb6192 100644
--- a/lib/Catmandu/Importer/MARC/MiJ.pm
+++ b/lib/Catmandu/Importer/MARC/MiJ.pm
@@ -70,6 +70,9 @@ has decoder   => (
 sub generator {
     my ($self) = @_;
     my $file = MARC::File::MiJ->in($self->file);
+
+    # MARC::File doesn't provide support for inline files
+    $file = $self->decoder->fake_marc_file($self->fh,'MARC::File::MiJ') unless $file;
     sub  {
       $self->decoder->decode($file->next(),$self->id);
     }
diff --git a/lib/Catmandu/Importer/MARC/MicroLIF.pm b/lib/Catmandu/Importer/MARC/MicroLIF.pm
index 1dd15c0..e8c94d2 100644
--- a/lib/Catmandu/Importer/MARC/MicroLIF.pm
+++ b/lib/Catmandu/Importer/MARC/MicroLIF.pm
@@ -85,6 +85,8 @@ has decoder   => (
 sub generator {
     my ($self) = @_;
     my $file = MARC::File::MicroLIF->in($self->fh);
+    # MARC::File doesn't provide support for inline files
+    $file = $self->decoder->fake_marc_file($self->fh,'MARC::File::MicroLIF') unless $file;
     sub  {
       $self->decoder->decode($file->next(),$self->id);
     }
diff --git a/lib/Catmandu/Importer/MARC/USMARC.pm b/lib/Catmandu/Importer/MARC/USMARC.pm
index e52b301..1dd3b79 100644
--- a/lib/Catmandu/Importer/MARC/USMARC.pm
+++ b/lib/Catmandu/Importer/MARC/USMARC.pm
@@ -68,6 +68,7 @@ package Catmandu::Importer::MARC::USMARC;
 use Catmandu::Sane;
 use Moo;
 use MARC::File::USMARC;
+use Catmandu::Importer::MARC::Decoder;
 
 our $VERSION = '0.218';
 
@@ -75,10 +76,19 @@ with 'Catmandu::Importer';
 
 has id        => (is => 'ro' , default => sub { '001' });
 has records   => (is => 'rw');
+has decoder   => (
+    is   => 'ro',
+    lazy => 1 ,
+    builder => sub {
+        Catmandu::Importer::MARC::Decoder->new;
+    } );
 
 sub generator {
     my ($self) = @_;
     my $file = MARC::File::USMARC->in($self->fh);
+
+    # MARC::File doesn't provide support for inline files
+    $file = $self->decoder->fake_marc_file($self->fh,'MARC::File::USMARC') unless $file;
     sub  {
       $self->decode_marc($file->next());
     }
diff --git a/lib/Catmandu/Importer/MARC/XML.pm b/lib/Catmandu/Importer/MARC/XML.pm
index 62e7631..eb553b6 100644
--- a/lib/Catmandu/Importer/MARC/XML.pm
+++ b/lib/Catmandu/Importer/MARC/XML.pm
@@ -85,6 +85,10 @@ has decoder   => (
 sub generator {
     my ($self) = @_;
     my $file = MARC::File::XML->in($self->fh);
+
+    # MARC::File doesn't provide support for inline files
+    $file = $self->decoder->fake_marc_file($self->fh,'MARC::File::XML') unless $file;
+    
     sub  {
       $self->decoder->decode($file->next(),$self->id);
     }
diff --git a/t/19-io-string.t b/t/19-io-string.t
new file mode 100644
index 0000000..e6fb960
--- /dev/null
+++ b/t/19-io-string.t
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Catmandu::Importer::MARC;
+use MARC::File::USMARC;
+use Test::Simple tests => 4;
+
+my $data = join("",<DATA>);
+
+my $importer = Catmandu::Importer::MARC->new(
+    file => \$data,
+    type => "USMARC"
+);
+my $records = $importer->to_array();
+
+ok( @$records == 10, 'got all records' );
+ok( $records->[0]->{'_id'}             eq 'fol05731351 ', 'got _id' );
+ok( $records->[0]->{'record'}->[1][-1] eq 'fol05731351 ', 'got subfield' );
+ok( $records->[0]->{'_id'} eq $records->[0]->{'record'}->[1][-1],
+    '_id matches record id' );
+
+__DATA__
+00755cam  22002414a 4500001001300000003000600013005001700019008004100036010001700077020004300094040001800137042000800155050002600163082001700189100003100206245005400237260004200291300007200333500003300405650003700438630002500475630001300500
fol05731351 
IMchF
20000613133448.0
000107s2000    nyua          001 0 eng  
  a   00020737 
  a0471383147 (paper/cd-rom : alk. paper)
  aDLCcDLCdDLC
  apcc
00aQA76.73.P22bM33 2000
00a005.13/3221
1 aMartinsson, Tobias,d1976-
10aActivePerl [...]

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git



More information about the Pkg-perl-cvs-commits mailing list