File Coverage

blib/lib/Catmandu/Exporter/MARC/XML.pm
Criterion Covered Total %
statement 12 14 85.7
branch 1 2 50.0
condition n/a
subroutine 4 4 100.0
pod n/a
total 17 20 85.0


line stmt bran cond sub pod time code
1             package Catmandu::Exporter::MARC::XML;
2 28     28   161 use Catmandu::Sane;
  28         55  
  28         141  
3 28     28   4176 use Catmandu::Util qw(xml_escape is_different :array :is);
  28         59  
  28         8040  
4 28     28   185 use Moo;
  28         54  
  28         170  
5              
6             our $VERSION = '1.20';
7              
8             with 'Catmandu::Exporter', 'Catmandu::Exporter::MARC::Base', 'Catmandu::Buffer';
9              
10             has record => (is => 'ro' , default => sub { 'record'});
11             has record_format => (is => 'ro' , default => sub { 'raw'} );
12             has skip_empty_subfields => (is => 'ro' , default => sub { 1 });
13             has collection => (is => 'ro' , default => sub { 1 });
14             has xml_declaration => (is => 'ro' , default => sub { 1 });
15             has pretty => (is => 'rw' , default => sub { 0 });
16             has _n => (is => 'rw' , default => sub { 0 });
17              
18             sub _line {
19 615     615   10042 my ($self, $indent, $line) = @_;
20 615 50       1830 if ($self->pretty) {
21 0         0 my $pre = " " x $indent;
22 0         0 $self->buffer_add( $pre.$line."\n" );
23             } else {
24 615         1645 $self->buffer_add( $line );
25             }
26             }
27              
28             sub add {
29             my ($self, $data) = @_;
30              
31             if ($self->_n == 0) {
32             if ($self->xml_declaration) {
33             $self->buffer_add( Catmandu::Util::xml_declaration );
34             }
35              
36             if ($self->collection) {
37             $self->_line(0,'<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim">');
38             }
39              
40             $self->_n(1);
41             }
42              
43             my $indent = $self->collection ? 1 : 0;
44              
45             if ($self->record_format eq 'MARC-in-JSON') {
46             $data = $self->_json_to_raw($data);
47             }
48              
49             if ($self->collection) {
50             $self->_line($indent,'<marc:record>');
51             }
52             else {
53             $self->_line($indent,'<marc:record xmlns:marc="http://www.loc.gov/MARC21/slim">');
54             }
55              
56             my $record = $data->{$self->record};
57              
58             for my $field (@$record) {
59             my ($tag, $ind1, $ind2, @data) = @$field;
60              
61             $ind1 = ' ' unless defined $ind1;
62             $ind2 = ' ' unless defined $ind2;
63              
64             @data = $self->_clean_raw_data($tag,@data) if $self->skip_empty_subfields;
65              
66             next if $tag eq 'FMT';
67             next if @data == 0;
68              
69             if ($tag eq 'LDR') {
70             $self->_line($indent+1,'<marc:leader>' . xml_escape($data[1]) . '</marc:leader>');
71             }
72             elsif ($tag =~ /^00/) {
73             $self->_line($indent+1,'<marc:controlfield tag="' . xml_escape($tag) . '">' . xml_escape($data[1]) . '</marc:controlfield>');
74             }
75             else {
76             $self->_line($indent+1,'<marc:datafield tag="' . xml_escape($tag) . '" ind1="' . $ind1 . '" ind2="' . $ind2 . '">');
77             while (@data) {
78             my ($code, $val) = splice(@data, 0, 2);
79             next unless $code =~ /[A-Za-z0-9]/;
80             $self->_line($indent+2,'<marc:subfield code="' . $code . '">' . xml_escape($val) . '</marc:subfield>');
81             }
82             $self->_line($indent+1,'</marc:datafield>');
83             }
84             }
85              
86             $self->_line($indent,'</marc:record>');
87              
88             $self->fh->print( join('', @{ $self->buffer } ) );
89             $self->clear_buffer;
90             }
91              
92             sub commit {
93             my ($self) = @_;
94              
95             if($self->collection){
96             $self->fh->print('</marc:collection>');
97             }
98              
99             $self->fh->flush;
100              
101             1;
102             }
103              
104             1;
105             __END__
106              
107             =head1 NAME
108              
109             Catmandu::Exporter::MARC::XML - Exporter for MARC records to MARCXML
110              
111             =head1 SYNOPSIS
112              
113             # From the command line
114             $ catmandu convert MARC to MARC --type XML < /foo/data.mrc
115              
116             # From Perl
117             use Catmandu;
118              
119             my $importer = Catmandu->importer('MARC', file => "/foo/bar.mrc" , type => 'ISO');
120             my $exporter = Catmandu->exporter('MARC', file => "marc.xml", type => 'XML' );
121              
122             $exporter->add($importer);
123             $exporter->commit;
124              
125             =head1 DESCRIPTION
126              
127             This L<Catmandu::Exporter::MARC> serializes MARC records as XML.
128              
129             =head1 CONFIGURATION
130              
131             =over
132              
133             =item file
134              
135             Write output to a local file given by its path or file handle. Alternatively a
136             scalar reference can be passed to write to a string and a code reference can be
137             used to write to a callback function.
138              
139             =item fh
140              
141             Write the output to an L<IO::Handle>. If not specified,
142             L<Catmandu::Util::io|Catmandu::Util/IO-functions> is used to create the output
143             handle from the C<file> argument or by using STDOUT.
144              
145             =item fix
146              
147             An ARRAY of one or more fixes or file scripts to be applied to exported items.
148              
149             =item record
150              
151             the key containing the marc record (default: 'record')
152              
153             =item record_format
154              
155             Optionally set to 'MARC-in-JSON' when the input format is in MARC-in-JSON
156              
157             =item collection
158              
159             add a marc:collection header when true (default: true)
160              
161             =item xml_declaration
162              
163             add a xml declaration when true (default: true)
164              
165             =item skip_empty_subfields
166              
167             skip fields which don't contain any data (default: false)
168              
169             =item pretty
170              
171             pretty-print XML
172              
173             =back
174              
175             =head1 METHODS
176              
177             See L<Catmandu::Exporter>, L<Catmandu::Addable>, L<Catmandu::Fixable>,
178             L<Catmandu::Counter>, and L<Catmandu::Logger> for a full list of methods.
179              
180             =head1 SEE ALSO
181              
182             L<Catmandu::Importer::MARC::XML>
183              
184             =cut