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   80 use base HTTP::OAI::UserAgent;
  11         34  
  11         1147  
4              
5 11     11   74 use strict;
  11         30  
  11         6240  
6              
7             our $VERSION = '4.13';
8              
9             sub new {
10 4     4 1 1161 my ($class,%args) = @_;
11 4         25 my %ARGS = %args;
12 4         23 delete @ARGS{qw(baseURL resume repository handlers onRecord)};
13 4         56 my $self = $class->SUPER::new(%ARGS);
14              
15 4         12912 $self->{doc} = XML::LibXML::Document->new( '1.0', 'UTF-8' );
16              
17 4 50       28 $self->{'resume'} = exists($args{resume}) ? $args{resume} : 1;
18              
19 4 50       16 if ($ENV{HTTP_OAI_AGENT}) {
20 0         0 $self->agent($ENV{HTTP_OAI_AGENT});
21             }
22             else {
23 4         24 $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     346 HTTP::OAI::Identify->new(baseURL=>$args{baseURL});
30 4 50 33     18 Carp::croak "Requires repository or baseURL" unless $self->repository and $self->repository->baseURL;
31              
32             # Canonicalise
33 4         68 $self->baseURL($self->baseURL);
34              
35 4         57 return $self;
36             }
37              
38 6     6 1 602 sub resume { shift->_elem('resume',@_) }
39 33     33 1 190 sub repository { shift->_elem('repository',@_) }
40              
41             sub baseURL {
42 18     18 0 56 my $self = shift;
43 18 100       74 return @_ ?
44             $self->repository->baseURL(URI->new(shift)->canonical) :
45             $self->repository->baseURL();
46             }
47 7     7 0 276 sub version { shift->repository->protocolVersion(@_); }
48              
49 1     1 1 307 sub ListIdentifiers { shift->_list( @_, verb => "ListIdentifiers" ); }
50 3     3 1 1063 sub ListRecords { shift->_list( @_, verb => "ListRecords" ); }
51 1     1 1 334 sub ListSets { shift->_list( @_, verb => "ListSets" ); }
52             sub _list
53             {
54 5     5   10 my $self = shift;
55              
56 5         15 local $self->{recursion};
57 5         26 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     25 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       98 $self->version( $r->version ) if $r->is_success;
74              
75 5         49 return $r;
76             }
77              
78             # build the methods for each OAI verb
79             foreach my $verb (qw( GetRecord Identify ListMetadataFormats ))
80             {
81 11     11   87 no strict "refs";
  11         26  
  11         1242  
82             *$verb = sub {
83 5     5   1726 my $self = shift;
84 5         14 local $self->{recursion};
85              
86 5         24 my $r = $self->_oai( @_, verb => $verb );
87              
88 5 100       28 $self->version( $r->version ) if $r->is_success;
89              
90 5         44 return $r;
91             };
92             }
93              
94             1;
95              
96             __END__