File Coverage

blib/lib/MARC/Moose/Parser/Marcxml.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package MARC::Moose::Parser::Marcxml;
2             # ABSTRACT: Parser for MARXML records
3             $MARC::Moose::Parser::Marcxml::VERSION = '1.0.46';
4 2     2   4413 use Moose;
  2         6  
  2         17  
5              
6             extends 'MARC::Moose::Parser';
7              
8 2     2   14031 use MARC::Moose::Field::Control;
  2         4  
  2         45  
9 2     2   10 use MARC::Moose::Field::Std;
  2         5  
  2         1062  
10              
11              
12             override 'parse' => sub {
13             my ($self, $raw) = @_;
14              
15             return unless $raw =~ /<record/;
16              
17             my @parts = split />/, $raw;
18             my ($tag, $code, $ind1, $ind2);
19             my $record = MARC::Moose::Record->new();
20             my @fields;
21             while ( @parts ) {
22             $_ = shift @parts;
23             $_ = shift @parts if /<record/;
24             if ( /<leader/ ) {
25             $_ = shift @parts;
26             /(.*)<\/leader/;
27             $record->_leader($1);
28             next;
29             }
30             if ( /<controlfield\s*tag="(.*)"/ ) {
31             my $tag = $1;
32             $_ = shift @parts;
33             s/<\/controlfield//;
34             push @fields, MARC::Moose::Field::Control->new( tag => $tag, value => $_ );
35             next;
36             }
37             if ( /<datafield\s*tag="(.*?)"\s*ind1="(.*?)"\s*ind2="(.*)"/ ) {
38             my ($tag, $ind1, $ind2) = ($1, $2, $3);
39             my @subf;
40             while ( @parts && $parts[0] =~ /<subfield.*code="(.*)"/ ) {
41             my $letter = $1;
42             shift @parts;
43             $_ = shift @parts;
44             s/<\/subfield//;
45             push @subf, [ $letter => $_ ];
46             }
47             $ind1 = ' ' unless defined($ind1);
48             $ind2 = ' ' unless defined($ind2);
49             push @fields, MARC::Moose::Field::Std->new(
50             tag => $tag,
51             ind1 => $ind1,
52             ind2 => $ind2,
53             subf => \@subf );
54             shift @parts;
55             next;
56             }
57             last;
58             }
59             $record->fields( \@fields );
60              
61             return $record;
62             };
63              
64             __PACKAGE__->meta->make_immutable;
65              
66             1;
67              
68             __END__
69              
70             =pod
71              
72             =encoding UTF-8
73              
74             =head1 NAME
75              
76             MARC::Moose::Parser::Marcxml - Parser for MARXML records
77              
78             =head1 VERSION
79              
80             version 1.0.46
81              
82             =head1 DESCRIPTION
83              
84             This MARCXML parser doesn't use a SAX parser. It's pure Perl. This results in
85             better performances.
86              
87             =head1 SEE ALSO
88              
89             =over 4
90              
91             =item *
92              
93             L<MARC::Moose>
94              
95             =item *
96              
97             L<MARC::Moose::Parser>
98              
99             =back
100              
101             =head1 AUTHOR
102              
103             Frédéric Demians <f.demians@tamil.fr>
104              
105             =head1 COPYRIGHT AND LICENSE
106              
107             This software is copyright (c) 2022 by Frédéric Demians.
108              
109             This is free software; you can redistribute it and/or modify it under
110             the same terms as the Perl 5 programming language system itself.
111              
112             =cut