File Coverage

blib/lib/HTTP/OAI/Harvester.pm
Criterion Covered Total %
statement 39 42 92.8
branch 8 12 66.6
condition 9 15 60.0
subroutine 13 13 100.0
pod 6 8 75.0
total 75 90 83.3


line stmt bran cond sub pod time code
1             package HTTP::OAI::Harvester;
2              
3 11     11   84 use base HTTP::OAI::UserAgent;
  11         28  
  11         962  
4              
5 11     11   82 use strict;
  11         24  
  11         5669  
6              
7             our $VERSION = '4.11';
8              
9             sub new {
10 4     4 1 1575 my ($class,%args) = @_;
11 4         20 my %ARGS = %args;
12 4         22 delete @ARGS{qw(baseURL resume repository handlers onRecord)};
13 4         62 my $self = $class->SUPER::new(%ARGS);
14              
15 4         11962 $self->{doc} = XML::LibXML::Document->new( '1.0', 'UTF-8' );
16              
17 4 50       25 $self->{'resume'} = exists($args{resume}) ? $args{resume} : 1;
18              
19 4         28 $self->agent('OAI-PERL/'.$HTTP::OAI::VERSION);
20              
21             # Record the base URL this harvester instance is associated with
22             $self->{repository} =
23             $args{repository} ||
24 4   33     334 HTTP::OAI::Identify->new(baseURL=>$args{baseURL});
25 4 50 33     17 Carp::croak "Requires repository or baseURL" unless $self->repository and $self->repository->baseURL;
26              
27             # Canonicalise
28 4         53 $self->baseURL($self->baseURL);
29              
30 4         60 return $self;
31             }
32              
33 6     6 1 631 sub resume { shift->_elem('resume',@_) }
34 33     33 1 163 sub repository { shift->_elem('repository',@_) }
35              
36             sub baseURL {
37 18     18 0 74 my $self = shift;
38 18 100       64 return @_ ?
39             $self->repository->baseURL(URI->new(shift)->canonical) :
40             $self->repository->baseURL();
41             }
42 7     7 0 275 sub version { shift->repository->protocolVersion(@_); }
43              
44 1     1 1 316 sub ListIdentifiers { shift->_list( @_, verb => "ListIdentifiers" ); }
45 3     3 1 1174 sub ListRecords { shift->_list( @_, verb => "ListRecords" ); }
46 1     1 1 346 sub ListSets { shift->_list( @_, verb => "ListSets" ); }
47             sub _list
48             {
49 5     5   12 my $self = shift;
50              
51 5         12 local $self->{recursion};
52 5         35 my $r = $self->_oai( @_ );
53              
54             # resume the partial list?
55             # note: noRecordsMatch is a "success" but won't have a resumptionToken
56 5   66     27 RESUME: while($self->resume && $r->is_success && !$r->error && defined(my $token = $r->resumptionToken))
      100        
      66        
57             {
58 0 0       0 last RESUME if !$token->resumptionToken;
59 0         0 local $self->{recursion};
60             $r = $self->_oai(
61             onRecord => $r->{onRecord},
62 0         0 handlers => $r->handlers,
63             verb => $r->verb,
64             resumptionToken => $token->resumptionToken,
65             );
66             }
67              
68 5 100       97 $self->version( $r->version ) if $r->is_success;
69              
70 5         93 return $r;
71             }
72              
73             # build the methods for each OAI verb
74             foreach my $verb (qw( GetRecord Identify ListMetadataFormats ))
75             {
76 11     11   90 no strict "refs";
  11         25  
  11         1311  
77             *$verb = sub {
78 5     5   1721 my $self = shift;
79 5         15 local $self->{recursion};
80              
81 5         33 my $r = $self->_oai( @_, verb => $verb );
82              
83 5 100       22 $self->version( $r->version ) if $r->is_success;
84              
85 5         61 return $r;
86             };
87             }
88              
89             1;
90              
91             __END__