File Coverage

blib/lib/Catmandu/Importer/MARC/ALEPHSEQ.pm
Criterion Covered Total %
statement 6 6 100.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 8 8 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Catmandu::Importer::MARC::ALEPHSEQ - Package that imports Ex Libris' Aleph sequential MARC records
4              
5             =head1 SYNOPSIS
6              
7             # From the command line
8             $ catmandu convert MARC --type ALEPHSEQ --fix "marc_map('245a','title')" < /foo/usm01.txt
9              
10             # From perl
11             use Catmandu;
12              
13             # import records from file
14             my $importer = Catmandu->importer('MARC',file => '/foo/usm01.txt' , type => 'ALEPHSEQ');
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 file
34              
35             Read input from a local file given by its path. Alternatively a scalar
36             reference can be passed to read from a string.
37              
38             =item fh
39              
40             Read input from an L<IO::Handle>. If not specified, L<Catmandu::Util::io> is used to
41             create the input stream from the C<file> argument or by using STDIN.
42              
43             =item encoding
44              
45             Binmode of the input stream C<fh>. Set to C<:utf8> by default.
46              
47             =item fix
48              
49             An ARRAY of one or more fixes or file scripts to be applied to imported items.
50              
51             =back
52              
53             =head1 METHODS
54              
55             Every Catmandu::Importer is a Catmandu::Iterable all its methods are inherited.
56              
57             =head1 SEE ALSO
58              
59             L<Catmandu::Importer>,
60             L<Catmandu::Iterable>
61              
62             =cut
63             package Catmandu::Importer::MARC::ALEPHSEQ;
64 3     3   1744 use Catmandu::Sane;
  3         8  
  3         27  
65 3     3   782 use Moo;
  3         6  
  3         21  
66              
67             our $VERSION = '1.19';
68              
69             with 'Catmandu::Importer';
70              
71             sub generator {
72             my $self = shift;
73              
74             sub {
75             state $fh = $self->fh;
76             state $prev_id;
77             state $record = [];
78              
79             while(<$fh>) {
80             chop;
81             next unless (length $_ >= 18);
82              
83             my ($sysid,$s1,$tag,$ind1,$ind2,$s2,$char,$s3,$data) = unpack("A9A1A3A1A1A1A1A1U0A*",$_);
84             unless ($tag =~ m{^[0-9A-Z]+}o) {
85             warn "skipping $sysid $tag unknown tag";
86             next;
87             }
88             unless ($ind1 =~ m{^[A-Za-z0-9-]$}o) {
89             $ind1 = " ";
90             }
91             unless ($ind2 =~ m{^[A-Za-z0-9-]$}o) {
92             $ind2 = " ";
93             }
94             unless (utf8::decode($data)) {
95             warn "skipping $sysid $tag unknown data";
96             next;
97             }
98             if ($tag eq 'LDR') {
99             $data =~ s/\^/ /g;
100             }
101             my @parts = ('_' , split(/\$\$(.)/, $data) );
102              
103             # All control-fields contain an underscore field containing the data
104             # all other fields not.
105             unless ($tag =~ /^FMT|LDR|00.$/o) {
106             shift @parts;
107             shift @parts;
108             }
109              
110             # If we have an empty subfield at the end, then we need to add a implicit empty value
111             push(@parts,'') unless int(@parts) % 2 == 0;
112              
113             if (@$record > 0 && $tag eq 'FMT') {
114             my $result = { _id => $prev_id , record => [ @$record ] };
115             $record = [[$tag, $ind1, $ind2, @parts]];
116             $prev_id = $sysid;
117             return $result;
118             }
119              
120             push @$record, [$tag, $ind1, $ind2, @parts];
121              
122             $prev_id = $sysid;
123             }
124              
125             if (@$record > 0) {
126             my $result = { _id => $prev_id , record => [ @$record ] };
127             $record = [];
128             return $result;
129             }
130             else {
131             return;
132             }
133             };
134             }
135              
136              
137             1;