File Coverage

blib/lib/MARC/Moose/Parser/Iso2709.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             package MARC::Moose::Parser::Iso2709;
2             # ABSTRACT: Parser for ISO2709 records
3             $MARC::Moose::Parser::Iso2709::VERSION = '1.0.46';
4 4     4   103046 use Moose;
  4         467165  
  4         28  
5 4     4   28046 use Modern::Perl;
  4         10156  
  4         27  
6             require bytes;
7              
8             extends 'MARC::Moose::Parser';
9              
10 4     4   1292 use MARC::Moose::Record;
  4         12  
  4         152  
11 4     4   30 use MARC::Moose::Field::Control;
  4         9  
  4         122  
12 4     4   24 use MARC::Moose::Field::Std;
  4         8  
  4         2362  
13              
14              
15             # FIXME Experimental. Not used yet.
16             #has converter => (
17             # is => 'rw',
18             # isa => 'Text::IconvPtr',
19             # default => sub { Text::Iconv->new( "cp857", "utf8" ) }
20             #);
21              
22              
23              
24             override 'parse' => sub {
25             my ($self, $raw) = @_;
26              
27             return unless $raw;
28             my $utf8_flag = utf8::is_utf8($raw) || 1;
29              
30             my $record = MARC::Moose::Record->new();
31              
32             my $leader = substr($raw, 0, 24);
33             $record->_leader( $leader );
34              
35             $raw = substr($raw, 24);
36             my $directory_len = substr($leader, 12, 5) - 25;
37             my $directory = substr $raw, 0, $directory_len;
38             my $content = substr($raw, $directory_len+1);
39             my $number_of_tag = $directory_len / 12;
40             my @fields;
41             for (my $i = 0; $i < $number_of_tag; $i++) {
42             my $off = $i * 12;
43             my $tag = substr($directory, $off, 3);
44             next if $tag !~ /^[a-zA-Z0-9]*$/; # FIXME: it happens!
45             my $len = substr($directory, $off+3, 4) - 1;
46             my $pos = substr($directory, $off+7, 5) + 0;
47             my $value = bytes::substr($content, $pos, $len);
48             utf8::decode($value) if $utf8_flag;
49             next unless $value;
50             #$value = $self->converter->convert($value);
51             if ( $value =~ /\x1F/ ) { # There are some letters
52             my $i1 = substr($value, 0, 1);
53             my $i2 = substr($value, 1, 1);
54             $value = substr($value, 2);
55             my @sf;
56             for ( split /\x1F/, $value) {
57             next if length($_) < 2;
58             push @sf, [ substr($_, 0, 1), substr($_, 1) ];
59             }
60             push @fields, MARC::Moose::Field::Std->new(
61             tag => $tag, ind1 => $i1, ind2 => $i2, subf => \@sf );
62             }
63             else {
64             push @fields, MARC::Moose::Field::Control->new( tag => $tag, value => $value );
65             }
66             }
67             $record->fields( \@fields );
68             $record->lint($self->lint) if $self->lint;
69             return $record;
70             };
71              
72             __PACKAGE__->meta->make_immutable;
73              
74             1;
75              
76             __END__
77              
78             =pod
79              
80             =encoding UTF-8
81              
82             =head1 NAME
83              
84             MARC::Moose::Parser::Iso2709 - Parser for ISO2709 records
85              
86             =head1 VERSION
87              
88             version 1.0.46
89              
90             =head1 DESCRIPTION
91              
92             Override L<MARC::Moose::Parser> to parse ISO2709 MARC records.
93              
94             =head1 SEE ALSO
95              
96             =over 4
97              
98             =item *
99              
100             L<MARC::Moose>
101              
102             =item *
103              
104             L<MARC::Moose::Parser>
105              
106             =back
107              
108             =head1 AUTHOR
109              
110             Frédéric Demians <f.demians@tamil.fr>
111              
112             =head1 COPYRIGHT AND LICENSE
113              
114             This software is copyright (c) 2022 by Frédéric Demians.
115              
116             This is free software; you can redistribute it and/or modify it under
117             the same terms as the Perl 5 programming language system itself.
118              
119             =cut