File Coverage

blib/lib/MAB2/Writer/XML.pm
Criterion Covered Total %
statement 31 31 100.0
branch 10 14 71.4
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 48 52 92.3


line stmt bran cond sub pod time code
1             package MAB2::Writer::XML;
2              
3             our $VERSION = '0.23';
4              
5 3     3   394 use strict;
  3         6  
  3         75  
6 3     3   13 use Moo;
  3         5  
  3         12  
7             with 'MAB2::Writer::Handle';
8              
9             has xml_declaration => ( is => 'ro' , default => sub {0} );
10             has collection => ( is => 'ro' , default => sub {0} );
11              
12              
13             sub start {
14 2     2 1 38 my ($self) = @_;
15              
16 2 50       14 print { $self->fh } "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" if $self->xml_declaration;
  2         34  
17 2 50       61 print { $self->fh }
  2         36  
18             "<datei xmlns=\"http://www.ddb.de/professionell/mabxml/mabxml-1.xsd\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xsi:schemaLocation=\"http://www.ddb.de/professionell/mabxml/mabxml-1.xsd http://www.d-nb.de/standardisierung/formate/mabxml-1.xsd\">\n" if $self->collection;
19             }
20              
21              
22             sub _write_record {
23 4     4   8 my ( $self, $record ) = @_;
24 4         69 my $fh = $self->fh;
25              
26 4 100       28 if ( $record->[0][0] eq 'LDR' ) {
27 1         2 my $leader = $record->[0];
28 1 50       8 my ( $status, $typ ) = ( $1, $2 )
29             if $leader->[3] =~ /^\d{5}(\w)M2\.0\d*\s*(\w)$/;
30 1         5 print $fh
31             "<datensatz typ=\"$typ\" status=\"$status\" mabVersion=\"M2.0\">\n";
32             }
33             else {
34             # default to typ and status
35 3         9 print $fh "<datensatz typ=\"h\" status=\"n\" mabVersion=\"M2.0\">\n";
36             }
37              
38 4         9 foreach my $field (@$record) {
39              
40 9 100       22 next if $field->[0] eq 'LDR';
41 8 100       14 if ( $field->[2] eq '_' ) {
42 4         17 print $fh
43             "<feld nr=\"$field->[0]\" ind=\"$field->[1]\">$field->[3]</feld>\n";
44             }
45             else {
46 4         12 print $fh "<feld nr=\"$field->[0]\" ind=\"$field->[1]\">\n";
47 4         12 for ( my $i = 2; $i < scalar @$field; $i += 2 ) {
48 6         10 my $value = $field->[ $i + 1 ];
49 6         18 print $fh " <uf code=\"$field->[$i]\">$value</uf>\n";
50             }
51 4         22 print $fh "</feld>\n";
52             }
53             }
54 4         13 print $fh "</datensatz>\n";
55             }
56              
57              
58             sub end {
59 2     2 1 14 my ($self) = @_;
60              
61 2 50       8 print { $self->fh } "</datei>\n" if $self->collection;
  2         29  
62             }
63              
64              
65             1;
66              
67             __END__
68              
69             =pod
70              
71             =encoding UTF-8
72              
73             =head1 NAME
74              
75             MAB2::Writer::XML - MAB2 XML format serializer
76              
77             =head1 SYNOPSIS
78              
79             L<MAB2::Writer::XML> is a MAB2 XML serializer.
80              
81             use MAB2::Writer::XML;
82              
83             my @mab_records = (
84             [
85             ['001', ' ', '_', '2415107-5'],
86             ['331', ' ', '_', 'Code4Lib journal'],
87             ['655', 'e', 'u', 'http://journal.code4lib.org/', 'z', 'kostenfrei'],
88             ...
89             ],
90             {
91             record => [
92             ['001', ' ', '_', '2415107-5'],
93             ['331', ' ', '_', 'Code4Lib journal'],
94             ['655', 'e', 'u', 'http://journal.code4lib.org/', 'z', 'kostenfrei'],
95             ...
96             ]
97             }
98             );
99              
100             my $writer = MAB2::Writer::XML->new( fh => $fh, xml_declaration => 1, collection => 1 );
101            
102             $writer->start();
103              
104             foreach my $record (@mab_records) {
105             $writer->write($record);
106             }
107              
108             $writer->end();
109              
110             =head1 Arguments
111              
112             =over
113              
114             =item C<xml_declaration>
115              
116             Write XML declaration. Set to 0 or 1. Default: 0. Optional.
117              
118             =item C<collection>
119              
120             Wrap records in collection element (<datei>). Set to 0 or 1. Default: 0. Optional.
121              
122             =back
123              
124             See also L<MAB2::Writer::Handle>.
125              
126             =head1 METHODS
127              
128             =head2 new(file => $file | fh => $fh [, xml_declaration => 1, collection => 1, encoding => 'UTF-8'])
129              
130             =head2 start()
131              
132             Writes XML declaration and/or start element for a collection.
133              
134             =head2 _write_record()
135              
136             =head2 end()
137              
138             Writes end element for the collection.
139              
140             =head1 SEEALSO
141              
142             L<MAB2::Writer::Handle>, L<Catmandu::Exporter>.
143              
144             =head1 AUTHOR
145              
146             Johann Rolschewski <jorol@cpan.org>
147              
148             =head1 COPYRIGHT AND LICENSE
149              
150             This software is copyright (c) 2013 by Johann Rolschewski.
151              
152             This is free software; you can redistribute it and/or modify it under
153             the same terms as the Perl 5 programming language system itself.
154              
155             =cut