File Coverage

blib/lib/Catmandu/Importer/MARC/ISO.pm
Criterion Covered Total %
statement 35 36 97.2
branch 10 12 83.3
condition 4 6 66.6
subroutine 6 6 100.0
pod 0 1 0.0
total 55 61 90.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Catmandu::Importer::MARC::ISO - Package that imports ISO MARC records
4              
5             =head1 SYNOPSIS
6              
7             # From the command line (ISO is the default importer for MARC)
8             $ catmandu convert MARC --fix "marc_map('245a','title')" < /foo/bar.mrc
9              
10             # From perl
11             use Catmandu;
12              
13             # import records from file
14             my $importer = Catmandu->importer('MARC',file => '/foo/bar.mrc');
15             my $fixer = Catmandu->fixer("marc_map('245a','title')");
16              
17             $importer->each(sub {
18             my $item = shift;
19             ...
20             });
21              
22             # or using the fixer
23              
24             $fixer->fix($importer)->each(sub {
25             my $item = shift;
26             printf "title: %s\n" , $item->{title};
27             });
28              
29             =head1 CONFIGURATION
30              
31             =over
32              
33             =item id
34              
35             The MARC field which contains the system id (default: 001)
36              
37             =item file
38              
39             Read input from a local file given by its path. Alternatively a scalar
40             reference can be passed to read from a string.
41              
42             =item fh
43              
44             Read input from an L<IO::Handle>. If not specified, L<Catmandu::Util::io> is used to
45             create the input stream from the C<file> argument or by using STDIN.
46              
47             =item encoding
48              
49             Binmode of the input stream C<fh>. Set to C<:utf8> by default.
50              
51             =item fix
52              
53             An ARRAY of one or more fixes or file scripts to be applied to imported items.
54              
55             =back
56              
57             =head1 METHODS
58              
59             Every Catmandu::Importer is a Catmandu::Iterable all its methods are inherited.
60              
61             =head1 SEE ALSO
62              
63             L<Catmandu::Importer>,
64             L<Catmandu::Iterable>
65              
66             =cut
67             package Catmandu::Importer::MARC::ISO;
68 11     11   4328 use Catmandu::Sane;
  11         34  
  11         79  
69 11     11   2406 use Moo;
  11         22  
  11         68  
70 11     11   6613 use MARC::File::USMARC;
  11         142491  
  11         325  
71 11     11   3423 use Catmandu::Importer::MARC::Decoder;
  11         31  
  11         5263  
72              
73             our $VERSION = '1.20';
74              
75             with 'Catmandu::Importer';
76              
77             has id => (is => 'ro' , default => sub { '001' });
78             has records => (is => 'rw');
79             has decoder => (
80             is => 'ro',
81             lazy => 1 ,
82             builder => sub {
83 2     2   90 Catmandu::Importer::MARC::Decoder->new;
84             } );
85              
86             sub generator {
87             my ($self) = @_;
88             my $file = MARC::File::USMARC->in($self->fh);
89              
90             # MARC::File doesn't provide support for inline files
91             $file = $self->decoder->fake_marc_file($self->fh,'MARC::File::USMARC') unless $file;
92             sub {
93             $self->decode_marc($file->next());
94             }
95             }
96              
97             sub decode_marc {
98 91     91 0 170584 my ($self, $record) = @_;
99 91 100       195 return unless eval { $record->isa('MARC::Record') };
  91         585  
100 82         191 my @result = ();
101              
102 82         226 push @result , [ 'LDR' , undef, undef, '_' , $record->leader ];
103              
104 82         712 for my $field ($record->fields()) {
105 1412         3013 my $tag = $field->tag;
106 1412         5740 my $ind1 = $field->indicator(1);
107 1412         14285 my $ind2 = $field->indicator(2);
108              
109 1412         13255 my @sf = ();
110              
111 1412 100       2298 if ($field->is_control_field) {
112 324         1482 push @sf , '_', $field->data;
113             }
114              
115 1412         7534 for my $subfield ($field->subfields) {
116 1761         17257 push @sf , @$subfield;
117             }
118              
119 1412         7608 push @result, [$tag,$ind1,$ind2,@sf];
120             }
121              
122 82         203 my $sysid = undef;
123 82         278 my $id = $self->id;
124              
125 82 100 100     514 if ($id =~ /^00/ && $record->field($id)) {
    100 33        
    50          
126 71         2487 $sysid = $record->field($id)->data();
127             }
128             elsif ($id =~ /^([0-9]{3})([0-9a-zA-Z])$/) {
129 10         24 my $field = $record->field($1);
130 10 50       800 $sysid = $field->subfield($2) if ($field);
131             }
132             elsif (defined $id && $record->field($id)) {
133 0         0 $sysid = $record->field($id)->subfield("a");
134             }
135              
136 82         2885 return { _id => $sysid , record => \@result };
137             }
138              
139             1;