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 |