File Coverage

blib/lib/Net/OAI/ListRecords.pm
Criterion Covered Total %
statement 65 69 94.2
branch 12 12 100.0
condition 2 5 40.0
subroutine 13 15 86.6
pod 5 5 100.0
total 97 106 91.5


line stmt bran cond sub pod time code
1             package Net::OAI::ListRecords;
2              
3 14     14   77 use strict;
  14         37  
  14         528  
4 14     14   76 use base qw( XML::SAX::Base );
  14         26  
  14         1135  
5 14     14   76 use base qw( Net::OAI::Base );
  14         25  
  14         929  
6 14     14   14995 use Net::OAI::Record;
  14         33  
  14         421  
7 14     14   83 use Net::OAI::Record::Header;
  14         23  
  14         298  
8 14     14   66 use File::Temp qw( tempfile );
  14         29  
  14         895  
9 14     14   79 use Storable qw( store_fd fd_retrieve );
  14         26  
  14         648  
10 14     14   73 use IO::File;
  14         26  
  14         2713  
11 14     14   123 use Carp qw( croak );
  14         24  
  14         9350  
12              
13             =head1 NAME
14              
15             Net::OAI::ListRecords - Results of the ListRecords OAI-PMH verb.
16              
17             =head1 SYNOPSIS
18              
19             =head1 DESCRIPTION
20              
21             =head1 METHODS
22              
23             =head2 new()
24              
25             You probably don't want to be using this method yourself, since
26             Net::OAI::Harvester::listRecords() calls it for you.
27              
28             =cut
29              
30             sub new {
31 5     5 1 35 my ( $class, %opts ) = @_;
32              
33             ## default metadata handler
34             $opts{ metadataHandler } = 'Net::OAI::Record::OAI_DC'
35 5 100       71 if ( ! $opts{ metadataHandler } );
36            
37 5         29 Net::OAI::Harvester::_verifyMetadataHandler( $opts{ metadataHandler } );
38 5   33     88 my $self = bless \%opts, ref( $class ) || $class;
39 5         42 my ( $fh, $tempfile ) = tempfile(UNLINK => 1);
40 5         3728 binmode( $fh, ':utf8' );
41 5         57 $self->{ recordsFileHandle } = $fh;
42 5         16 $self->{ recordsFilename } = $tempfile;
43              
44             ## so we can store code refs
45 5         10 $Storable::Deparse = 1;
46 5         13 $Storable::Eval = 1;
47              
48 5         23 return( $self );
49             }
50              
51             =head2 next()
52              
53             Return the next metadata object or undef if there are no more.
54              
55             =cut
56              
57             sub next {
58 604     604 1 274676 my $self = shift;
59              
60             ## if we haven't opened our object store do it now
61 604 100       2198 if ( ! $self->{ recordsFileHandle } ) {
62             $self->{ recordsFileHandle } =
63             IO::File->new( $self->{ recordsFilename } )
64 4   50     37 || die "unable to open temp file: ".$self->{ recordsFilename };
65             ## we assume utf8 encoding (perhaps wrongly)
66 4         536 binmode( $self->{ recordsFileHandle }, ':utf8' );
67             }
68              
69             ## no more data to read back from our object store then return undef
70 604 100       2678 if ( $self->{ recordsFileHandle }->eof() ) {
71 3         61 $self->{ recordsFileHandle }->close();
72 3         154 return( $self->handleResumptionToken( 'listRecords' ) );
73             }
74              
75             ## get an object back from the store, thaw and return it
76 601         5687 my $record = fd_retrieve( $self->{ recordsFileHandle } );
77 601         236713 return( $record );
78             }
79              
80             =head2 metadataHandler()
81              
82             Returns the name of the package being used to represent the individual metadata
83             records. If unspecified it defaults to L which
84             should be ok.
85              
86             =cut
87              
88             sub metadataHandler {
89 0     0 1 0 my $self = shift;
90 0         0 return( $self->{ metadataHandler } );
91             }
92              
93             ## SAX Handlers
94              
95             sub start_element {
96 22919     22919 1 139090 my ( $self, $element ) = @_;
97              
98             ## if we are at the start of a new record then we need an empty
99             ## metadata object to fill up
100 22919 100       55728 if ( $element->{ Name } eq 'record' ) {
101             ## we store existing downstream handler so we can replace
102             ## it after we are done retrieving the metadata record
103 800         3547 $self->{ OLD_Handler } = $self->get_handler();
104             my $header = Net::OAI::Record::Header->new(
105             Handler => $self->{ metadataHandler }->new()
106 800         9662 );
107 800         2790 $self->set_handler( $header );
108             }
109 22919         76529 $self->SUPER::start_element( $element );
110             }
111              
112             sub end_element {
113 22919     22919 1 137820 my ( $self, $element ) = @_;
114 22919         62605 $self->SUPER::end_element( $element );
115              
116             ## if we've got to the end of the record we need to stash
117             ## away the object in our object store on disk
118 22919 100       142206 if ( $element->{ Name } eq 'record' ) {
    100          
119              
120             ## we need to swap out the existing metadata handler and freeze
121             ## it on disk
122 800         4793 my $header = $self->get_handler();
123 800         8300 my $metadata = $header->get_handler();
124 800         6772 $header->set_handler( undef ); ## remove reference to $record
125              
126             ## set handler to what is was before we started processing
127             ## the record
128 800         23541 $self->set_handler( $self->{ OLD_Handler } );
129 800         15962 my $record = Net::OAI::Record->new(
130             header => $header,
131             metadata => $metadata,
132             );
133              
134             ## commit the object to disk
135 800         5176 Net::OAI::Harvester::debug( "committing record to object store" );
136 800         6322 store_fd( $record, $self->{ recordsFileHandle } );
137             }
138              
139             ## otherwise if we got to the end of our list we can close
140             ## our object stash on disk
141             elsif ( $element->{ Name } eq 'ListRecords' ) {
142 4         46 $self->{ recordsFileHandle }->close();
143 4         538 $self->{ recordsFileHandle } = undef;
144             }
145              
146             }
147              
148             sub _fatal {
149 0     0     print STDERR "fatal: ", shift, "\n";
150 0           exit(1);
151             }
152              
153             1;
154              
155