File Coverage

blib/lib/PICA/Parser/XML.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package PICA::Parser::XML;
2 4     4   29 use strict;
  4         10  
  4         121  
3 4     4   23 use warnings;
  4         10  
  4         194  
4              
5             our $VERSION = '0.33';
6              
7 4     4   25 use Carp qw(croak);
  4         11  
  4         241  
8 4     4   3633 use XML::LibXML::Reader;
  0            
  0            
9              
10             use parent 'PICA::Parser::Base';
11              
12             sub new {
13             my ($class, $input, %options) = @_;
14              
15             my $self = bless {
16             bless => !!$options{bless},
17             }, $class;
18            
19             # check for file or filehandle
20             my $ishandle = eval { fileno($input); };
21             if ( !$@ && defined $ishandle ) {
22             binmode $input; # drop all PerlIO layers, as required by libxml2
23             my $reader = XML::LibXML::Reader->new(IO => $input)
24             or croak "cannot read from filehandle $input\n";
25             $self->{xml_reader} = $reader;
26             } elsif ( defined $input && $input !~ /\n/ && -e $input ) {
27             my $reader = XML::LibXML::Reader->new(location => $input)
28             or croak "cannot read from file $input\n";
29             $self->{xml_reader} = $reader;
30             } elsif ( defined $input && length $input > 0 ) {
31             $input = ${$input} if (ref($input) // '' eq 'SCALAR');
32             my $reader = XML::LibXML::Reader->new( string => $input )
33             or croak "cannot read XML string $input\n";
34             $self->{xml_reader} = $reader;
35             } else {
36             croak "file, filehande or string $input does not exists";
37             }
38              
39             $self;
40             }
41              
42             sub _next_record {
43             my ($self) = @_;
44              
45             my $reader = $self->{xml_reader};
46             return unless $reader->nextElement('record');
47              
48             my @record;
49              
50             # get all field nodes from PICA record;
51             foreach my $field_node ( $reader->copyCurrentNode(1)->getChildrenByTagName('*') ) {
52             my @field;
53            
54             # get field tag number
55             my $tag = $field_node->getAttribute('tag');
56             my $occurrence = $field_node->getAttribute('occurrence') // '';
57             push(@field, ($tag, $occurrence));
58            
59             # get all subfield nodes
60             foreach my $subfield_node ( $field_node->getChildrenByTagName('*') ) {
61             my $subfield_code = $subfield_node->getAttribute('code');
62             my $subfield_data = $subfield_node->textContent;
63             push(@field, ($subfield_code, $subfield_data));
64             }
65             push(@record, [@field]);
66             };
67             return \@record;
68             }
69              
70             1;
71             __END__