File Coverage

blib/lib/Net/OAI/ListRecords.pm
Criterion Covered Total %
statement 85 91 93.4
branch 35 38 92.1
condition 1 3 33.3
subroutine 14 17 82.3
pod 8 8 100.0
total 143 157 91.0


line stmt bran cond sub pod time code
1             package Net::OAI::ListRecords;
2              
3 16     16   78 use strict;
  16         30  
  16         443  
4 16     16   76 use base qw( XML::SAX::Base Net::OAI::Base );
  16         26  
  16         1584  
5 16     16   77 use Carp qw( croak );
  16         27  
  16         687  
6 16     16   8569 use Net::OAI::Record;
  16         39  
  16         446  
7 16     16   79 use Net::OAI::Record::Header;
  16         27  
  16         357  
8 16     16   78 use File::Temp qw( tempfile );
  16         24  
  16         718  
9 16     16   76 use Storable qw( store_fd fd_retrieve );
  16         29  
  16         664  
10 16     16   79 use IO::File;
  16         23  
  16         17828  
11              
12             =head1 NAME
13              
14             Net::OAI::ListRecords - Results of the ListRecords OAI-PMH verb.
15              
16             =head1 SYNOPSIS
17              
18             =head1 DESCRIPTION
19              
20             =head1 METHODS
21              
22             Like all responses to OAI verbs, ListRecords is based on L
23             and inherits its methods.
24              
25              
26             =head2 new()
27              
28             You probably don't want to be using this method yourself, since
29             Net::OAI::Harvester::listRecords() calls it for you.
30              
31             =cut
32              
33             sub new {
34 9     9 1 87 my ( $class, %opts ) = @_;
35              
36 9         26 my $package;
37 9 100       91 if ( $package = $opts{ recordHandler } ) {
    100          
38 2 50       16 $opts{ metadataHandler } and croak( "you may pass either a recordHandler or a metadataHandler to getRecord()" );
39 2         9 delete $opts { metadataHandler };
40             } elsif ( $package = $opts{ metadataHandler } ) {
41 3         15 delete $opts{ recordHandler };
42             } else {
43 4         15 delete $opts{ recordHandler };
44 4         16 $package = $opts{ metadataHandler } = 'Net::OAI::Record::OAI_DC';
45             }
46 9         157 Net::OAI::Harvester::_verifyHandler( $package );
47              
48 9   33     109 my $self = bless \%opts, ref( $class ) || $class;
49 9         79 my ( $fh, $tempfile ) = tempfile(UNLINK => 1);
50 9         7233 binmode( $fh, ':utf8' );
51 9         133 $self->{ recordsFileHandle } = $fh;
52 9         38 $self->{ recordsFilename } = $tempfile;
53              
54             ## so we can store code refs
55 9         31 $Storable::Deparse = 1;
56 9         28 $Storable::Eval = 1;
57              
58 9         42 $self->{ _prefixmap } = {};
59 9         58 return( $self );
60             }
61              
62             =head2 next()
63              
64             Returns the L object for the next OAI record in the
65             response, C if none remain. resumptionToken handling is performed
66             automagically if the original request was listAllIdentifiers().
67              
68             =cut
69              
70             sub next {
71 1207     1207 1 635330 my $self = shift;
72              
73             ## if we haven't opened our object store do it now
74 1207 100       4166 if ( ! $self->{ recordsFileHandle } ) {
75             $self->{ recordsFileHandle } = IO::File->new( $self->{ recordsFilename } )
76 7 50       71 or croak "unable to open temp file: ".$self->{ recordsFilename };
77             ## we assume utf8 encoding (perhaps wrongly)
78 7         845 binmode( $self->{ recordsFileHandle }, ':utf8' );
79             }
80              
81             ## no more data to read back from our object store then return undef
82 1207 100       4219 if ( $self->{ recordsFileHandle }->eof() ) {
83             $self->{ recordsFileHandle }->close() or croak "Could not close() ".$self->{ recordsFilename }
84 6 50       97 .". File system full?";
85 6         1803 return( $self->handleResumptionToken( 'listRecords' ) );
86             }
87              
88             ## get an object back from the store, thaw and return it
89 1201         10614 my $record = fd_retrieve( $self->{ recordsFileHandle } );
90 1201         206646 return( $record );
91             }
92              
93             =head2 metadataHandler()
94             =head2 recordHandler()
95              
96             Returns the name of the package being used to represent the individual metadata
97             records. If unspecified it defaults to L which
98             should be ok.
99              
100             =cut
101              
102             sub metadataHandler {
103 0     0 1 0 my $self = shift;
104 0         0 return( $self->{ metadataHandler } );
105             }
106              
107             sub recordHandler {
108 0     0 1 0 my $self = shift;
109 0         0 return( $self->{ recordHandler } );
110             }
111              
112             ## SAX Handlers
113              
114             sub start_prefix_mapping {
115 4218     4218 1 55909 my ($self, $mapping) = @_;
116 4218 100       10611 if ( $self->get_handler() ) {
117 4200         34231 return $self->SUPER::start_prefix_mapping( $mapping )};
118 18         312 $self->{ _prefixmap }->{$mapping->{ Prefix }} = $mapping;
119             }
120              
121             sub end_prefix_mapping {
122 4218     4218 1 132180 my ($self, $mapping) = @_;
123 4218 100       11814 if ( $self->get_handler() ) {
124 4200         36078 return $self->SUPER::end_prefix_mapping( $mapping )};
125 18         204 delete $self->{ _prefixmap }->{$mapping->{ Prefix }};
126             }
127              
128             sub start_element {
129 41632     41632 1 251506 my ( $self, $element ) = @_;
130 41632 100       139891 return $self->SUPER::start_element( $element ) unless $element->{NamespaceURI} eq Net::OAI::Harvester::XMLNS_OAI;
131              
132             ## if we are at the start of a new record then we need an empty
133             ## metadata object to fill up
134 8816 100       26009 if ( $element->{ LocalName } eq 'record' ) {
    100          
135             ## we store existing downstream handler so we can replace
136             ## it after we are done retrieving the metadata record
137 1400         4313 $self->{ OLD_Handler } = $self->get_handler();
138             my $header = $self->{ recordHandler }
139             ? Net::OAI::Record::Header->new(
140             Handler => (ref($self->{ recordHandler }) ? $self->{ recordHandler } : $self->{ recordHandler }->new()),
141             fwdAll => 1,
142             )
143             : Net::OAI::Record::Header->new(
144 1400 100       17709 Handler => (ref($self->{ metadataHandler }) ? $self->{ metadataHandler } : $self->{ metadataHandler }->new()),
    100          
    100          
145             );
146 1400         4291 $self->set_handler( $header );
147 1400         16158 foreach my $mapping ( values %{$self->{_prefixmap}} ) {
  1400         4955  
148 2800         39619 $self->SUPER::start_prefix_mapping($mapping)};
149             }
150             elsif ( $element->{ LocalName } eq 'ListRecords' ) {
151             }
152 8816         32558 return $self->SUPER::start_element( $element );
153             }
154              
155             sub end_element {
156 41632     41632 1 249308 my ( $self, $element ) = @_;
157              
158 41632         100380 $self->SUPER::end_element( $element );
159 41632 100       190506 return unless $element->{NamespaceURI} eq Net::OAI::Harvester::XMLNS_OAI;
160              
161             ## if we've got to the end of the record we need to stash
162             ## away the object in our object store on disk
163 8816 100       45136 if ( $element->{ LocalName } eq 'record' ) {
    100          
164              
165             ## we need to swap out the existing metadata handler and freeze
166             ## it on disk
167 1400         3821 my $header = $self->get_handler();
168 1400         10592 my $data = $header->get_handler();
169 1400         10765 $header->set_handler( undef ); ## remove reference to $record
170              
171             ## set handler to what is was before we started processing
172             ## the record
173 1400         28780 $self->set_handler( $self->{ OLD_Handler } );
174 1400         20181 my $record;
175 1400 100       3914 if ( $self->{ recordHandler } ) {
176 400         1910 $record = Net::OAI::Record->new(header => $header, recorddata => $data)
177             } else {
178 1000         5059 $record = Net::OAI::Record->new(header => $header, metadata => $data)
179             };
180              
181             ## commit the object to disk
182 1400         6938 Net::OAI::Harvester::debug( "committing record to object store" );
183 1400         6574 store_fd( $record, $self->{ recordsFileHandle } );
184             }
185              
186             ## otherwise if we got to the end of our list we can close
187             ## our object stash on disk
188             elsif ( $element->{ LocalName } eq 'ListRecords' ) {
189 7         75 $self->{ recordsFileHandle }->close();
190 7         992 $self->{ recordsFileHandle } = undef;
191             }
192              
193             }
194              
195             sub _fatal {
196 0     0     print STDERR "fatal: ", shift, "\n";
197 0           exit(1);
198             }
199              
200             1;
201