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   4657 use Catmandu::Sane;
  11         36  
  11         103  
69 11     11   2732 use Moo;
  11         25  
  11         74  
70 11     11   7076 use MARC::File::USMARC;
  11         143679  
  11         331  
71 11     11   4020 use Catmandu::Importer::MARC::Decoder;
  11         26  
  11         5177  
72              
73             our $VERSION = '1.19';
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   47 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 256844 my ($self, $record) = @_;
99 91 100       250 return unless eval { $record->isa('MARC::Record') };
  91         833  
100 82         190 my @result = ();
101              
102 82         244 push @result , [ 'LDR' , undef, undef, '_' , $record->leader ];
103              
104 82         739 for my $field ($record->fields()) {
105 1412         3216 my $tag = $field->tag;
106 1412         5953 my $ind1 = $field->indicator(1);
107 1412         14781 my $ind2 = $field->indicator(2);
108              
109 1412         13901 my @sf = ();
110              
111 1412 100       2532 if ($field->is_control_field) {
112 324         1660 push @sf , '_', $field->data;
113             }
114              
115 1412         7627 for my $subfield ($field->subfields) {
116 1761         18422 push @sf , @$subfield;
117             }
118              
119 1412         8084 push @result, [$tag,$ind1,$ind2,@sf];
120             }
121              
122 82         215 my $sysid = undef;
123 82         283 my $id = $self->id;
124              
125 82 100 100     511 if ($id =~ /^00/ && $record->field($id)) {
    100 33        
    50          
126 71         2677 $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       736 $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         2934 return { _id => $sysid , record => \@result };
137             }
138              
139             1;