File Coverage

blib/lib/HTTP/OAI/Harvester.pm
Criterion Covered Total %
statement 40 44 90.9
branch 9 14 64.2
condition 9 15 60.0
subroutine 13 13 100.0
pod 6 8 75.0
total 77 94 81.9


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