File Coverage

blib/lib/MAB2/Writer/RAW.pm
Criterion Covered Total %
statement 29 29 100.0
branch 6 6 100.0
condition n/a
subroutine 5 5 100.0
pod n/a
total 40 40 100.0


line stmt bran cond sub pod time code
1             package MAB2::Writer::RAW;
2              
3             our $VERSION = '0.23';
4              
5 3     3   424 use strict;
  3         6  
  3         74  
6 3     3   13 use Moo;
  3         5  
  3         13  
7             with 'MAB2::Writer::Handle';
8              
9 3     3   848 use charnames ':full';
  3         6  
  3         23  
10 3     3   468 use Readonly;
  3         6  
  3         112  
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   11 my ( $self, $record ) = @_;
18 6         94 my $fh = $self->fh;
19              
20 6 100       38 if ( $record->[0][0] eq 'LDR' ) {
21 2         4 my $leader = $record->[0];
22 2         5 print $fh $leader->[3];
23             }
24             else {
25             # set default record leader
26 4         28 print $fh "99999nM2.01200024 h";
27             }
28              
29 6         13 foreach my $field (@$record) {
30 14 100       62 next if $field->[0] eq 'LDR';
31 12 100       25 if ( $field->[2] eq '_' ) {
32 6         54 print $fh $field->[0], $field->[1], $field->[3], $END_OF_FIELD;
33             }
34             else {
35 6         10 print $fh $field->[0], $field->[1];
36 6         18 for ( my $i = 2; $i < scalar @$field; $i += 2 ) {
37 9         24 my $subfield_code = $field->[ $i ];
38 9         14 my $value = $field->[ $i + 1 ];
39 9         19 print $fh $SUBFIELD_INDICATOR, $subfield_code, $value;
40             }
41 6         35 print $fh $END_OF_FIELD;
42             }
43             }
44 6         29 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