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 9my $header1 = new_ok('Net::OAI::Record::Header'); 10 11# basic attributes 12 13$header1->status( 'deleted' ); 14is( $header1->status(), 'deleted', 'status()' ); 15 16$header1->identifier( 'xxx' ); 17is( $header1->identifier(), 'xxx', 'identifier()' ); 18 19$header1->datestamp( 'May-28-1969' ); 20is( $header1->datestamp(), 'May-28-1969', 'datestatmp()' ); 21 22$header1->setSpecs( 'foo', 'bar' ); 23my @sets1 = $header1->setSpecs(); 24is( scalar(@sets1), 2, 'setSpecs() 1' ); 25is( $sets1[0], 'foo', 'setSpecs() 2' ); 26is( $sets1[1], 'bar', 'setSpecs() 3' ); 27 28## fetch a record and see what the status is 29## this may need to be changed over time 30 31use_ok( 'Net::OAI::Harvester' ); 32 33my $id = 'oai:eprints.dcs.warwick.ac.uk:399'; 34my $repo = 'http://eprints.dcs.warwick.ac.uk/cgi/oai2'; 35 36my $h = new_ok('Net::OAI::Harvester' => [ baseURL => $repo ]); 37 38# this will fetch < http://eprints.dcs.warwick.ac.uk/cgi/oai2?verb=GetRecord&metadataPrefix=oai_dc&identifier=oai:eprints.dcs.warwick.ac.uk:399 > 39# which hopefully exists and is an deleted record 40my $r = $h->getRecord( identifier => $id, metadataPrefix => 'oai_dc' ); 41 42SKIP: { 43 my $HTE = HTE($r, $repo); 44 skip $HTE, 5 if $HTE; 45 46 ok( ! $r->errorCode(), "errorCode()" ); 47 ok( ! $r->errorString(), "errorString()" ); 48 49 subtest 'OAI request/response' => sub { 50 plan tests => 5; 51 like($r->responseDate(), qr/^\d{4}-\d\d-\d\dT\d\d:\d\d:\d\dZ$/, 'OAI responseDate element' ); 52 53 is($r->request(), $repo, 'scalar OAI response element text' ); 54 my ($rr, %ra) = $r->request(); 55 is($rr, $repo, 'OAI response element text' ); 56 is($ra{ verb }, 'GetRecord', 'OAI verb' ); 57 is($ra{ identifier }, $id, 'OAI identifier' ); 58 }; 59 60 my $header = $r->header(); 61 is( $header->identifier, $id, 'identifier()' ); 62 is( $header->status(), 'deleted', 'status' ); 63} 64 65 66sub HTE { 67 my ($r, $url) = @_; 68 my $hte; 69 if ( my $e = $r->HTTPError() ) { 70 $hte = "HTTP Error ".$e->status_line; 71 $hte .= " [Retry-After: ".$r->HTTPRetryAfter()."]" if $e->code() == 503; 72 diag("LWP condition accessing $url:\n$hte"); 73 note explain $e; 74 } 75 return $hte; 76} 77 78