1use Test::More tests => 15;
2
3use strict;
4use warnings;
5$XML::SAX::ParserPackage = $XML::SAX::ParserPackage ||= $ENV{'NOH_ParserPackage'};
6
7use_ok( 'Net::OAI::Harvester' );
8
9## a good call
10
11my $repo = 'http://memory.loc.gov/cgi-bin/oai2_0';
12my $h = new_ok('Net::OAI::Harvester' => [ baseURL => $repo ]);
13
14my $i = $h->identify();
15isa_ok( $i, 'Net::OAI::Identify', 'identity()' );
16
17SKIP: {
18    my $HTE = HTE($i, $repo);
19    skip $HTE, 10 if $HTE;
20
21    ok( ! $i->errorCode(), 'errorCode()' );
22    ok( ! $i->errorString(), 'errorString()' );
23
24    subtest 'OAI request/response' => sub {
25        plan tests => 3;
26        like($i->responseDate(), qr/^\d{4}-\d\d-\d\dT\d\d:\d\d:\d\dZ$/, 'OAI responseDate element' );
27        my ($it, %ia) = $i->request();
28        is($it, $repo, 'OAI response element text' );
29        is($ia{ verb }, 'Identify', 'OAI verb' );
30      };
31
32    like( $i->repositoryName(), qr/Library of Congress/, 'repositoryName()');
33    like( $i->protocolVersion(), qr/^2\.0$/, 'protocolVersion()' );
34    like( $i->earliestDatestamp(), qr/^\d{4}-\d{2}-\d{2}/, 'earliestDatestamp()' );
35    like( $i->deletedRecord(), qr/yes|no/, 'deletedRecord()' );
36    like( $i->granularity(), qr/^YYYY/, 'granularity()' );
37
38    my $email = $i->adminEmail();
39    my @emails = $i->adminEmail();
40    like( $email, qr/@/, 'adminEmail() scalar context' );
41    like( $emails[0], qr/@/, 'adminEmail() list context' );
42
43## make sure we can call them, even though they are optional
44    my $compression = $i->compression();
45    my @compressions = $i->compression();
46}
47
48## make sure we don't get stuff from sub descriptions
49$repo = 'http://oaigateway.grainger.uiuc.edu/oai.asp';
50$h = new_ok('Net::OAI::Harvester' => [ baseURL => $repo ]);
51$i = $h->identify();
52
53SKIP: {
54    my $HTE = HTE($i, $repo);
55    skip $HTE, 1 if $HTE;
56
57    is( $i->repositoryName(),
58        'University of Illinois Library at Urbana-Champaign, OAI Gateway',
59        'do not extract sub descriptions and run them together'
60    );
61}
62
63sub HTE {
64    my ($r, $url) = @_;
65    my $hte;
66    if ( my $e = $r->HTTPError() ) {
67        $hte = "HTTP Error ".$e->status_line;
68	$hte .= " [Retry-After: ".$r->HTTPRetryAfter()."]" if $e->code() == 503;
69	diag("LWP condition accessing $url:\n$hte");
70        note explain $e;
71      }
72   return $hte;
73}
74
75