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