line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MAB2::Writer::RAW; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '0.21'; |
4
|
|
|
|
|
|
|
|
5
|
3
|
|
|
3
|
|
309
|
use strict; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
74
|
|
6
|
3
|
|
|
3
|
|
13
|
use Moo; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
14
|
|
7
|
|
|
|
|
|
|
with 'MAB2::Writer::Handle'; |
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
746
|
use charnames ':full'; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
16
|
|
10
|
3
|
|
|
3
|
|
478
|
use Readonly; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
113
|
|
11
|
|
|
|
|
|
|
Readonly my $SUBFIELD_INDICATOR => qq{\N{INFORMATION SEPARATOR ONE}}; |
12
|
|
|
|
|
|
|
Readonly my $END_OF_FIELD => qq{\N{INFORMATION SEPARATOR TWO}}; |
13
|
|
|
|
|
|
|
Readonly my $END_OF_RECORD => qq{\N{INFORMATION SEPARATOR THREE}\N{LINE FEED}}; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub _write_record { |
17
|
6
|
|
|
6
|
|
10
|
my ( $self, $record ) = @_; |
18
|
6
|
|
|
|
|
88
|
my $fh = $self->fh; |
19
|
|
|
|
|
|
|
|
20
|
6
|
100
|
|
|
|
37
|
if ( $record->[0][0] eq 'LDR' ) { |
21
|
2
|
|
|
|
|
4
|
my $leader = $record->[0]; |
22
|
2
|
|
|
|
|
4
|
print $fh $leader->[3]; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
else { |
25
|
|
|
|
|
|
|
# set default record leader |
26
|
4
|
|
|
|
|
19
|
print $fh "99999nM2.01200024 h"; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
6
|
|
|
|
|
13
|
foreach my $field (@$record) { |
30
|
14
|
100
|
|
|
|
55
|
next if $field->[0] eq 'LDR'; |
31
|
12
|
100
|
|
|
|
20
|
if ( $field->[2] eq '_' ) { |
32
|
6
|
|
|
|
|
24
|
print $fh $field->[0], $field->[1], $field->[3], $END_OF_FIELD; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
else { |
35
|
6
|
|
|
|
|
13
|
print $fh $field->[0], $field->[1]; |
36
|
6
|
|
|
|
|
14
|
for ( my $i = 2; $i < scalar @$field; $i += 2 ) { |
37
|
9
|
|
|
|
|
24
|
my $subfield_code = $field->[ $i ]; |
38
|
9
|
|
|
|
|
13
|
my $value = $field->[ $i + 1 ]; |
39
|
9
|
|
|
|
|
20
|
print $fh $SUBFIELD_INDICATOR, $subfield_code, $value; |
40
|
|
|
|
|
|
|
} |
41
|
6
|
|
|
|
|
34
|
print $fh $END_OF_FIELD; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
} |
44
|
6
|
|
|
|
|
28
|
print $fh $END_OF_RECORD; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
1; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
__END__ |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=pod |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=encoding UTF-8 |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 NAME |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
MAB2::Writer::RAW - MAB2 RAW format serializer |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head1 SYNOPSIS |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
L<MAB2::Writer::RAW> is a MAB2 serializer. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
use MAB2::Writer::RAW; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
my @mab_records = ( |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
[ |
69
|
|
|
|
|
|
|
['001', ' ', '_', '2415107-5'], |
70
|
|
|
|
|
|
|
['331', ' ', '_', 'Code4Lib journal'], |
71
|
|
|
|
|
|
|
['655', 'e', 'u', 'http://journal.code4lib.org/', 'z', 'kostenfrei'], |
72
|
|
|
|
|
|
|
... |
73
|
|
|
|
|
|
|
], |
74
|
|
|
|
|
|
|
{ |
75
|
|
|
|
|
|
|
record => [ |
76
|
|
|
|
|
|
|
['001', ' ', '_', '2415107-5'], |
77
|
|
|
|
|
|
|
['331', ' ', '_', 'Code4Lib journal'], |
78
|
|
|
|
|
|
|
['655', 'e', 'u', 'http://journal.code4lib.org/', 'z', 'kostenfrei'], |
79
|
|
|
|
|
|
|
... |
80
|
|
|
|
|
|
|
] |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
$writer = MAB2::Writer::RAW->new( fh => $fh ); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
foreach my $record (@mab_records) { |
87
|
|
|
|
|
|
|
$writer->write($record); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head1 Arguments |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
See L<MAB2::Writer::Handle>. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 METHODS |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head2 new(file => $file | fh => $fh [, encoding => 'UTF-8']) |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head2 _write_record($record) |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head1 SEEALSO |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
L<MAB2::Writer::Handle>, L<Catmandu::Exporter>. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head1 AUTHOR |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Johann Rolschewski <jorol@cpan.org> |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
This software is copyright (c) 2013 by Johann Rolschewski. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
113
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=cut |