File Coverage

blib/lib/MAB2/Writer/Disk.pm
Criterion Covered Total %
statement 30 30 100.0
branch 6 6 100.0
condition n/a
subroutine 5 5 100.0
pod n/a
total 41 41 100.0


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