diff -Nru libhttp-oai-perl-3.27/bin/oai_browser.pl libhttp-oai-perl-4.03/bin/oai_browser.pl --- libhttp-oai-perl-3.27/bin/oai_browser.pl 2011-08-04 13:40:01.000000000 +0000 +++ libhttp-oai-perl-4.03/bin/oai_browser.pl 2014-04-03 12:45:44.000000000 +0000 @@ -53,7 +53,7 @@ unshift @INC, "."; } -use vars qw($VERSION $PROTOCOL_VERSION $h); +use vars qw($VERSION $h); use lib "../lib"; use lib "lib"; @@ -117,7 +117,7 @@ print < +Copyright 2005-2012 Tim Brody Use CTRL+C to quit at any time @@ -137,14 +137,10 @@ $h = new HTTP::OAI::Harvester(baseURL=>$burl); last if $opt_skip_identify; if( my $id = Identify() ) { - $h->repository($id); - $PROTOCOL_VERSION = $id->version; last; } } -my $archive = $h->repository; - &mainloop(); sub mainloop { @@ -202,7 +198,7 @@ print "setSpec => ", $_, "\n"; } print "\nHeader:\n", - $rec->header->dom->toString; + $rec->header->toString; print "\nMetadata:\n", $rec->metadata->toString if defined($rec->metadata); print "\nAbout data:\n", @@ -225,7 +221,7 @@ "repositoryName => ", $r->repositoryName, "\n"; foreach my $dom (grep { defined } map { $_->dom } $r->description) { - foreach my $md ($dom->getElementsByTagNameNS('http://www.openarchives.org/OAI/2.0/oai-identifier','oai-identifier')) { + foreach my $md ($dom->firstChild) { foreach my $elem ($md->getElementsByTagNameNS('http://www.openarchives.org/OAI/2.0/oai-identifier','sampleIdentifier')) { $DEFAULTID = $elem->getFirstChild->toString; print "sampleIdentifier => ", $DEFAULTID, "\n"; diff -Nru libhttp-oai-perl-3.27/bin/oai_pmh.pl libhttp-oai-perl-4.03/bin/oai_pmh.pl --- libhttp-oai-perl-3.27/bin/oai_pmh.pl 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/bin/oai_pmh.pl 2014-04-03 12:45:44.000000000 +0000 @@ -0,0 +1,152 @@ +#!/usr/bin/perl + +use encoding 'utf8'; + +use HTTP::OAI; +use Getopt::Long; +use Pod::Usage; +use XML::LibXML; + +=head1 NAME + +oai_pmh.pl - pipe OAI-PMH to the command-line + +=head1 SYNOPSIS + + oai_pmh.pl [baseURL] + +=head1 OPTIONS + +=over 8 + +=item --help + +=item --man + +=item --verbose + +Be more verbose (repeatable). + +=item --force + +Force a non-conformant OAI request. + +=item --from + +=item --identifier + +OAI identifier to GetRecord or ListMetadataFormats. + +=item --metadataPrefix + +Specify format of metadata to retrieve. + +=item -X/--request + +Verb to request, defaults to ListRecords. + +=item --set + +Request only those records in a set. + +=item --until + +=back + +=head1 DESCRIPTION + +Retrieve data from OAI-PMH endpoints. The output format is: + + + + + + +Where are in HTTP header format. Content will be the raw XML as exposed by the repository. Each record is separated by a FORMFEED character. + +For example: + + oai_pmh.pl -X GetRecord --metadataPrefix oai_dc \ + --identifier oai:eprints.soton.ac.uk:20 http://eprints.soton.ac.uk/cgi/oai2 + +=cut + +my %opts = ( + verbose => 1, +); + +GetOptions(\%opts, + 'help', + 'man', + 'metadataPrefix=s', + 'request|X=s', + 'identifier=s', + 'verbose+', + 'force', + 'from=s', + 'until=s', +) or pod2usage(2); +pod2usage(1) if $opts{help}; +pod2usage({-verbose => 2}) if $opts{man}; + +my $noise = delete $opts{verbose}; + +if (!exists $opts{request}) { + $opts{request} = 'ListRecords'; + $opts{metadataPrefix} = 'oai_dc'; +} + +my $base_url = pop @ARGV; +pod2usage(1) if !$base_url; + +my $ha = HTTP::OAI::Harvester->new(baseURL => $base_url); + +my $f = delete $opts{request}; +debug("Requesting $f", 2); +my $r = $ha->$f( + %opts, + onRecord => \&output_record, +); +if( $f eq "ListMetadataFormats" ) +{ + foreach my $mdf ($r->metadataFormat) { + print "metadataPrefix: " . $mdf->metadataPrefix . "\n"; + print "schema: " . $mdf->schema . "\n"; + print "metadataNamespace: " . $mdf->metadataNamespace . "\n"; + print "\n"; + print "\f"; + } +} + +if( !$r->is_success ) +{ + die "Error in response: " . $r->message . "\n"; +} + +sub debug +{ + my( $msg, $level ) = @_; + + warn "$msg\n" if $noise >= $level; +} + +sub output_record +{ + my( $rec ) = @_; + + my $header = $rec->isa( 'HTTP::OAI::Header' ) ? $rec : $rec->header; + + print "identifier: " . $header->identifier . "\n"; + print "datestamp: " . $header->datestamp . "\n"; + print "status: " . $header->status . "\n"; + foreach my $set ($header->setSpec) { + print "setSpec: " . $set . "\n"; + } + print "\n"; + + if ($rec->can( "metadata" ) && defined(my $metadata = $rec->metadata)) { + print $metadata->dom->toString( 1 ); + } + + print "\f"; +} diff -Nru libhttp-oai-perl-3.27/CHANGES libhttp-oai-perl-4.03/CHANGES --- libhttp-oai-perl-3.27/CHANGES 2011-08-04 14:25:53.000000000 +0000 +++ libhttp-oai-perl-4.03/CHANGES 2014-04-07 12:04:04.000000000 +0000 @@ -1,3 +1,17 @@ +4.03 + - Fixed MANIFEST [phochste] + +4.02 + - Fixed namespace issue with ResumptionToken.pm [sebastfr] + +4.01 + - Reworked API to use DocumentFragments + - Various speed improvements + - Added bin/oai_pmh.pl CLI tool + +3.28 + - Fixed parsing elements that contain multiple child nodes + 3.26 - Added 'delay' option to delay between requests - Added --skip-identify option to oai_browser.pl diff -Nru libhttp-oai-perl-3.27/debian/changelog libhttp-oai-perl-4.03/debian/changelog --- libhttp-oai-perl-3.27/debian/changelog 2011-08-05 20:55:33.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/changelog 2015-06-20 00:13:08.000000000 +0000 @@ -1,3 +1,45 @@ +libhttp-oai-perl (4.03-1) unstable; urgency=low + + * Team upload. + + [ Fabrizio Regalli ] + * Imported Upstream version 3.28 + * Bump to 3.9.3 Standard-Version + * debian/copyright: update to Copyright-Format 1.0 + * debian/copyright: add 2012 year to debian/* files + * debian/control: add libxml-sax-base-perl to B-D-I and Depends + + [ gregor herrmann ] + * debian/control: update {versioned,alternative} (build) dependencies. + + [ Salvatore Bonaccorso ] + * Change Vcs-Git to canonical URI (git://anonscm.debian.org) + * Change search.cpan.org based URIs to metacpan.org based URIs + + [ gregor herrmann ] + * Strip trailing slash from metacpan URLs. + + [ Harlan Lieberman-Berg ] + * Imported Upstream version 4.03 + Closes: #789337 + * Bump S-V and compat to latest. + * Update copyright year in d/*. + * Support new executable script. + * Fix up POD errors. + + [ Salvatore Bonaccorso ] + * Update Vcs-Browser URL to cgit web frontend + + [ gregor herrmann ] + * Add debian/upstream/metadata. + * Update years of upstream copyright. + * Update license short names in debian/copyright. Thanks to lintian. + * Mark package as autopkgtest-able. + * Declare compliance with Debian Policy 3.9.6. + * Add dependency on libcgi-pm-perl. + + -- gregor herrmann Sat, 20 Jun 2015 02:13:00 +0200 + libhttp-oai-perl (3.27-1) unstable; urgency=low [ Harlan Lieberman-Berg ] diff -Nru libhttp-oai-perl-3.27/debian/compat libhttp-oai-perl-4.03/debian/compat --- libhttp-oai-perl-3.27/debian/compat 2011-08-05 20:55:33.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/compat 2015-06-20 00:13:08.000000000 +0000 @@ -1 +1 @@ -8 +9 diff -Nru libhttp-oai-perl-3.27/debian/control libhttp-oai-perl-4.03/debian/control --- libhttp-oai-perl-3.27/debian/control 2011-08-05 20:55:33.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/control 2015-06-20 00:13:08.000000000 +0000 @@ -1,31 +1,36 @@ Source: libhttp-oai-perl +Maintainer: Debian Perl Group +Uploaders: Robin Sheat , + Chris Butler , + Fabrizio Regalli , + Harlan Lieberman-Berg Section: perl +Testsuite: autopkgtest-pkg-perl Priority: optional -Build-Depends: debhelper (>= 8) +Build-Depends: debhelper (>= 9) Build-Depends-Indep: libhttp-message-perl, - liburi-perl, - libwww-perl, - libxml-libxml-perl, - libxml-sax-perl (>= 0.96), - perl -Maintainer: Debian Perl Group -Uploaders: Robin Sheat , - Chris Butler , - Fabrizio Regalli , - Harlan Lieberman-Berg -Standards-Version: 3.9.2 -Homepage: http://search.cpan.org/dist/HTTP-OAI/ -Vcs-Git: git://git.debian.org/pkg-perl/packages/libhttp-oai-perl.git -Vcs-Browser: http://anonscm.debian.org/gitweb/?p=pkg-perl/packages/libhttp-oai-perl.git + liburi-perl, + libwww-perl, + libxml-libxml-perl, + libxml-sax-base-perl, + libxml-sax-perl, + perl +Standards-Version: 3.9.6 +Vcs-Browser: https://anonscm.debian.org/cgit/pkg-perl/packages/libhttp-oai-perl.git +Vcs-Git: git://anonscm.debian.org/pkg-perl/packages/libhttp-oai-perl.git +Homepage: https://metacpan.org/release/HTTP-OAI Package: libhttp-oai-perl Architecture: all -Depends: ${misc:Depends}, ${perl:Depends}, - libhttp-message-perl, - liburi-perl, - libwww-perl, - libxml-libxml-perl, - libxml-sax-perl (>= 0.96) +Depends: ${misc:Depends}, + ${perl:Depends}, + libcgi-pm-perl | perl (<< 5.19), + libhttp-message-perl, + liburi-perl, + libwww-perl, + libxml-libxml-perl, + libxml-sax-base-perl, + libxml-sax-perl Description: API for the OAI-PMH HTTP::OAI is a Perl library implementing an API to use the Open Archives Initiative Protocol for Metadata Harvesting (OAI-PMH). See diff -Nru libhttp-oai-perl-3.27/debian/copyright libhttp-oai-perl-4.03/debian/copyright --- libhttp-oai-perl-3.27/debian/copyright 2011-08-05 20:55:33.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/copyright 2015-06-20 00:13:08.000000000 +0000 @@ -1,11 +1,11 @@ -Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135 -Maintainer: Timothy D Brody -Source: http://search.cpan.org/dist/HTTP-OAI/ -Name: HTTP-OAI +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Contact: Timothy D Brody +Source: https://metacpan.org/release/HTTP-OAI +Upstream-Name: HTTP-OAI Files: * -Copyright: 2004-2010, Timothy D Brody -License: BSD +Copyright: 2004-2012, Timothy D Brody +License: BSD-3-clause All rights reserved. . Redistribution and use in source and binary forms, with or without @@ -35,9 +35,9 @@ Files: debian/* Copyright: 2010, Lars Wirzenius 2011, Chris Butler - 2011, Fabrizio Regalli - 2011, Harlan Lieberman-Berg -License: GPL3+ + 2011-2012, Fabrizio Regalli + 2011, 2014, Harlan Lieberman-Berg +License: GPL-3+ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or diff -Nru libhttp-oai-perl-3.27/debian/patches/fix-pod-errors.patch libhttp-oai-perl-4.03/debian/patches/fix-pod-errors.patch --- libhttp-oai-perl-3.27/debian/patches/fix-pod-errors.patch 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/patches/fix-pod-errors.patch 2015-06-20 00:13:08.000000000 +0000 @@ -0,0 +1,47 @@ +Description: Fix POD Errors +Author: Harlan Lieberman-Berg +Bug: https://rt.cpan.org/Public/Bug/Display.html?id=94864 +Last-Update: 2014-04-18 + +--- a/bin/oai_browser.pl ++++ b/bin/oai_browser.pl +@@ -47,6 +47,8 @@ + + Don't perform an initial Identify to check the repository's baseURL. + ++=back ++ + =cut + + BEGIN { +--- a/lib/HTTP/OAI/MemberMixin.pm ++++ b/lib/HTTP/OAI/MemberMixin.pm +@@ -28,7 +28,7 @@ + + =head1 NAME + +-HTTP::OAI::MemberMixin ++HTTP::OAI::MemberMixin - Attribute utility methods + + =head1 DESCRIPTION + +@@ -47,3 +47,8 @@ + Same as L but if you pass a non-ARRAY reference appends the given value(s). + + In list context returns a list of all the items. ++ ++=back ++ ++=cut ++ +--- a/lib/HTTP/OAI/SAX/Text.pm ++++ b/lib/HTTP/OAI/SAX/Text.pm +@@ -38,7 +38,7 @@ + + =head1 NAME + +-HTTP::OAI::SAX::Text ++HTTP::OAI::SAX::Text - Adds Text and Attributes to end_element. + + =head1 DESCRIPTION + diff -Nru libhttp-oai-perl-3.27/debian/patches/series libhttp-oai-perl-4.03/debian/patches/series --- libhttp-oai-perl-3.27/debian/patches/series 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/patches/series 2015-06-20 00:13:08.000000000 +0000 @@ -0,0 +1 @@ +fix-pod-errors.patch diff -Nru libhttp-oai-perl-3.27/debian/rules libhttp-oai-perl-4.03/debian/rules --- libhttp-oai-perl-3.27/debian/rules 2011-08-05 20:55:33.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/rules 2015-06-20 00:13:08.000000000 +0000 @@ -9,5 +9,8 @@ override_dh_auto_install: dh_auto_install mv $(TMP)/usr/bin/oai_browser.pl $(TMP)/usr/bin/oai_browser + mv $(TMP)/usr/bin/oai_pmh.pl $(TMP)/usr/bin/oai_pmh mv $(TMP)/usr/share/man/man1/oai_browser.pl.1p \ $(TMP)/usr/share/man/man1/oai_browser.1p + mv $(TMP)/usr/share/man/man1/oai_pmh.pl.1p \ + $(TMP)/usr/share/man/man1/oai_pmh.1p diff -Nru libhttp-oai-perl-3.27/debian/tests/pkg-perl/skip-syntax libhttp-oai-perl-4.03/debian/tests/pkg-perl/skip-syntax --- libhttp-oai-perl-3.27/debian/tests/pkg-perl/skip-syntax 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/tests/pkg-perl/skip-syntax 2015-06-20 00:13:08.000000000 +0000 @@ -0,0 +1,6 @@ +# stumbles over Carp::confess ?! +# needs investigation +HTTP/OAI/Harvester.pm +HTTP/OAI/UserAgent.pm +HTTP/OAI/Metadata.pm +HTTP/OAI/Metadata/METS.pm diff -Nru libhttp-oai-perl-3.27/debian/tests/pkg-perl/test-files libhttp-oai-perl-4.03/debian/tests/pkg-perl/test-files --- libhttp-oai-perl-3.27/debian/tests/pkg-perl/test-files 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/tests/pkg-perl/test-files 2015-06-20 00:13:08.000000000 +0000 @@ -0,0 +1,2 @@ +t/ +examples/ diff -Nru libhttp-oai-perl-3.27/debian/upstream/metadata libhttp-oai-perl-4.03/debian/upstream/metadata --- libhttp-oai-perl-3.27/debian/upstream/metadata 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/upstream/metadata 2015-06-20 00:13:08.000000000 +0000 @@ -0,0 +1,5 @@ +--- +Archive: CPAN +Name: HTTP-OAI +Repository: git://github.com/timbrody/perl-oai-lib.git + diff -Nru libhttp-oai-perl-3.27/debian/watch libhttp-oai-perl-4.03/debian/watch --- libhttp-oai-perl-3.27/debian/watch 2011-08-05 20:55:33.000000000 +0000 +++ libhttp-oai-perl-4.03/debian/watch 2015-06-20 00:13:08.000000000 +0000 @@ -1,2 +1,2 @@ version=3 -http://search.cpan.org/dist/HTTP-OAI/ .*/HTTP-OAI-v?(\d[\d.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ +https://metacpan.org/release/HTTP-OAI .*/HTTP-OAI-v?(\d[\d.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Error.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Error.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Error.pm 2007-06-28 11:16:40.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Error.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,20 +1,10 @@ package HTTP::OAI::Error; -use strict; -use warnings; - -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAG); - -use vars qw( - $PARSER -); - -$PARSER = 600; +@ISA = qw( HTTP::OAI::SAX::Base HTTP::OAI::MemberMixin Exporter ); -use Exporter; -use HTTP::OAI::SAXHandler qw( :SAX ); +use strict; -@ISA = qw(HTTP::OAI::Encapsulation Exporter); +use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAG); @EXPORT = qw(); @EXPORT_OK = qw(%OAI_ERRORS); @@ -32,43 +22,39 @@ noSetHierarchy => 'The repository does not support sets.' ); -sub new { - my ($class,%args) = @_; - my $self = $class->SUPER::new(%args); +sub new +{ + my( $class, %self ) = @_; - $self->code($args{code}); - $self->message($args{message}); + $self{message} ||= $OAI_ERRORS{$self{code}} if $self{code}; - $self; + return $class->SUPER::new(%self); } sub code { shift->_elem('code',@_) } sub message { shift->_elem('message',@_) } -sub toString { - my $self = shift; - return $self->code . " (\"" . ($self->message || 'No further information available') . "\")"; +sub generate +{ + my( $self, $driver ) = @_; + + $driver->data_element( 'error', ($self->message || $OAI_ERRORS{$self->code} || ''), + code => $self->code, + ); } -sub generate { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - Carp::croak ref($self)."::generate Error code undefined" unless defined($self->code); - - g_data_element($handler, - 'http://www.openarchives.org/OAI/2.0/', - 'error', - { - '{}code'=>{ - 'LocalName' => 'code', - 'Prefix' => '', - 'Value' => $self->code, - 'Name' => 'code', - 'NamespaceURI' => '', - }, - }, - ($self->message || $OAI_ERRORS{$self->code} || '') - ); +sub start_element +{ + my( $self, $hash ) = @_; + + $self->code( $hash->{Attributes}->{'{}code'}->{Value} ); +} + +sub characters +{ + my( $self, $hash ) = @_; + + $self->message( $hash->{Data} ); } 1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/GetRecord.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/GetRecord.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/GetRecord.pm 2007-06-28 11:16:40.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/GetRecord.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,74 +1,22 @@ package HTTP::OAI::GetRecord; -use strict; -use warnings; - -use HTTP::OAI::SAXHandler qw/ :SAX /; - -use vars qw(@ISA); - -@ISA = qw( HTTP::OAI::Response ); - -sub new { - my ($class,%args) = @_; - - $args{handlers} ||= {}; - $args{handlers}->{header} ||= "HTTP::OAI::Header"; - $args{handlers}->{metadata} ||= "HTTP::OAI::Metadata"; - $args{handlers}->{about} ||= "HTTP::OAI::Metadata"; - - my $self = $class->SUPER::new(%args); - - $self->verb('GetRecord') unless $self->verb; - - $self->{record} ||= []; - $self->record($args{record}) if defined($args{record}); +require HTTP::OAI::ListRecords; +@ISA = qw( HTTP::OAI::ListRecords ); - return $self; -} +use strict; -sub record { +sub record +{ my $self = shift; - $self->{record} = [shift] if @_; - return wantarray ? - @{$self->{record}} : - $self->{record}->[0]; + $self->{item} = [@_] if @_; + return $self->{item}->[0]; } -sub next { shift @{shift->{record}} } sub generate_body { - my ($self) = @_; + my ($self, $driver) = @_; for( $self->record ) { - $_->set_handler($self->get_handler); - $_->generate; - } -} - -sub start_element { - my ($self,$hash) = @_; - my $elem = $hash->{LocalName}; - if( $elem eq 'record' && !exists($self->{"in_record"}) ) { - $self->{OLDHandler} = $self->get_handler; - my $rec = HTTP::OAI::Record->new( - version=>$self->version, - handlers=>$self->{handlers}, - ); - $self->record($rec); - $self->set_handler($rec); - $self->{"in_record"} = $hash->{Depth}; - } - $self->SUPER::start_element($hash); -} - -sub end_element { - my ($self,$hash) = @_; - $self->SUPER::end_element($hash); - my $elem = lc($hash->{LocalName}); - if( $elem eq 'record' && - exists($self->{"in_record"}) && - $self->{"in_record"} == $hash->{Depth} ) { - $self->set_handler($self->{OLDHandler}); + $_->generate( $driver ); } } diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Harvester.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Harvester.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Harvester.pm 2011-06-23 13:36:15.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Harvester.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,11 +1,8 @@ package HTTP::OAI::Harvester; -use strict; -use warnings; - -use vars qw( @ISA ); +use base HTTP::OAI::UserAgent; -@ISA = qw( HTTP::OAI::UserAgent ); +use strict; sub new { my ($class,%args) = @_; @@ -13,9 +10,10 @@ delete @ARGS{qw(baseURL resume repository handlers onRecord)}; my $self = $class->SUPER::new(%ARGS); + $self->{doc} = XML::LibXML::Document->new( '1.0', 'UTF-8' ); + $self->{'resume'} = exists($args{resume}) ? $args{resume} : 1; - $self->{'handlers'} = $args{'handlers'}; - $self->{'onRecord'} = $args{'onRecord'}; + $self->agent('OAI-PERL/'.$HTTP::OAI::VERSION); # Record the base URL this harvester instance is associated with @@ -23,38 +21,15 @@ $args{repository} || HTTP::OAI::Identify->new(baseURL=>$args{baseURL}); Carp::croak "Requires repository or baseURL" unless $self->repository and $self->repository->baseURL; + # Canonicalise $self->baseURL($self->baseURL); return $self; } -sub resume { - my $self = shift; - return @_ ? $self->{resume} = shift : $self->{resume}; -} - -sub repository { - my $self = shift; - return $self->{repository} unless @_; - my $id = shift; - # Don't clobber a good existing base URL with a bad one - if( $self->{repository} && $self->{repository}->baseURL ) { - if( !$id->baseURL ) { - Carp::carp "Attempt to set a non-existant baseURL"; - $id->baseURL($self->baseURL); - } else { - my $uri = URI->new($id->baseURL); - if( $uri && $uri->scheme ) { - $id->baseURL($uri->canonical); - } else { - Carp::carp "Ignoring attempt to use an invalid base URL: " . $id->baseURL; - $id->baseURL($self->baseURL); - } - } - } - return $self->{repository} = $id; -} +sub resume { shift->_elem('resume',@_) } +sub repository { shift->_elem('repository',@_) } sub baseURL { my $self = shift; @@ -62,162 +37,51 @@ $self->repository->baseURL(URI->new(shift)->canonical) : $self->repository->baseURL(); } +sub version { shift->repository->protocolVersion(@_); } -sub version { shift->repository->version(@_); } - -# build the methods for each OAI verb -foreach my $verb (qw( GetRecord Identify ListIdentifiers ListMetadataFormats ListRecords ListSets )) +sub ListIdentifiers { shift->_list( @_, verb => "ListIdentifiers" ); } +sub ListRecords { shift->_list( @_, verb => "ListRecords" ); } +sub ListSets { shift->_list( @_, verb => "ListSets" ); } +sub _list { - no strict "refs"; - *$verb = sub { shift->_oai( verb => $verb, @_ )}; -} - -sub _oai { - my( $self, %args ) = @_; - - my $verb = $args{verb} or Carp::croak "Requires verb argument"; + my $self = shift; - my $handlers = delete($args{handlers}) || $self->{'handlers'}; - my $onRecord = delete($args{onRecord}) || $self->{'onRecord'}; + local $self->{recursion}; + my $r = $self->_oai( @_ ); - if( !$args{force} && - defined($self->repository->version) && - '2.0' eq $self->repository->version && - (my @errors = HTTP::OAI::Repository::validate_request(%args)) ) { - return new HTTP::OAI::Response( - code=>503, - message=>'Invalid Request (use \'force\' to force a non-conformant request): ' . $errors[0]->toString, - errors=>\@errors + # resume the partial list? + # note: noRecordsMatch is a "success" but won't have a resumptionToken + RESUME: while($self->resume && $r->is_success && !$r->error && defined(my $token = $r->resumptionToken)) + { + last RESUME if !$token->resumptionToken; + local $self->{recursion}; + $r = $self->_oai( + $r->{onRecord}, + handlers => $r->handlers, + verb => $r->verb, + resumptionToken => $token->resumptionToken, ); } - delete $args{force}; - # Get rid of any empty arguments - for( keys %args ) { - delete $args{$_} if !defined($args{$_}) || !length($args{$_}); - } + $self->version( $r->version ) if $r->is_success; - # Check for a static repository (sets _static) - if( !$self->{_interogated} ) { - $self->interogate(); - $self->{_interogated} = 1; - } - - if( 'ListIdentifiers' eq $verb && - defined($self->repository->version) && - '1.1' eq $self->repository->version ) { - delete $args{metadataPrefix}; - } - - my $r = "HTTP::OAI::$verb"->new( - harvestAgent => $self, - resume => $self->resume, - handlers => $handlers, - onRecord => $onRecord, - ); - $r->headers->{_args} = \%args; - - # Parse all the records if _static set - if( defined($self->{_static}) && !defined($self->{_records}) ) { - my $lmdf = HTTP::OAI::ListMetadataFormats->new( - handlers => $handlers, - ); - $lmdf->headers->{_args} = { - %args, - verb=>'ListMetadataFormats', - }; - # Find the metadata formats - $lmdf = $lmdf->parse_string($self->{_static}); - return $lmdf unless $lmdf->is_success; - @{$self->{_formats}} = $lmdf->metadataFormat; - # Extract all records - $self->{_records} = {}; - for($lmdf->metadataFormat) { - my $lr = HTTP::OAI::ListRecords->new( - handlers => $handlers, - ); - $lr->headers->{_args} = { - %args, - verb=>'ListRecords', - metadataPrefix=>$_->metadataPrefix, - }; - $lr->parse_string($self->{_static}); - return $lr if !$lr->is_success; - @{$self->{_records}->{$_->metadataPrefix}} = $lr->record; - } - undef($self->{_static}); - } - - # Make the remote request and return the result - if( !defined($self->{_records}) ) { - $r = $self->request({baseURL=>$self->baseURL,%args},undef,undef,undef,$r); - # Lets call next() for the user if she's using the callback interface - if( $onRecord and $r->is_success and $r->isa("HTTP::OAI::PartialList") ) { - $r->next; - } - return $r; - # Parse our memory copy of the static repository - } else { - $r->code(200); - # Format doesn't exist - if( $verb =~ /^GetRecord|ListIdentifiers|ListRecords$/ && - !exists($self->{_records}->{$args{metadataPrefix}}) ) { - $r->code(600); - $r->errors(HTTP::OAI::Error->new( - code=>'cannotDisseminateFormat', - )); - # GetRecord - } elsif( $verb eq 'GetRecord' ) { - for(@{$self->{_records}->{$args{metadataPrefix}}}) { - if( $_->identifier eq $args{identifier} ) { - $r->record($_); - return $r; - } - } - $r->code(600); - $r->errors(HTTP::OAI::Error->new( - code=>'idDoesNotExist' - )); - # Identify - } elsif( $verb eq 'Identify' ) { - $r = $self->repository(); - # ListIdentifiers - } elsif( $verb eq 'ListIdentifiers' ) { - $r->identifier(map { $_->header } @{$self->{_records}->{$args{metadataPrefix}}}) - # ListMetadataFormats - } elsif( $verb eq 'ListMetadataFormats' ) { - $r->metadataFormat(@{$self->{_formats}}); - # ListRecords - } elsif( $verb eq 'ListRecords' ) { - $r->record(@{$self->{_records}->{$args{metadataPrefix}}}); - # ListSets - } elsif( $verb eq 'ListSets' ) { - $r->errors(HTTP::OAI::Error->new( - code=>'noSetHierarchy', - message=>'Static Repositories do not support sets', - )); - } - return $r; - } + return $r; } -sub interogate { - my $self = shift; - Carp::croak "Requires baseURL" unless $self->baseURL; - -HTTP::OAI::Debug::trace($self->baseURL); - my $r = $self->request(HTTP::Request->new(GET => $self->baseURL)); - return unless length($r->content); - my $id = HTTP::OAI::Identify->new( - handlers=>$self->{handlers}, - ); - $id->headers->{_args} = {verb=>'Identify'}; - $id->parse_string($r->content); - if( $id->is_success && $id->version eq '2.0s' ) { - $self->{_static} = $r->content; - $self->repository($id); - } -HTTP::OAI::Debug::trace("version = ".$id->version) if $id->is_success; +# build the methods for each OAI verb +foreach my $verb (qw( GetRecord Identify ListMetadataFormats )) +{ + no strict "refs"; + *$verb = sub { + my $self = shift; + local $self->{recursion}; + + my $r = $self->_oai( @_, verb => $verb ); + + $self->version( $r->version ) if $r->is_success; + + return $r; + }; } 1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Header.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Header.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Header.pm 2011-06-24 10:54:27.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Header.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,30 +1,12 @@ package HTTP::OAI::Header; +@ISA = qw( HTTP::OAI::MemberMixin HTTP::OAI::SAX::Base ); + use strict; -use warnings; use POSIX qw/strftime/; -use vars qw(@ISA); - -use HTTP::OAI::SAXHandler qw( :SAX ); - -@ISA = qw(HTTP::OAI::Encapsulation); - -sub new { - my ($class,%args) = @_; - my $self = $class->SUPER::new(%args); - - $self->identifier($args{identifier}) unless $self->identifier; - $self->datestamp($args{datestamp}) unless $self->datestamp; - $self->status($args{status}) unless $self->status; - $self->{setSpec} ||= $args{setSpec} || []; - - $self; -} - sub identifier { shift->_elem('identifier',@_) } -sub now { return strftime("%Y-%m-%dT%H:%M:%SZ",gmtime()) } sub datestamp { my $self = shift; return $self->_elem('datestamp') unless @_; @@ -36,58 +18,29 @@ } return $self->_elem('datestamp',$ds); } -sub status { shift->_attr('status',@_) } -sub is_deleted { my $s = shift->status(); return defined($s) && $s eq 'deleted'; } +sub status { shift->_elem('status',@_) } +sub setSpec { shift->_multi('setSpec',@_) } -sub setSpec { - my $self = shift; - push(@{$self->{setSpec}},@_); - @{$self->{setSpec}}; -} +sub now { return strftime("%Y-%m-%dT%H:%M:%SZ",gmtime()) } -sub dom { - my $self = shift; - if( my $dom = shift ) { - my $driver = XML::LibXML::SAX::Parser->new( - Handler=>HTTP::OAI::SAXHandler->new( - Handler=>$self - )); - $driver->generate($dom->ownerDocument); - } else { - $self->set_handler(my $builder = XML::LibXML::SAX::Builder->new()); - g_start_document($self); - $self->xml_decl({'Version'=>'1.0','Encoding'=>'UTF-8'}); - $self->characters({'Data'=>"\n"}); - $self->generate(); - $self->end_document(); - return $builder->result; - } -} +sub is_deleted { my $s = shift->status(); return defined($s) && $s eq 'deleted'; } -sub generate { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); +sub generate +{ + my ($self, $driver) = @_; if( defined($self->status) ) { - g_start_element($handler,'http://www.openarchives.org/OAI/2.0/','header', - { - "{}status"=>{ - 'Name'=>'status', - 'LocalName'=>'status', - 'Value'=>$self->status, - 'Prefix'=>'', - 'NamespaceURI'=>'' - } - }); + $driver->start_element( 'header', status => $self->status ); } else { - g_start_element($handler,'http://www.openarchives.org/OAI/2.0/','header',{}); + $driver->start_element( 'header' ); } - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','identifier',{},$self->identifier); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','datestamp',{},($self->datestamp || $self->now)); - for($self->setSpec) { - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','setSpec',{},$_); + $driver->data_element( 'identifier', $self->identifier ); + $driver->data_element( 'datestamp', ($self->datestamp || $self->now) ); + for($self->setSpec) + { + $driver->data_element( 'setSpec', $_ ); } - g_end_element($handler,'http://www.openarchives.org/OAI/2.0/','header'); + $driver->end_element( 'header' ); } sub end_element { @@ -100,10 +53,8 @@ $text =~ s/\s+$//; } if( $elem eq 'identifier' ) { - die "HTTP::OAI::Header parse error: Empty identifier\n" unless $text; $self->identifier($text); } elsif( $elem eq 'datestamp' ) { - warn "HTTP::OAI::Header parse warning: Empty datestamp for ".$self->identifier."\n" unless $text; $self->datestamp($text); } elsif( $elem eq 'setspec' ) { $self->setSpec($text); diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Headers.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Headers.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Headers.pm 2011-06-23 13:31:52.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Headers.pm 1970-01-01 00:00:00.000000000 +0000 @@ -1,249 +0,0 @@ -package HTTP::OAI::Headers; - -use strict; -use warnings; - -use HTTP::OAI::SAXHandler qw( :SAX ); - -use vars qw( @ISA ); - -@ISA = qw( XML::SAX::Base ); - -my %VERSIONS = ( - 'http://www.openarchives.org/oai/1.0/oai_getrecord' => '1.0', - 'http://www.openarchives.org/oai/1.0/oai_identify' => '1.0', - 'http://www.openarchives.org/oai/1.0/oai_listidentifiers' => '1.0', - 'http://www.openarchives.org/oai/1.0/oai_listmetadataformats' => '1.0', - 'http://www.openarchives.org/oai/1.0/oai_listrecords' => '1.0', - 'http://www.openarchives.org/oai/1.0/oai_listsets' => '1.0', - 'http://www.openarchives.org/oai/1.1/oai_getrecord' => '1.1', - 'http://www.openarchives.org/oai/1.1/oai_identify' => '1.1', - 'http://www.openarchives.org/oai/1.1/oai_listidentifiers' => '1.1', - 'http://www.openarchives.org/oai/1.1/oai_listmetadataformats' => '1.1', - 'http://www.openarchives.org/oai/1.1/oai_listrecords' => '1.1', - 'http://www.openarchives.org/oai/1.1/oai_listsets' => '1.1', - 'http://www.openarchives.org/oai/2.0/' => '2.0', - 'http://www.openarchives.org/oai/2.0/static-repository' => '2.0s', -); - -sub new { - my ($class,%args) = @_; - my $self = bless { - 'field'=>{ - 'xmlns'=>'http://www.openarchives.org/OAI/2.0/', - 'xmlns:xsi'=>'http://www.w3.org/2001/XMLSchema-instance', - 'xsi:schemaLocation'=>'http://www.openarchives.org/OAI/2.0/ http://www.openarchives.org/OAI/2.0/OAI-PMH.xsd' - }, - %args, - }, ref($class) || $class; - return $self; -} - -sub set_error -{ - my ($self,$error,$code) = @_; - $code ||= 600; - - if( $self->get_handler ) { - $self->get_handler->errors($error); - $self->get_handler->code($code); - } else { - Carp::carp ref($self)." tried to set_error without having a handler to set it on!"; - } -} -sub generate_start { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - - $handler->start_prefix_mapping({ - 'Prefix'=>'xsi', - 'NamespaceURI'=>'http://www.w3.org/2001/XMLSchema-instance' - }); - $handler->start_prefix_mapping({ - 'Prefix'=>'', - 'NamespaceURI'=>'http://www.openarchives.org/OAI/2.0/' - }); - g_start_element($handler, - 'http://www.openarchives.org/OAI/2.0/', - 'OAI-PMH', - { - '{http://www.w3.org/2001/XMLSchema-instance}schemaLocation'=>{ - 'LocalName' => 'schemaLocation', - 'Prefix' => 'xsi', - 'Value' => 'http://www.openarchives.org/OAI/2.0/ http://www.openarchives.org/OAI/2.0/OAI-PMH.xsd', - 'Name' => 'xsi:schemaLocation', - 'NamespaceURI' => 'http://www.w3.org/2001/XMLSchema-instance', - }, - '{}xmlns' => { - 'Prefix' => '', - 'LocalName' => 'xmlns', - 'Value' => 'http://www.openarchives.org/OAI/2.0/', - 'Name' => 'xmlns', - 'NamespaceURI' => '', - }, - '{http://www.w3.org/2000/xmlns/}xsi'=>{ - 'LocalName' => 'xsi', - 'Prefix' => 'xmlns', - 'Value' => 'http://www.w3.org/2001/XMLSchema-instance', - 'Name' => 'xmlns:xsi', - 'NamespaceURI' => 'http://www.w3.org/2000/xmlns/', - }, - }); - - g_data_element($handler, - 'http://www.openarchives.org/OAI/2.0/', - 'responseDate', - {}, - $self->header('responseDate') - ); - - my $uri = URI->new($self->header('requestURL')); - my $attr; - my %QUERY = $uri->query_form; - while(my ($key,$value) = each %QUERY) { - $attr->{"{}$key"} = { - 'Name'=>$key, - 'LocalName'=>$key, - 'Value'=>$value, - 'Prefix'=>'', - 'NamespaceURI'=>'', - }; - } - $uri->query( undef ); - g_data_element($handler, - 'http://www.openarchives.org/OAI/2.0/', - 'request', - $attr, - $uri->as_string - ); -} - -sub generate_end { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - - g_end_element($handler, - 'http://www.openarchives.org/OAI/2.0/', - 'OAI-PMH' - ); - - $handler->end_prefix_mapping({ - 'Prefix'=>'xsi', - 'NamespaceURI'=>'http://www.w3.org/2001/XMLSchema-instance' - }); - $handler->end_prefix_mapping({ - 'Prefix'=>'', - 'NamespaceURI'=>'http://www.openarchives.org/OAI/2.0/' - }); -} - -sub header { - my $self = shift; - return @_ > 1 ? $self->{field}->{$_[0]} = $_[1] : $self->{field}->{$_[0]}; -} - -sub end_document { - my $self = shift; - $self->set_handler(undef); - unless( defined($self->header('version')) ) { - die "Not an OAI-PMH response: No recognised OAI-PMH namespace found before end of document\n"; - } -} - -sub start_element { - my ($self,$hash) = @_; - return $self->SUPER::start_element($hash) if $self->{State}; - my $elem = $hash->{LocalName}; - my $attr = $hash->{Attributes}; - - # Root element - unless( defined($self->header('version')) ) { - my $xmlns = $hash->{NamespaceURI}; - if( !defined($xmlns) || !length($xmlns) ) - { - die "Error parsing response: no namespace on root element"; - } - elsif( !exists $VERSIONS{lc($xmlns)} ) - { - die "Error parsing response: unrecognised OAI namespace '$xmlns'"; - } - else - { - $self->header('version',$VERSIONS{lc($xmlns)}) - } - } - # With a static repository, don't process any headers - if( $self->header('version') && $self->header('version') eq '2.0s' ) { - my %args = %{$self->{_args}}; - # ListRecords and the correct prefix - if( $elem eq 'ListRecords' && - $elem eq $args{'verb'} && - $attr->{'{}metadataPrefix'}->{'Value'} eq $args{'metadataPrefix'} ) { - $self->{State} = 1; - # Start of the verb we're looking for - } elsif( - $elem ne 'ListRecords' && - $elem eq $args{'verb'} - ) { - $self->{State} = 1; - } - } else { - $self->{State} = 1; - } -} - -sub end_element { - my ($self,$hash) = @_; - my $elem = $hash->{LocalName}; - my $attr = $hash->{Attributes}; - my $text = $hash->{Text}; - # Static repository, don't process any headers - if( $self->header('version') && $self->header('version') eq '2.0s' ) { - # Stop parsing when we get to the closing verb - if( $self->{State} && - $elem eq $self->{_args}->{'verb'} && - $hash->{NamespaceURI} eq 'http://www.openarchives.org/OAI/2.0/static-repository' - ) { - $self->{State} = 0; - die "done\n\n"; - } - return $self->{State} ? - $self->SUPER::end_element($hash) : - undef; - } - $self->SUPER::end_element($hash); - if( $elem eq 'responseDate' || $elem eq 'requestURL' ) { - $self->header($elem,$text); - } elsif( $elem eq 'request' ) { - $self->header("request",$text); - my $uri = new URI($text); - $uri->query_form(map { ($_->{LocalName},$_->{Value}) } values %$attr); - $self->header("requestURL",$uri); - } else { - die "Still in headers, but came across an unrecognised element: $elem"; - } - if( $elem eq 'requestURL' || $elem eq 'request' ) { - die "Oops! Root handler isn't \$self - $self != $hash->{State}" - unless ref($self) eq ref($hash->{State}->get_handler); - $hash->{State}->set_handler($self->get_handler); - } - return 1; -} - -1; - -__END__ - -=head1 NAME - -HTTP::OAI::Headers - Encapsulation of 'header' values - -=head1 METHODS - -=over 4 - -=item $value = $hdrs->header($name,[$value]) - -Return and optionally set the header field $name to $value. - -=back diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Identify.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Identify.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Identify.pm 2011-06-23 13:32:29.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Identify.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,100 +1,56 @@ package HTTP::OAI::Identify; +@ISA = qw( HTTP::OAI::Verb ); + use strict; -use warnings; use HTTP::OAI::SAXHandler qw( :SAX ); -use vars qw( @ISA ); -@ISA = qw( HTTP::OAI::Response ); - -sub new { - my ($class,%args) = @_; - delete $args{'harvestAgent'}; # Otherwise we get a memory cycle with $h->repository($id)! - for(qw( adminEmail compression description )) { - $args{$_} ||= []; - } - $args{handlers}->{description} ||= "HTTP::OAI::Metadata"; - my $self = $class->SUPER::new(%args); - - $self->verb('Identify') unless $self->verb; - $self->baseURL($args{baseURL}) unless $self->baseURL; - $self->adminEmail($args{adminEmail}) if !ref($args{adminEmail}) && !$self->adminEmail; - $self->protocolVersion($args{protocolVersion} || '2.0') unless $self->protocolVersion; - $self->repositoryName($args{repositoryName}) unless $self->repositoryName; - $self->earliestDatestamp($args{earliestDatestamp}) unless $self->earliestDatestamp; - $self->deletedRecord($args{deletedRecord}) unless $self->deletedRecord; - $self->granularity($args{granularity}) unless $self->granularity; - - $self; -} - -sub adminEmail { - my $self = shift; - push @{$self->{adminEmail}}, @_; - return wantarray ? - @{$self->{adminEmail}} : - $self->{adminEmail}->[0] -} -sub baseURL { shift->headers->header('baseURL',@_) } -sub compression { - my $self = shift; - push @{$self->{compression}}, @_; - return wantarray ? - @{$self->{compression}} : - $self->{compression}->[0]; -} -sub deletedRecord { return shift->headers->header('deletedRecord',@_) } -sub description { - my $self = shift; - push(@{$self->{description}}, @_); - return wantarray ? - @{$self->{description}} : - $self->{description}->[0]; -}; -sub earliestDatestamp { return shift->headers->header('earliestDatestamp',@_) } -sub granularity { return shift->headers->header('granularity',@_) } -sub protocolVersion { return shift->headers->header('protocolVersion',@_) }; -sub repositoryName { return shift->headers->header('repositoryName',@_) }; +sub adminEmail { shift->_elem('adminEmail',@_) } +sub baseURL { shift->_elem('baseURL',@_) } +sub compression { shift->_multi('compression',@_) } +sub deletedRecord { shift->_elem('deletedRecord',@_) } +sub description { shift->_multi('description',@_) } +sub earliestDatestamp { shift->_elem('earliestDatestamp',@_) } +sub granularity { shift->_elem('granularity',@_) } +sub protocolVersion { shift->_elem('protocolVersion',@_) } +sub repositoryName { shift->_elem('repositoryName',@_) } sub next { my $self = shift; return shift @{$self->{description}}; } -sub generate_body { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','repositoryName',{},$self->repositoryName); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','baseURL',{},"".$self->baseURL); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','protocolVersion',{},$self->protocolVersion); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','adminEmail',{},$_) for $self->adminEmail; - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','earliestDatestamp',{},$self->earliestDatestamp||'0001-01-01'); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','deletedRecord',{},$self->deletedRecord||'no'); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','granularity',{},$self->granularity) if defined($self->granularity); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','compression',{},$_) for $self->compression; +sub generate_body +{ + my( $self, $driver ) = @_; + + for(qw( repositoryName baseURL protocolVersion adminEmail earliestDatestamp deletedRecord granularity compression )) + { + foreach my $value ($self->$_) + { + $driver->data_element( $_, $value ); + } + } for($self->description) { - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','description',{},$_); + $_->generate( $driver ); } } sub start_element { - my ($self,$hash) = @_; + my ($self,$hash,$r) = @_; my $elem = lc($hash->{LocalName}); - $self->SUPER::start_element($hash); if( $elem eq 'description' && !$self->{"in_$elem"} ) { - $self->{OLDHandler} = $self->get_handler(); - $self->set_handler(my $handler = $self->{handlers}->{$elem}->new()); - $self->description($handler); + $self->set_handler(my $desc = HTTP::OAI::Metadata->new); + $self->description([$self->description, $desc]); $self->{"in_$elem"} = $hash->{Depth}; - g_start_document($handler); } + $self->SUPER::start_element($hash,$r); } sub end_element { - my ($self,$hash) = @_; + my ($self,$hash,$r) = @_; my $elem = $hash->{LocalName}; my $text = $hash->{Text}; if( defined $text ) @@ -102,11 +58,11 @@ $text =~ s/^\s+//; $text =~ s/\s+$//; } + $self->SUPER::end_element($hash,$r); if( defined($self->get_handler) ) { if( $elem eq 'description' && $self->{"in_$elem"} == $hash->{Depth} ) { - $self->SUPER::end_document(); - $self->set_handler($self->{OLDHandler}); - $self->{"in_$elem"} = undef; + $self->set_handler( undef ); + $self->{"in_$elem"} = 0; } } elsif( $elem eq 'adminEmail' ) { $self->adminEmail($text); @@ -118,9 +74,8 @@ $text = '2.0' if $text =~ /\D/ or $text < 2.0; $self->protocolVersion($text); } elsif( defined($text) && length($text) ) { - $self->headers->header($elem,$text); + $self->_elem($elem,$text); } - $self->SUPER::end_element($hash); } 1; @@ -159,7 +114,7 @@ =item $i->headers -Returns an HTTP::OAI::Headers object. Use $headers->header('headername') to retrive field values. +Returns an HTTP::Headers object. Use $headers->header('headername') to retrive field values. =item $burl = $i->baseURL([$burl]) diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/ListIdentifiers.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/ListIdentifiers.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/ListIdentifiers.pm 2007-06-28 11:16:40.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/ListIdentifiers.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,72 +1,41 @@ package HTTP::OAI::ListIdentifiers; -use strict; -use warnings; - -use vars qw( @ISA ); @ISA = qw( HTTP::OAI::PartialList ); -sub new { - my $class = shift; - my %args = @_; - - my $self = $class->SUPER::new(@_); - - $self->{in_record} = 0; - - $self; -} +use strict; sub identifier { shift->item(@_) } -sub generate_body { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - - for($self->identifier) { - $_->set_handler($handler); - $_->generate; - } - if( defined($self->resumptionToken) ) { - $self->resumptionToken->set_handler($handler); - $self->resumptionToken->generate; +sub start_element +{ + my ($self,$hash, $r) = @_; + + if( $hash->{Depth} == 3 && $hash->{LocalName} eq "header" ) + { + $self->set_handler(HTTP::OAI::Header->new); } -} -sub start_element { - my ($self,$hash) = @_; - my $elem = lc($hash->{LocalName}); - if( $elem eq 'header' ) { - $self->set_handler(new HTTP::OAI::Header( - version=>$self->version - )); - } elsif( $elem eq 'resumptiontoken' ) { - $self->set_handler(new HTTP::OAI::ResumptionToken( - version=>$self->version - )); - } - $self->SUPER::start_element($hash); + $self->SUPER::start_element($hash, $r); } sub end_element { - my ($self,$hash) = @_; - my $elem = lc($hash->{LocalName}); + my ($self,$hash, $r) = @_; + $self->SUPER::end_element($hash); - if( $elem eq 'header' ) { - $self->identifier( $self->get_handler ); - $self->set_handler( undef ); - } elsif( $elem eq 'resumptiontoken' ) { - $self->resumptionToken( $self->get_handler ); - $self->set_handler( undef ); - } + # OAI 1.x - if( $self->version eq '1.1' && $elem eq 'identifier' ) { - $self->identifier(new HTTP::OAI::Header( - version=>$self->version, + if( $hash->{Depth} == 3 && $hash->{LocalName} eq "identifier" ) + { + $r->callback(HTTP::OAI::Header->new( identifier=>$hash->{Text}, datestamp=>'0000-00-00', )); } + elsif( $hash->{Depth} == 3 && $hash->{LocalName} eq "header" ) + { + $r->callback( $self->get_handler, $self ); + $self->set_handler( undef ); + } } 1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/ListMetadataFormats.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/ListMetadataFormats.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/ListMetadataFormats.pm 2011-06-23 13:34:26.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/ListMetadataFormats.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,60 +1,29 @@ package HTTP::OAI::ListMetadataFormats; -use strict; -use warnings; - -use vars qw( @ISA ); - -@ISA = qw( HTTP::OAI::Response ); - -sub new { - my $class = shift; - my $self = $class->SUPER::new(@_); - $self->{'metadataFormat'} ||= []; - $self->{in_mdf} = 0; - $self->verb('ListMetadataFormats') unless $self->verb; - - $self; -} +@ISA = qw( HTTP::OAI::PartialList ); -sub metadataFormat { - my $self = shift; - push(@{$self->{metadataformat}}, @_); - return wantarray ? - @{$self->{metadataformat}} : - $self->{metadataformat}->[0]; -} - -sub next { shift @{shift->{metadataformat}} } - -sub generate_body { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); +use strict; - for( $self->metadataFormat ) { - $_->set_handler($handler); - $_->generate; - } -} +sub metadataFormat { shift->item(@_) } sub start_element { - my ($self,$hash) = @_; + my ($self,$hash,$r) = @_; if( !$self->{'in_mdf'} ) { if( lc($hash->{LocalName}) eq 'metadataformat' ) { - $self->set_handler(new HTTP::OAI::MetadataFormat()); + $self->set_handler(my $mdf = HTTP::OAI::MetadataFormat->new); + $self->metadataFormat($mdf); $self->{'in_mdf'} = $hash->{Depth}; } } - $self->SUPER::start_element($hash); + $self->SUPER::start_element($hash,$r); } sub end_element { - my ($self,$hash) = @_; - $self->SUPER::end_element($hash); + my ($self,$hash,$r) = @_; + $self->SUPER::end_element($hash,$r); if( $self->{'in_mdf'} == $hash->{Depth} ) { if( lc($hash->{LocalName}) eq 'metadataformat' ) { HTTP::OAI::Debug::trace( "metadataFormat: " . $self->get_handler->metadataPrefix ); - $self->metadataFormat( $self->get_handler ); $self->set_handler( undef ); $self->{'in_mdf'} = 0; } diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/ListRecords.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/ListRecords.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/ListRecords.pm 2011-06-23 13:34:26.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/ListRecords.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,77 +1,34 @@ package HTTP::OAI::ListRecords; -use strict; -use warnings; - -use vars qw( @ISA ); @ISA = qw( HTTP::OAI::PartialList ); -sub new { - my ($class,%args) = @_; - - $args{handlers} ||= {}; - $args{handlers}->{header} ||= "HTTP::OAI::Header"; - $args{handlers}->{metadata} ||= "HTTP::OAI::Metadata"; - $args{handlers}->{about} ||= "HTTP::OAI::Metadata"; - - my $self = $class->SUPER::new(%args); - - $self->{in_record} = 0; - - $self; -} +use strict; sub record { shift->item(@_) } -sub generate_body { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - - for( $self->record ) { - $_->set_handler($self->get_handler); - $_->generate; +sub start_element +{ + my ($self,$hash, $r) = @_; + + if( $hash->{Depth} == 3 && $hash->{LocalName} eq "record" ) + { + $self->set_handler(HTTP::OAI::Record->new); } - if( defined($self->resumptionToken) ) { - $self->resumptionToken->set_handler($handler); - $self->resumptionToken->generate; - } -} -sub start_element { - my ($self,$hash) = @_; - if( !$self->{'in_record'} ) { - my $elem = lc($hash->{LocalName}); - if( $elem eq 'record' ) { - $self->set_handler(new HTTP::OAI::Record( - version=>$self->version, - handlers=>$self->{handlers}, - )); - $self->{'in_record'} = $hash->{Depth}; - } elsif( $elem eq 'resumptiontoken' ) { - $self->set_handler(new HTTP::OAI::ResumptionToken( - version=>$self->version - )); - $self->{'in_record'} = $hash->{Depth}; - } - } - $self->SUPER::start_element($hash); + $self->SUPER::start_element($hash, $r); } -sub end_element { - my ($self,$hash) = @_; - $self->SUPER::end_element($hash); - if( $self->{'in_record'} == $hash->{Depth} ) { - my $elem = lc($hash->{LocalName}); - if( $elem eq 'record' ) { +sub end_element +{ + my ($self,$hash, $r) = @_; + + $self->SUPER::end_element($hash, $r); + + if( $hash->{Depth} == 3 && $hash->{LocalName} eq "record" ) + { HTTP::OAI::Debug::trace( "record: " . $self->get_handler->identifier ); - $self->record( $self->get_handler ); - $self->set_handler( undef ); - $self->{'in_record'} = 0; - } elsif( $elem eq 'resumptiontoken' ) { - $self->resumptionToken( $self->get_handler ); - $self->set_handler( undef ); - $self->{'in_record'} = 0; - } + $r->callback( $self->get_handler, $self ); + $self->set_handler( undef ); } } diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/ListSets.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/ListSets.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/ListSets.pm 2007-06-28 11:16:40.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/ListSets.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,75 +1,33 @@ package HTTP::OAI::ListSets; -use strict; -use warnings; - -use vars qw( @ISA ); @ISA = qw( HTTP::OAI::PartialList ); -sub new { - my ($class,%args) = @_; - - $args{handlers} ||= {}; - $args{handlers}->{description} ||= 'HTTP::OAI::Metadata'; - - my $self = $class->SUPER::new(%args); - - $self->{in_set} = 0; +use strict; - $self; -} - sub set { shift->item(@_) } -sub generate_body { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - - for( $self->set ) { - $_->set_handler($handler); - $_->generate; - } - if( defined($self->resumptionToken) ) { - $self->resumptionToken->set_handler($handler); - $self->resumptionToken->generate; - } -} +sub start_element +{ + my ($self,$hash, $r) = @_; -sub start_element { - my ($self,$hash) = @_; - my $elem = lc($hash->{Name}); - if( !$self->{in_set} ) { - if( $elem eq 'set' ) { - $self->set_handler(new HTTP::OAI::Set( - version=>$self->version, - handlers=>$self->{handlers} - )); - $self->{'in_set'} = $hash->{Depth}; - } elsif( $elem eq 'resumptiontoken' ) { - $self->set_handler(new HTTP::OAI::ResumptionToken( - version=>$self->version - )); - $self->{'in_set'} = $hash->{Depth}; - } + if( $hash->{Depth} == 3 && $hash->{LocalName} eq "set" ) + { + $self->set_handler(HTTP::OAI::Set->new); } - $self->SUPER::start_element($hash); + + $self->SUPER::start_element($hash, $r); } -sub end_element { - my ($self,$hash) = @_; - my $elem = lc($hash->{LocalName}); - $self->SUPER::end_element($hash); - if( $self->{'in_set'} == $hash->{Depth} ) +sub end_element +{ + my ($self,$hash, $r) = @_; + + $self->SUPER::end_element($hash, $r); + + if( $hash->{Depth} == 3 && $hash->{LocalName} eq "set" ) { - if( $elem eq 'set' ) { - $self->set( $self->get_handler ); - $self->set_handler( undef ); - $self->{in_set} = 0; - } elsif( $elem eq 'resumptionToken' ) { - $self->resumptionToken( $self->get_handler ); - $self->set_handler( undef ); - $self->{in_set} = 0; - } + $r->callback( $self->get_handler, $self ); + $self->set_handler( undef ); } } diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/MemberMixin.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/MemberMixin.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/MemberMixin.pm 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/MemberMixin.pm 2014-04-03 12:45:44.000000000 +0000 @@ -0,0 +1,49 @@ +package HTTP::OAI::MemberMixin; + +@ISA = qw( LWP::MemberMixin ); + +sub new +{ + my( $class, %self ) = @_; + return bless \%self, $class; +} + +sub harvester { shift->_elem("harvester",@_) } + +sub _multi +{ + my( $self, $elem ) = splice(@_, 0, 2); + if( ref($_[0]) eq "ARRAY" ) + { + $self->{$elem} = $_[0]; + } + elsif( @_ ) + { + push @{$self->{$elem}}, @_; + } + return @{$self->{$elem} || []}; +} + +1; + +=head1 NAME + +HTTP::OAI::MemberMixin + +=head1 DESCRIPTION + +Subclasses L to provide attribute utility methods. + +=head1 METHODS + +=over 4 + +=item $obj->_elem( FIELD [, VALUE ] ) + +See L. + +=item $obj->_multi( FIELD [, VALUE ] ) + +Same as L but if you pass a non-ARRAY reference appends the given value(s). + +In list context returns a list of all the items. diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Metadata/METS.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Metadata/METS.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Metadata/METS.pm 2007-06-28 11:16:39.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Metadata/METS.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,15 +1,12 @@ package HTTP::OAI::Metadata::METS; -use strict; -use warnings; - -use HTTP::OAI::Metadata; -use vars qw(@ISA); -@ISA = qw(HTTP::OAI::Metadata); - use XML::LibXML; use XML::LibXML::XPathContext; +@ISA = qw( HTTP::OAI::Metadata ); + +use strict; + sub new { my $class = shift; my $self = $class->SUPER::new(@_); @@ -20,6 +17,7 @@ sub _xc { my $xc = XML::LibXML::XPathContext->new( @_ ); + $xc->registerNs( 'oai_dc', HTTP::OAI::OAI_NS ); $xc->registerNs( 'mets', 'http://www.loc.gov/METS/' ); $xc->registerNs( 'xlink', 'http://www.w3.org/1999/xlink' ); return $xc; @@ -33,7 +31,7 @@ my $xc = _xc($dom); my @files; - foreach my $file ($xc->findnodes( '//mets:file' )) + foreach my $file ($xc->findnodes( '*//mets:file' )) { my $f = {}; foreach my $attr ($file->attributes) diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Metadata/OAI_DC.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Metadata/OAI_DC.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Metadata/OAI_DC.pm 2010-09-23 10:09:46.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Metadata/OAI_DC.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,113 +1,47 @@ package HTTP::OAI::Metadata::OAI_DC; -use XML::LibXML; -use HTTP::OAI::Metadata; -@ISA = qw(HTTP::OAI::Metadata); +@ISA = qw( HTTP::OAI::MemberMixin HTTP::OAI::SAX::Base ); use strict; our $OAI_DC_SCHEMA = 'http://www.openarchives.org/OAI/2.0/oai_dc/'; our $DC_SCHEMA = 'http://purl.org/dc/elements/1.1/'; our @DC_TERMS = qw( contributor coverage creator date description format identifier language publisher relation rights source subject title type ); +our %VALID_TERM = map { $_ => 1 } @DC_TERMS; -sub new { - my( $class, %self ) = @_; +sub metadata { shift->dom(@_) } - my $self = $class->SUPER::new( %self ); +sub dc { shift->_elem('dc',@_) } - if( exists $self{dc} && ref($self{dc}) eq 'HASH' ) - { - my ($dom,$dc) =_oai_dc_dom(); - foreach my $term (@DC_TERMS) - { - foreach my $value (@{$self{dc}->{$term}||[]}) - { - $dc->appendChild($dom->createElementNS($DC_SCHEMA, $term))->appendText( $value ); - } - } - $self->dom($dom); - } - - $self; -} - -sub dc -{ - my( $self ) = @_; - - my $dom = $self->dom; - my $metadata = $dom->documentElement; - - return $self->{dc} if defined $self->{dc}; - - my %dc = map { $_ => [] } @DC_TERMS; - - $self->_dc( $metadata, \%dc ); - - return \%dc; -} - -sub _dc +sub generate { - my( $self, $node, $dc ) = @_; - - my $ns = $node->getNamespaceURI; - $ns =~ s/\/?$/\//; - - if( $ns eq $DC_SCHEMA ) - { - push @{$dc->{lc($node->localName)}}, $node->textContent; - } - elsif( $node->hasChildNodes ) - { - for($node->childNodes) - { - next if $_->nodeType != XML_ELEMENT_NODE; - $self->_dc( $_, $dc ); - } - } -} - -sub _oai_dc_dom { - my $dom = XML::LibXML->createDocument(); - $dom->setDocumentElement(my $dc = $dom->createElement('oai_dc:dc')); - $dc->setAttribute('xmlns:oai_dc','http://www.openarchives.org/OAI/2.0/oai_dc/'); - $dc->setAttribute('xmlns:dc','http://purl.org/dc/elements/1.1/'); - $dc->setAttribute('xmlns:xsi','http://www.w3.org/2001/XMLSchema-instance'); - $dc->setAttribute('xsi:schemaLocation','http://www.openarchives.org/OAI/2.0/oai_dc/ http://www.openarchives.org/OAI/2.0/oai_dc.xsd'); - return ($dom,$dc); -} - -sub metadata { - my( $self, $md ) = @_; - - return $self->dom if @_ == 1; - - delete $self->{dc}; - $self->dom( $md ); - - return if !defined $md; - - my $dc = $self->dc; - - my ($dom,$metadata) = _oai_dc_dom(); + my( $self, $driver ) = @_; + $driver->start_element( 'metadata' ); + $driver->start_element( 'oai_dc:dc', + 'xmlns:oai_dc' => 'http://www.openarchives.org/OAI/2.0/oai_dc/', + 'xmlns:dc' => 'http://purl.org/dc/elements/1.1/', + 'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance', + 'xsi:schemaLocation' => 'http://www.openarchives.org/OAI/2.0/oai_dc/ http://www.openarchives.org/OAI/2.0/oai_dc.xsd', + ); foreach my $term (@DC_TERMS) { - foreach my $value (@{$dc->{$term}}) + foreach my $value (@{$self->{dc}{$term} || []}) { - $metadata->appendChild( $dom->createElementNS( $DC_SCHEMA, $term ) )->appendText( $value ); + $driver->data_element( "dc:$term", $value ); } } - - $self->dom($dom) + $driver->end_element( 'oai_dc:dc' ); + $driver->end_element( 'metadata' ); } -sub toString { +sub _toString { my $self = shift; my $str = "Open Archives Initiative Dublin Core (".ref($self).")\n"; - foreach my $term ( @DC_TERMS ) { - for(@{$self->{dc}->{$term}}) { + foreach my $term ( @DC_TERMS ) + { + for(@{$self->{dc}->{$term}}) + { $str .= sprintf("%s:\t%s\n", $term, $_||''); } } @@ -117,16 +51,10 @@ sub end_element { my ($self,$hash) = @_; my $elem = lc($hash->{LocalName}); - if( exists($self->{dc}->{$elem}) ) { + if( $VALID_TERM{$elem} ) + { push @{$self->{dc}->{$elem}}, $hash->{Text}; } - $self->SUPER::end_element($hash); -} - -sub end_document { - my $self = shift; - $self->SUPER::end_document(); - $self->metadata($self->dom); } 1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/MetadataFormat.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/MetadataFormat.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/MetadataFormat.pm 2011-06-23 13:43:32.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/MetadataFormat.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,50 +1,25 @@ package HTTP::OAI::MetadataFormat; -use strict; -use warnings; - -use HTTP::OAI::SAXHandler qw/ :SAX /; - -use vars qw( @ISA ); -@ISA = qw( HTTP::OAI::Encapsulation ); - -sub new { - my ($class,%args) = @_; - - my $self = $class->SUPER::new(%args); - - $self->metadataPrefix($args{metadataPrefix}) if $args{metadataPrefix}; - $self->schema($args{schema}) if $args{schema}; - $self->metadataNamespace($args{metadataNamespace}) if $args{metadataNamespace}; +@ISA = qw( HTTP::OAI::MemberMixin XML::SAX::Base ); - $self; -} - -sub metadataPrefix { - my $self = shift; - return @_ ? $self->{metadataPrefix} = shift : $self->{metadataPrefix} -} -sub schema { - my $self = shift; - return @_ ? $self->{schema} = shift : $self->{schema} } -sub metadataNamespace { - my $self = shift; - return @_ ? $self->{metadataNamespace} = shift : $self->{metadataNamespace} -} +use strict; -sub generate { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - - g_start_element($handler,'http://www.openarchives.org/OAI/2.0/','metadataFormat',{}); - - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','metadataPrefix',{},$self->metadataPrefix); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','schema',{},$self->schema); - if( defined($self->metadataNamespace) ) { - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','metadataNamespace',{},$self->metadataNamespace); +sub metadataPrefix { shift->_elem('metadataPrefix',@_) } +sub schema { shift->_elem('schema',@_) } +sub metadataNamespace { shift->_elem('metadataNamespace',@_) } + +sub generate +{ + my( $self, $driver ) = @_; + + $driver->start_element('metadataFormat'); + $driver->data_element('metadataPrefix',$self->metadataPrefix); + $driver->data_element('schema',$self->schema); + if( defined($self->metadataNamespace) ) + { + $driver->data_element('metadataNamespace',$self->metadataNamespace); } - - g_end_element($handler,'http://www.openarchives.org/OAI/2.0/','metadataFormat'); + $driver->end_element('metadataFormat'); } sub end_element { diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Metadata.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Metadata.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Metadata.pm 2007-06-28 11:16:40.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Metadata.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,7 +1,59 @@ package HTTP::OAI::Metadata; -use vars qw(@ISA); -@ISA = qw(HTTP::OAI::Encapsulation::DOM); +@ISA = qw( HTTP::OAI::MemberMixin HTTP::OAI::SAX::Base ); + +use strict; + +sub new +{ + my( $class, %self ) = @_; + + $self{doc} = XML::LibXML::Document->new( '1.0', 'UTF-8' ); + $self{dom} = $self{current} = $self{doc}->createDocumentFragment; + + return bless \%self, $class; +} + +sub metadata { shift->dom( @_ ) } +sub dom { shift->_elem( "dom", @_ ) } + +sub generate +{ + my( $self, $driver ) = @_; + + $driver->generate( $self->dom ); +} + +sub start_element +{ + my( $self, $hash ) = @_; + + my $node = $self->{doc}->createElementNS( + $hash->{NamespaceURI}, + $hash->{Name}, + ); + foreach my $attr (values %{$hash->{Attributes}}) + { + Carp::confess "Can't setAttribute without attribute name" if !defined $attr->{Name}; + $node->setAttribute( $attr->{Name}, $attr->{Value} ); + } + + $self->{current} = $self->{current}->appendChild( $node ); +} + +sub end_element +{ + my( $self, $hash ) = @_; + + $self->{current} = $self->{current}->parentNode; +} + +sub characters +{ + my( $self, $hash ) = @_; + + $self->{current}->appendText( $hash->{Data} ); +} 1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/PartialList.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/PartialList.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/PartialList.pm 2011-08-04 14:17:42.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/PartialList.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,43 +1,57 @@ package HTTP::OAI::PartialList; +@ISA = qw( HTTP::OAI::Verb ); + use strict; -use warnings; -use vars qw( @ISA ); -@ISA = qw( HTTP::OAI::Response ); +sub resumptionToken { shift->_elem('resumptionToken',@_) } -sub new { - my( $class, %args ) = @_; - my $self = $class->SUPER::new(%args); - $self->{onRecord} = delete $args{onRecord}; - $self->{item} ||= []; - return $self; -} +sub item { shift->_multi('item',@_) } -sub resumptionToken { shift->headers->header('resumptionToken',@_) } +sub next +{ + my( $self ) = @_; -sub item { - my $self = shift; - if( defined($self->{onRecord}) ) { - $self->{onRecord}->($_, $self) for @_; - } else { - push(@{$self->{item}}, @_); + return shift @{$self->{item}}; +} + +sub generate_body +{ + my( $self, $driver ) = @_; + + for($self->item) + { + $_->generate( $driver ); + } + if(my $token = $self->resumptionToken) + { + $token->generate( $driver ); } - return wantarray ? - @{$self->{item}} : - $self->{item}->[0]; } -sub next { - my $self = shift; - return shift @{$self->{item}} if @{$self->{item}}; - return undef unless $self->{'resume'} and $self->resumptionToken; - - do { - $self->resume(resumptionToken=>$self->resumptionToken); - } while( $self->{onRecord} and $self->is_success and $self->resumptionToken ); +sub start_element +{ + my ($self, $hash, $r) = @_; + + if( $hash->{Depth} == 3 && $hash->{LocalName} eq "resumptionToken" ) + { + $self->set_handler(HTTP::OAI::ResumptionToken->new); + } + + $self->SUPER::start_element( $hash, $r ); +} - return $self->is_success ? $self->next : undef; +sub end_element +{ + my ($self, $hash, $r) = @_; + + $self->SUPER::end_element( $hash, $r ); + + if( $hash->{Depth} == 3 && $hash->{LocalName} eq "resumptionToken" ) + { + $self->resumptionToken( $self->get_handler ); + $self->set_handler( undef ); + } } 1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Record.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Record.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Record.pm 2011-06-23 13:32:29.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Record.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,82 +1,73 @@ package HTTP::OAI::Record; -use strict; -use warnings; - -use vars qw(@ISA); +@ISA = qw( HTTP::OAI::MemberMixin HTTP::OAI::SAX::Base ); -use HTTP::OAI::SAXHandler qw/ :SAX /; - -@ISA = qw(HTTP::OAI::Encapsulation); +use strict; sub new { my ($class,%args) = @_; - my $self = $class->SUPER::new(%args); - - $self->{handlers} = $args{handlers}; - - $self->header($args{header}) unless defined($self->header); - $self->metadata($args{metadata}) unless defined($self->metadata); - $self->{about} = $args{about} || [] unless defined($self->{about}); - - $self->{in_record} = 0; - $self->header(new HTTP::OAI::Header(%args)) unless defined $self->header; + $args{header} ||= HTTP::OAI::Header->new(%args); - $self; + return $class->SUPER::new(%args); } sub header { shift->_elem('header',@_) } sub metadata { shift->_elem('metadata',@_) } -sub about { - my $self = shift; - push @{$self->{about}}, @_ if @_; - return @{$self->{about}}; -} +sub about { shift->_multi('about',@_) } sub identifier { shift->header->identifier(@_) } sub datestamp { shift->header->datestamp(@_) } sub status { shift->header->status(@_) } sub is_deleted { shift->header->is_deleted(@_) } -sub generate { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - - g_start_element($handler,'http://www.openarchives.org/OAI/2.0/','record',{}); - $self->header->set_handler($handler); - $self->header->generate; - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','metadata',{},$self->metadata) if defined($self->metadata); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','about',{},$_) for $self->about; - g_end_element($handler,'http://www.openarchives.org/OAI/2.0/','record'); +sub generate +{ + my( $self, $driver ) = @_; + + $driver->start_element('record'); + $self->header->generate( $driver ); + $self->metadata->generate( $driver ) if defined $self->metadata; + $self->about->generate( $driver ) for $self->about; + $driver->end_element('record'); } sub start_element { - my ($self,$hash) = @_; - return $self->SUPER::start_element( $hash ) if $self->{in_record}; - my $elem = lc($hash->{LocalName}); - if( $elem eq 'record' && $self->version eq '1.1' ) { - $self->status($hash->{Attributes}->{'{}status'}->{Value}); - } - elsif( $elem =~ /^header|metadata|about$/ ) { - my $handler = $self->{handlers}->{$elem}->new() - or die "Error getting handler for <$elem> (failed to create new $self->{handlers}->{$elem})"; - $self->set_handler($handler); - $self->{in_record} = $hash->{Depth}; - g_start_document( $handler ); - $self->SUPER::start_element( $hash ); + my ($self,$hash, $r) = @_; + + if( !$self->{in_record} ) + { + my $elem = lc($hash->{LocalName}); + if( $elem eq 'record' && $hash->{Attributes}->{'{}status'}->{Value} ) + { + $self->status($hash->{Attributes}->{'{}status'}->{Value}); + } + elsif( $elem eq "header" ) + { + $self->set_handler(my $handler = HTTP::OAI::Header->new); + $self->header( $handler ); + $self->{in_record} = $hash->{Depth}; + } + elsif( $elem =~ /^metadata|about$/ ) + { + my $class = $r->handlers->{$elem} || "HTTP::OAI::Metadata"; + $self->set_handler(my $handler = $class->new); + $self->$elem($handler); + $self->{in_record} = $hash->{Depth}; + } } + + $self->SUPER::start_element($hash, $r); } sub end_element { - my ($self,$hash) = @_; - $self->SUPER::end_element($hash); - if( $self->{in_record} == $hash->{Depth} ) { - $self->SUPER::end_document(); - - my $elem = lc ($hash->{LocalName}); - $self->$elem ($self->get_handler); - $self->set_handler ( undef ); + my ($self,$hash, $r) = @_; + + $self->SUPER::end_element($hash, $r); + + if( $self->{in_record} == $hash->{Depth} ) + { + $self->set_handler( undef ); $self->{in_record} = 0; } } diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Response.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Response.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Response.pm 2011-06-23 13:31:52.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Response.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,420 +1,305 @@ package HTTP::OAI::Response; -use strict; -use warnings; - -=head1 NAME - -HTTP::OAI::Response - An OAI response - -=head1 DESCRIPTION - -C inherits from L and supplies some utility methods for OAI. - -=head1 METHODS - -=over 4 - -=cut +require POSIX; -use vars qw($BAD_REPLACEMENT_CHAR @ISA); +@ISA = qw( HTTP::Response HTTP::OAI::MemberMixin HTTP::OAI::SAX::Base ); -our $USE_EVAL = 1; - -use utf8; - -use POSIX qw/strftime/; - -use CGI qw/-oldstyle_urls/; -$CGI::USE_PARAM_SEMICOLON = 0; - -use HTTP::OAI::SAXHandler qw/ :SAX /; - -@ISA = qw( HTTP::Response XML::SAX::Base ); -$BAD_REPLACEMENT_CHAR = '?'; +use strict; -=item $r = new HTTP::OAI::Response([responseDate=>$rd][, requestURL=>$ru]) +# Backwards compatibility, pass any unknown methods to content +our $AUTOLOAD; -This constructor method returns a new HTTP::OAI::Response object. Optionally set the responseDate and requestURL. +sub DESTROY {} +sub AUTOLOAD +{ + my $self = shift; + $AUTOLOAD =~ s/^.*:://; -Use $r->is_error to test whether the request was successful. In addition to the HTTP response codes, the following codes may be returned: + # don't call a $self method here, because that might call AUTOLOAD again! + my $content = $self->{content}->[-1]; + return defined $content ? $content->$AUTOLOAD( @_ ) : undef; +} -600 - Error parsing XML or invalid OAI response +sub new +{ + my( $class, %self ) = @_; -Use $r->message to obtain a human-readable error message. + my $handlers = delete $self{handlers}; + my $cb = delete $self{onRecord}; -=cut + $self{responseDate} ||= POSIX::strftime("%Y-%m-%dT%H:%M:%S",gmtime).'Z'; + $self{requestURL} ||= CGI::self_url() if defined &CGI::self_url; -sub new { - my ($class,%args) = @_; my $self = $class->SUPER::new( - $args{code}, - $args{message} + delete($self{code}) || 200, + delete($self{message}) || "OK", + HTTP::Headers->new( %self ) ); - # Force headers - $self->{handlers} = $args{handlers} || {}; - $self->{_headers} = new HTTP::OAI::Headers(handlers=>$args{handlers}); - $self->{errors} = $args{errors} || []; - $self->{resume} = $args{resume}; - - # Force the version of OAI to try to parse - $self->version($args{version}); - - # Add the harvestAgent - $self->harvestAgent($args{harvestAgent}); - - # OAI initialisation - if( $args{responseDate} ) { - $self->responseDate($args{responseDate}); - } - if( $args{requestURL} ) { - $self->requestURL($args{requestURL}); - } - if( $args{xslt} ) { - $self->xslt($args{xslt}); - } - # Do some intelligent filling of undefined values - unless( defined($self->responseDate) ) { - $self->responseDate(strftime("%Y-%m-%dT%H:%M:%S",gmtime).'Z'); - } - unless( defined($self->requestURL) ) { - $self->requestURL(CGI::self_url()); - } - unless( defined($self->verb) ) { - my $verb = ref($self); - $verb =~ s/.*:://; - $self->verb($verb); - } + $self->{Depth} = 0; + $self->{handlers} = $handlers || {}; + $self->{onRecord} = $cb; + $self->{doc} = XML::LibXML::Document->new( '1.0', 'UTF-8' ); + $self->{content} = []; return $self; } -=item $r->copy_from( $r ) +# Back compatibility +sub errors { shift->error(@_) } +sub toDOM { shift->dom } + +# data that belong to this class +sub content { shift->_multi('content',@_) } +sub doc { shift->_elem('doc',@_) } +sub handlers { shift->_elem('handlers',@_) } -Copies an L $r into this object. - -=cut +# data that belong to this class's headers +sub version { shift->headers->header('version',@_) } +sub verb { shift->headers->header('verb',@_) } +sub error { shift->headers->header('error',@_) } +sub xslt { shift->headers->header('xslt',@_) } +sub responseDate { shift->headers->header('responseDate',@_) } +sub requestURL { shift->headers->header('requestURL',@_) } -sub copy_from +sub callback { - my( $self, $r ) = @_; - - # The DOM stuff will break if headers isn't an HTTP::OAI::Headers object - $self->{_headers}->{$_} = $r->{_headers}->{$_} - for keys %{$r->{_headers}}; - - $self->{_content} = $r->{_content}; + my( $self, $item, $list ) = @_; - $self->code( $r->code ); - $self->message( $r->message ); - $self->request( $r->request ); - - $self; + if( defined $self->{onRecord} ) + { + $self->{onRecord}->( $item, $self ); + } + else + { + Carp::confess( "Requires list parameter" ) if !defined $list; + $list->item( $item ); + } } -=item $headers = $r->headers - -Returns an L object. +# error on 600 as well +sub is_error { my $code = shift->code; $code != 0 && $code != 200 } +sub is_success { !shift->is_error } -=cut - -sub parse_file { - my ($self, $fh) = @_; +sub parse_string +{ + my( $self, $string ) = @_; - $self->code(200); - $self->message('parse_file'); - - my $parser = XML::LibXML::SAX->new( - Handler=>HTTP::OAI::SAXHandler->new( - Handler=>$self->headers - )); - -HTTP::OAI::Debug::trace( $self->verb . " " . ref($parser) . "->parse_file( ".ref($fh)." )" ); - $self->headers->set_handler($self); - $USE_EVAL ? - eval { $parser->parse_file($fh) } : - $parser->parse_file($fh); - $self->headers->set_handler(undef); # Otherwise we memory leak! - - if( $@ ) { - $self->code(600); - my $msg = $@; - $msg =~ s/^\s+//s; - $msg =~ s/\s+$//s; - if( $self->request ) { - $msg = "Error parsing XML from " . $self->request->uri . " " . $msg; - } else { - $msg = "Error parsing XML from string: $msg\n"; - } - $self->message($msg); - $self->errors(new HTTP::OAI::Error( - code=>'parseError', - message=>$msg - )); + eval { $self->SUPER::parse_string( $string ) }; + if( $@ ) + { + $self->code( 600 ); + $self->message( $@ ); } } -sub parse_string { - my ($self, $str) = @_; +sub parse_file +{ + my( $self, $fh ) = @_; - $self->code(200); - $self->message('parse_string'); - do { - my $parser = XML::LibXML::SAX->new( - Handler=>HTTP::OAI::SAXHandler->new( - Handler=>$self->headers - )); -HTTP::OAI::Debug::trace( $self->verb . " " . ref($parser) . "->parse_string(...)" ); - - $self->headers->set_handler($self); - eval { - local $SIG{__DIE__}; - $parser->parse_string( $str ) - }; - $self->headers->set_handler(undef); - undef $@ if $@ && $@ =~ /^done\n/; - - if( $@ ) { - die $@ if !$USE_EVAL; # rethrow - $self->errors(new HTTP::OAI::Error( - code=>'parseError', - message=>"Error while parsing XML: $@", - )); - } - } while( $@ && fix_xml(\$str,$@) ); - if( $@ ) { - $self->code(600); - my $msg = $@; - $msg =~ s/^\s+//s; - $msg =~ s/\s+$//s; - if( $self->request ) { - $msg = "Error parsing XML from " . $self->request->uri . " " . $msg; - } else { - $msg = "Error parsing XML from string: $msg\n"; - } - $self->message($msg); - $self->errors(new HTTP::OAI::Error( - code=>'parseError', - message=>$msg - )); + eval { $self->SUPER::parse_file( $fh ) }; + if( $@ ) + { + $self->code( 600 ); + $self->message( $@ ); } - $self; } -sub harvestAgent { shift->headers->header('harvestAgent',@_) } - -# Resume a request using a resumptionToken -sub resume { - my ($self,%args) = @_; - my $ha = $args{harvestAgent} || $self->harvestAgent || Carp::confess "Required argument harvestAgent is undefined"; - my $token = $args{resumptionToken} || Carp::confess "Required argument resumptionToken is undefined"; - my $verb = $args{verb} || $self->verb || Carp::confess "Required argument verb is undefined"; +sub generate +{ + my( $self, $driver ) = @_; - if( !ref($token) or !$token->isa( "HTTP::OAI::ResumptionToken" ) ) + if( !defined $self->version || $self->version eq "2.0" ) { - $token = HTTP::OAI::ResumptionToken->new( resumptionToken => $token ); - } - -HTTP::OAI::Debug::trace( "'" . $token->resumptionToken . "'" ); - - my $response; - %args = ( - baseURL=>$ha->repository->baseURL, - verb=>$verb, - resumptionToken=>$token->resumptionToken, - ); - $self->headers->{_args} = \%args; - - # Reset the resumptionToken - $self->headers->header('resumptionToken',undef); - - # Retry the request upto 3 times (leave a minute between retries) - my $tries = 3; - do { - $response = $ha->request(\%args, undef, undef, undef, $self); - unless( $response->is_success ) { - # If the token is expired, we need to break out (no point wasting 3 - # minutes) - if( my @errors = $response->errors ) { - for( grep { $_->code eq 'badResumptionToken' } @errors ) { - $tries = 0; - } + $driver->start_element( 'OAI-PMH', + 'xsi:schemaLocation' => 'http://www.openarchives.org/OAI/2.0/ http://www.openarchives.org/OAI/2.0/OAI-PMH.xsd', + ); + $driver->data_element( 'responseDate', $self->responseDate ); + my $url = URI->new( $self->requestURL ); + if( $self->error ) + { + $url->query( undef ); + $driver->data_element( 'request', $url ); + + for($self->error) + { + $_->generate( $driver ); } -HTTP::OAI::Debug::trace( sprintf("Error response to '%s': %d '%s'\n", - $args{resumptionToken}, - $response->code, - $response->message - ) ); - } - } while( - !$response->is_success and - $tries-- and - sleep(60) - ); - - if( $self->resumptionToken and - !$self->resumptionToken->is_empty and - $self->resumptionToken->resumptionToken eq $token->resumptionToken ) { - $self->code(600); - $self->message("Flow-control error: Resumption token hasn't changed (" . $response->request->uri . ")."); + } + elsif( $self->content ) + { + my %attr = $url->query_form; + $url->query( undef ); + $driver->data_element( 'request', $url, %attr ); + + my $content = ($self->content)[-1]; + $driver->start_element( $content->verb ); + $content->generate_body( $driver ); + $driver->end_element( $content->verb ); + } + $driver->end_element( 'OAI-PMH' ); } - - $self; -} - -sub generate { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - $self->headers->set_handler($handler); - - g_start_document($handler); - $handler->xml_decl({'Version'=>'1.0','Encoding'=>'UTF-8'}); - $handler->characters({'Data'=>"\n"}); - if( $self->xslt ) { - $handler->processing_instruction({ - 'Target' => 'xml-stylesheet', - 'Data' => 'type=\'text/xsl\' href=\''. $self->xslt . '\'' + elsif( $self->version eq "2.0s" ) + { + $driver->start_prefix_mapping({ + Prefix => 'static', + NamespaceURI => 'http://www.openarchives.org/OAI/2.0/static-repository', }); + $driver->start_element( 'static:Repository', + 'xsi:schemaLocation' => 'http://www.openarchives.org/OAI/2.0/ http://www.openarchives.org/OAI/2.0/OAI-PMH.xsd http://www.openarchives.org/OAI/2.0/static-repository http://www.openarchives.org/OAI/2.0/static-repository.xsd', + ); + for($self->content) + { + $driver->start_element( 'static:' . $_->verb ); + $_->generate_body( $driver ); + $driver->end_element( 'static:' . $_->verb ); + } + $driver->end_element( 'static:Repository' ); } - $self->headers->generate_start(); - - if( $self->errors ) { - for( $self->errors ) { - $_->set_handler($handler); - $_->generate(); - } - } else { - g_start_element($handler,'http://www.openarchives.org/OAI/2.0/',$self->verb,{}); - $self->generate_body(); - g_end_element($handler,'http://www.openarchives.org/OAI/2.0/',$self->verb,{}); - } - - $self->headers->generate_end(); - $handler->end_document(); -} - -sub toDOM { - my $self = shift; - $self->set_handler(my $builder = XML::LibXML::SAX::Builder->new()); - $self->generate(); - $builder->result; } -=item $errs = $r->errors([$err]) - -Returns and optionally adds to the OAI error list. Returns a reference to an array. +sub start_element +{ + my( $self, $hash ) = @_; -=cut + $hash->{Depth} = ++$self->{Depth}; -sub errors { - my $self = shift; - push @{$self->{errors}}, @_; - for (@_) { - if( $_->code eq 'badVerb' || $_->code eq 'badArgument' ) { - my $uri = URI->new($self->requestURL || ''); - $uri->query(''); - $self->requestURL($uri->as_string); - last; + if( $self->{Depth} == 1 ) + { + $self->version( $HTTP::OAI::VERSIONS{lc($hash->{NamespaceURI})} ); + if( !defined $self->version ) + { + die "Unrecognised namespace for OAI response: {$hash->{NamespaceURI}}$hash->{Name}"; + } + # static repositories don't contain ListIdentifiers or GetRecord, so + # instead we'll perform a complete ListRecords then extract the + # relevant data + if( $self->version eq "2.0s" ) + { + if( $self->verb eq "ListIdentifiers" || $self->verb eq "GetRecord" ) + { + $self->{_verb} = $self->verb; + $self->verb( "ListRecords" ); + } + elsif( $self->verb eq 'ListSets' ) + { + $self->content( HTTP::OAI::ListSets->new ); + $self->error(HTTP::OAI::Error->new( code => 'noSetHierarchy' )); + die "done\n"; + } + } + } + elsif( $self->{Depth} == 2 ) + { + my $elem = $hash->{LocalName}; + if( $elem eq "error" ) + { + $self->set_handler( my $error = HTTP::OAI::Error->new ); + $self->error( $error ); + } + elsif + ( + $elem =~ /^GetRecord|Identify|ListIdentifiers|ListMetadataFormats|ListRecords|ListSets$/ && + (!defined $self->verb || $elem eq $self->verb) + ) + { + if( $self->version eq "2.0s" && $self->verb eq "ListRecords" ) + { + my $metadataPrefix = $hash->{Attributes}{'{}metadataPrefix'}{Value}; + if( $metadataPrefix eq $self->headers->header( 'metadataPrefix' ) ) + { + $self->set_handler( my $content = "HTTP::OAI::$elem"->new ); + $self->content( [ $content ] ); + } + } + else + { + $self->set_handler( my $content = "HTTP::OAI::$elem"->new ); + $self->content( [ $content ] ); + } } } - @{$self->{errors}}; -} - -sub next { undef } - -=item $rd = $r->responseDate( [$rd] ) - -Returns and optionally sets the response date. - -=cut - -sub responseDate { shift->headers->header('responseDate',@_) } - -=item $ru = $r->requestURL( [$ru] ) - -Returns and optionally sets the request URL. - -=cut -sub requestURL { - my $self = shift; - $_[0] =~ s/;/&/sg if @_ && $_[0] !~ /&/; - $self->headers->header('requestURL',@_) + $self->SUPER::start_element( $hash, $self ); } -=item $verb = $r->verb( [$verb] ) - -Returns and optionally sets the OAI verb. - -=cut - -sub verb { shift->headers->header('verb',@_) } - -=item $r->version - -Return the version of the OAI protocol used by the remote site (protocolVersion is automatically changed by the underlying API). - -=cut - -sub version { shift->headers->header('version',@_) } - -=item $r->xslt( $url ) - -Set the stylesheet to use in a response. - -=cut +sub end_element +{ + my( $self, $hash ) = @_; -sub xslt { shift->headers->header('xslt',@_) } + $hash->{Depth} = $self->{Depth}; -# HTTP::Response::is_error doesn't consider 0 an error -sub is_error { return shift->code != 200 } + $self->SUPER::end_element( $hash, $self ); -sub end_element { - my ($self,$hash) = @_; - my $elem = lc($hash->{Name}); - $self->SUPER::end_element($hash); - if( $elem eq 'error' ) { - my $code = $hash->{Attributes}->{'{}code'}->{'Value'} || 'oai-lib: Undefined error code'; - my $msg = $hash->{Text} || 'oai-lib: Undefined error message'; - $self->errors(new HTTP::OAI::Error( - code=>$code, - message=>$msg, - )); - if( $code !~ '^noRecordsMatch|noSetHierarchy$' ) { - $self->verb($elem); - $self->code(600); - $self->message("Response contains error(s): " . $self->{errors}->[0]->code . " (" . $self->{errors}->[0]->message . ")"); + if( $self->{Depth} == 2 ) + { + my $elem = $hash->{LocalName}; + if( $elem eq "responseDate" || $elem eq "requestURL" ) + { + $self->headers->header( $elem, $hash->{Text} ); + } + elsif( $elem eq "request" ) + { + $self->headers->header("request",$hash->{Text}); + my $uri = new URI($hash->{Text}); + $uri->query_form(map { ($_->{LocalName},$_->{Value}) } values %{$hash->{Attributes}}); + $self->headers->header("requestURL",$uri); + } + elsif( $elem eq "error" ) + { + my $error = $self->get_handler; + if( $error->code !~ /^noRecordsMatch|noSetHierarchy$/ ) + { + $self->code( 500 ); + $self->message( $error->code . ": " . $error->message ); + } + } + # extract ListIdentifiers and GetRecord from a static ListRecords + elsif( defined($self->get_handler) && $self->version eq "2.0s" ) + { + # fake ListIdentifiers/GetRecord + if( defined(my $verb = $self->{_verb}) ) + { + if( $verb eq "ListIdentifiers" ) + { + my $content = HTTP::OAI::ListIdentifiers->new; + $content->item( map { $_->header } ($self->content)[-1]->item ); + $self->content( [ $content ] ); + } + elsif( $verb eq "GetRecord" ) + { + my $content = HTTP::OAI::GetRecord->new; + $content->item( [grep { $_->identifier eq $self->headers->header('identifier') } ($self->content)[-1]->item] ); + $self->content( [ $content ] ); + if( !defined( ($content->item)[0] ) ) + { + $self->content( [] ); + $self->error(my $error = HTTP::OAI::Error->new( code => 'idDoesNotExist' )); + $self->code( 500 ); + $self->message( $error->code . ": " . $error->message ); + } + } + } + die "done\n"; + } + $self->set_handler( undef ); + } + if( $self->{Depth} == 1 ) + { + if( $self->version eq "2.0s" && !$self->error && !$self->content ) + { + $self->error(my $error = HTTP::OAI::Error->new( code => 'cannotDisseminateFormat' )); + $self->code( 500 ); + $self->message( $error->code . ": " . $error->message ); + } + # allow callers to do $r->next to check whether anything came back + if( !$self->content && defined(my $verb = $self->verb) ) + { + $self->content( "HTTP::OAI::$verb"->new ); } } -} -sub fix_xml { - my ($str, $err) = @_; - return 0 unless( $err =~ /not well-formed.*byte (\d+)/ ); - my $offset = $1; - if( substr($$str,$offset-1,1) eq '&' ) { - substr($$str,$offset-1,1) = '&'; - return 1; - } elsif( substr($$str,$offset-1,1) eq '<' ) { - substr($$str,$offset-1,1) = '<'; - return 1; - } elsif( substr($$str,$offset,1) ne $BAD_REPLACEMENT_CHAR ) { - substr($$str,$offset,1) = $BAD_REPLACEMENT_CHAR; - return 1; - } else { - return 0; - } + $self->{Depth}--; } 1; - -__END__ - -=back - -=head1 NOTE - requestURI/request - -Version 2.0 of OAI uses a "request" element to contain the client's request, rather than a URI. The OAI-PERL library automatically converts from a URI into the appropriate request structure, and back again when harvesting. - -The exception to this rule is for badVerb errors, where the arguments will not be available for conversion into a URI. diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/ResumptionToken.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/ResumptionToken.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/ResumptionToken.pm 2007-06-28 11:16:40.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/ResumptionToken.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,57 +1,40 @@ package HTTP::OAI::ResumptionToken; -use strict; -use warnings; - -use HTTP::OAI::SAXHandler qw/ :SAX /; +@ISA = qw( HTTP::OAI::MemberMixin XML::SAX::Base ); -use vars qw( @ISA ); -@ISA = qw( HTTP::OAI::Encapsulation ); +use strict; use overload "bool" => \¬_empty; -sub new { - my ($class,%args) = @_; - my $self = $class->SUPER::new(%args); - - $self->resumptionToken($args{resumptionToken}) unless $self->resumptionToken; - $self->expirationDate($args{expirationDate}) unless $self->expirationDate; - $self->completeListSize($args{completeListSize}) unless $self->completeListSize; - $self->cursor($args{cursor}) unless $self->cursor; - - $self; -} - sub resumptionToken { shift->_elem('resumptionToken',@_) } -sub expirationDate { shift->_attr('expirationDate',@_) } -sub completeListSize { shift->_attr('completeListSize',@_) } -sub cursor { shift->_attr('cursor',@_) } +sub expirationDate { shift->_elem('expirationDate',@_) } +sub completeListSize { shift->_elem('completeListSize',@_) } +sub cursor { shift->_elem('cursor',@_) } sub not_empty { defined($_[0]->resumptionToken) and length($_[0]->resumptionToken) > 0 } sub is_empty { !not_empty(@_) } sub generate { - my ($self) = @_; - return unless (my $handler = $self->get_handler); - my $attr; - while(my ($key,$value) = each %{$self->_attr}) { - $attr->{"{}$key"} = {'Name'=>$key,'LocalName'=>$key,'Value'=>$value,'Prefix'=>'','NamespaceURI'=>'http://www.openarchives.org/OAI/2.0/'}; - } - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','resumptionToken',$attr,$self->resumptionToken); + my( $self, $driver ) = @_; + + $driver->data_element( 'resumptionToken', $self->resumptionToken, + expirationDate => scalar($self->expirationDate), + completeListSize => scalar($self->completeListSize), + cursor => scalar($self->cursor), + ); } sub end_element { my ($self,$hash) = @_; $self->SUPER::end_element($hash); - if( lc($hash->{Name}) eq 'resumptiontoken' ) { - my $attr = $hash->{Attributes}; + if( lc($hash->{LocalName}) eq 'resumptiontoken' ) { $self->resumptionToken($hash->{Text}); + my $attr = $hash->{Attributes}; $self->expirationDate($attr->{'{}expirationDate'}->{'Value'}); $self->completeListSize($attr->{'{}completeListSize'}->{'Value'}); $self->cursor($attr->{'{}cursor'}->{'Value'}); } -#warn "Got RT: $hash->{Text}"; } 1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/SAX/Base.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/SAX/Base.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/SAX/Base.pm 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/SAX/Base.pm 2014-04-03 12:45:44.000000000 +0000 @@ -0,0 +1,65 @@ +package HTTP::OAI::SAX::Base; + +@ISA = qw( XML::SAX::Base ); + +use strict; + +sub toString +{ + my $str = shift->dom->toString( 1 ); + utf8::decode($str); + return $str; +} + +sub parse_string +{ + my( $self, $string ) = @_; + + my $parser = XML::LibXML::SAX->new( + Handler => HTTP::OAI::SAX::Text->new( + Handler => $self, + ) + ); + $parser->parse_string( $string ); +} + +sub parse_file +{ + my( $self, $fh ) = @_; + + my $parser = XML::LibXML::SAX->new( + Handler => HTTP::OAI::SAX::Text->new( + Handler => $self, + ) + ); + $parser->parse_file( $fh ); +} + +sub generate +{ + my( $self, $driver ) = @_; + + # override this +} + +sub dom { + my $self = shift; + if( my $dom = shift ) { + my $driver = XML::LibXML::SAX::Parser->new( + Handler=>HTTP::OAI::SAXHandler->new( + Handler=>$self + )); + $driver->generate($dom); + } else { + my $driver = HTTP::OAI::SAX::Driver->new( + Handler => my $builder = XML::LibXML::SAX::Builder->new() + ); + $driver->start_oai_pmh(); + $self->generate( $driver ); + $driver->end_oai_pmh(); + + return $builder->result; + } +} + +1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/SAX/Driver.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/SAX/Driver.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/SAX/Driver.pm 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/SAX/Driver.pm 2014-04-03 12:45:44.000000000 +0000 @@ -0,0 +1,213 @@ +package HTTP::OAI::SAX::Driver; + +use XML::LibXML; +use base XML::SAX::Base; +use XML::NamespaceSupport; + +use strict; + +=pod + +=head1 NAME + +HTTP::OAI::SAXHandler - SAX2 utility filter + +=head1 DESCRIPTION + +This module provides utility methods for SAX2, including collapsing multiple "characters" events into a single event. + +This module exports methods for generating SAX2 events with Namespace support. This *isn't* a fully-fledged SAX2 generator! + +=over 4 + +=item $h = HTTP::OAI::SAXHandler->new() + +Class constructor. + +=cut + +sub new +{ + my( $class, %self ) = @_; + + $self{ns} = XML::NamespaceSupport->new; + + my $self = $class->SUPER::new( %self ); + + return $self; +} + +sub generate +{ + my( $self, $node ) = @_; + + my $nodeType = $node->nodeType; + + if( $nodeType == XML_DOCUMENT_NODE ) + { + $self->generate( $node->documentElement ); + } + elsif( $nodeType == XML_DOCUMENT_FRAG_NODE ) + { + $self->generate( $_ ) for $node->childNodes; + } + elsif( $nodeType == XML_ELEMENT_NODE ) + { + $self->start_element( $node->nodeName, map { + $_->nodeName => $_->nodeValue + } $node->attributes + ); + $self->generate( $_ ) for $node->childNodes; + $self->end_element( $node->nodeName ); + } + elsif( $nodeType == XML_TEXT_NODE ) + { + $self->characters( { Data => $node->nodeValue } ); + } +} + +sub start_oai_pmh +{ + my( $self ) = @_; + + $self->start_document; + $self->xml_decl({'Version'=>'1.0','Encoding'=>'UTF-8'}); + $self->characters({'Data'=>"\n"}); + $self->start_prefix_mapping({ + Prefix => "", + NamespaceURI => HTTP::OAI::OAI_NS(), + }); + $self->start_prefix_mapping({ + Prefix => "xsi", + NamespaceURI => "http://www.w3.org/2001/XMLSchema-instance", + }); +} + +sub end_oai_pmh +{ + my( $self ) = @_; + + $self->end_prefix_mapping({ + Prefix => "", + NamespaceURI => HTTP::OAI::OAI_NS(), + }); + $self->end_prefix_mapping({ + Prefix => "xsi", + NamespaceURI => "http://www.w3.org/2001/XMLSchema-instance", + }); + $self->end_document; +} + +sub data_element { + my( $self, $Name, $value, @attr ) = @_; + + $self->start_element( $Name, @attr ); + $self->characters( {Data => $value} ); + $self->end_element( $Name ); +} + +sub start_prefix_mapping +{ + my( $self, $hash ) = @_; + + $self->{ns}->declare_prefix( $hash->{Prefix}, $hash->{NamespaceURI} ); + + $self->SUPER::start_prefix_mapping( $hash ); +} + +sub start_element +{ + my( $self, $Name, @attr ) = @_; + + $self->{ns}->push_context; + + my %attr; + while(my( $key, $value ) = splice(@attr,0,2)) + { + next if !defined $value; + my( $NamespaceURI, $Prefix, $LocalName ); + if( $key =~ /^xmlns:(.+)$/ ) + { + $self->start_prefix_mapping( {Prefix => $1, NamespaceURI => $value} ); + $NamespaceURI = "http://www.w3.org/2000/xmlns/"; + $Prefix = "xmlns"; + $LocalName = $1; + } + elsif( $key eq "xmlns" ) + { + $self->start_prefix_mapping( {Prefix => '', NamespaceURI => $value} ); + $NamespaceURI = ''; + $Prefix = ''; + $LocalName = $key; + } + elsif( $key =~ /^(.+):(.+)$/ ) + { + $NamespaceURI = $self->{ns}->get_uri( $1 ); + $Prefix = $1; + $LocalName = $2; + } + else + { + $NamespaceURI = ''; + $Prefix = ''; + $LocalName = $key; + } + $attr{"{$NamespaceURI}$LocalName"} = { + NamespaceURI => $NamespaceURI, + Prefix => $Prefix, + LocalName => $LocalName, + Name => $key, + Value => $value, + }; + } + + my ($Prefix,$LocalName) = split /:/, $Name; + + unless(defined($LocalName)) { + $LocalName = $Prefix; + $Prefix = ''; + } + + my $NamespaceURI = $self->{ns}->get_uri( $Prefix ); + + $self->SUPER::start_element({ + 'NamespaceURI'=>$NamespaceURI, + 'Name'=>$Name, + 'Prefix'=>$Prefix, + 'LocalName'=>$LocalName, + 'Attributes'=>\%attr + }); +} + +sub end_element +{ + my( $self, $Name ) = @_; + + my ($Prefix,$LocalName) = split /:/, $Name; + + unless(defined($LocalName)) { + $LocalName = $Prefix; + $Prefix = ''; + } + + my $NamespaceURI = $self->{ns}->get_uri( $Prefix ); + + $self->SUPER::end_element({ + 'NamespaceURI'=>$NamespaceURI, + 'Name'=>$Name, + 'Prefix'=>$Prefix, + 'LocalName'=>$LocalName, + }); + + $self->{ns}->pop_context; +} + +1; + +__END__ + +=back + +=head1 AUTHOR + +Tim Brody diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/SAX/Text.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/SAX/Text.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/SAX/Text.pm 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/SAX/Text.pm 2014-04-03 12:45:44.000000000 +0000 @@ -0,0 +1,45 @@ +package HTTP::OAI::SAX::Text; + +@ISA = qw( XML::SAX::Base ); + +use strict; + +sub start_element +{ + ( my $self, my $hash, @_ ) = @_; + + $self->{Data} = ""; + push @{$self->{Attributes}}, $hash->{Attributes}; + + $self->SUPER::start_element( $hash, @_ ); +} + +sub characters { $_[0]->{Data} .= $_[1]->{Data} } + +sub end_element +{ + ( my $self, my $hash, @_ ) = @_; + + $hash->{Text} = $self->{Data}; + $hash->{Attributes} = pop @{$self->{Attributes} || []}; + + # strip surrounding whitespace in leaf nodes + $hash->{Text} =~ s/^\s+//; + $hash->{Text} =~ s/\s+$//; + + $self->SUPER::characters( {Data => $self->{Data}}, @_ ); + + $self->{Data} = ""; + + $self->SUPER::end_element( $hash, @_ ); +} + +1; + +=head1 NAME + +HTTP::OAI::SAX::Text + +=head1 DESCRIPTION + +This module adds Text and Attributes to the end_element call. This is only useful for leaf nodes (elements that don't contain any child elements). diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/SAX/Trace.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/SAX/Trace.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/SAX/Trace.pm 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/SAX/Trace.pm 2014-04-03 12:45:44.000000000 +0000 @@ -0,0 +1,22 @@ +package HTTP::OAI::SAX::Trace; + +#use base XML::SAX::Base; + +our $AUTOLOAD; + +sub new +{ + my( $class, %self ) = @_; + bless \%self, $class; +} + +sub DESTROY {} + +sub AUTOLOAD +{ + $AUTOLOAD =~ s/^.*:://; +HTTP::OAI::Debug::sax( $AUTOLOAD . ": " . Data::Dumper::Dumper( @_[1..$#_] ) ); + shift->{Handler}->$AUTOLOAD( @_ ); +} + +1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Set.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Set.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Set.pm 2011-08-04 13:46:39.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Set.pm 2014-04-03 12:45:44.000000000 +0000 @@ -1,71 +1,52 @@ package HTTP::OAI::Set; -use strict; -use warnings; - -use HTTP::OAI::SAXHandler qw/ :SAX /; - -use vars qw( @ISA ); -@ISA = qw( HTTP::OAI::Encapsulation ); +@ISA = qw( HTTP::OAI::MemberMixin XML::SAX::Base ); -sub new { - my ($class,%args) = @_; - my $self = $class->SUPER::new(%args); - - $self->{handlers} = $args{handlers}; - - $self->setSpec($args{setSpec}); - $self->setName($args{setName}); - $self->{setDescription} = $args{setDescription} || []; - $self; -} +use strict; sub setSpec { shift->_elem('setSpec',@_) } sub setName { shift->_elem('setName',@_) } -sub setDescription { - my $self = shift; - push(@{$self->{setDescription}}, @_); - return @{$self->{setDescription}}; -} -sub next { shift @{shift->{setDescription}} } +sub setDescription { shift->_multi('setDescription',@_) } sub generate { - my ($self) = @_; - return unless defined(my $handler = $self->get_handler); - g_start_element($handler,'http://www.openarchives.org/OAI/2.0/','set',{}); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','setSpec',{},$self->setSpec); - g_data_element($handler,'http://www.openarchives.org/OAI/2.0/','setName',{},$self->setName); + my( $self, $driver ) = @_; + + $driver->start_element( 'set' ); + $driver->data_element( 'setSpec', $self->setSpec ); + $driver->data_element( 'setName', $self->setName ); for( $self->setDescription ) { - $_->set_handler($handler); $_->generate; } - g_end_element($handler,'http://www.openarchives.org/OAI/2.0/','set'); + $driver->end_element( 'set' ); } sub start_element { - my ($self,$hash) = @_; + my ($self,$hash,$r) = @_; my $elem = lc($hash->{Name}); if( $elem eq 'setdescription' ) { - $self->setDescription(my $d = $self->{handlers}->{description}->new(version=>$self->version)); - $self->set_handler($d); - g_start_document($d); + $self->setDescription(my $desc = HTTP::OAI::Metadata->new); + $self->set_handler($desc); + $self->{in_desc} = $hash->{Depth}; } - $self->SUPER::start_element($hash); + $self->SUPER::start_element($hash,$r); } sub end_element { - my ($self,$hash) = @_; - $self->SUPER::end_element($hash); - my $elem = lc($hash->{Name}); - if( $elem eq 'setspec' ) { - die ref($self)." Parse error: Empty setSpec\n" unless $hash->{Text}; - $self->setSpec($hash->{Text}); - } elsif( $elem eq 'setname' ) { - warn ref($self)." Parse error: Empty setName\n", return - unless $hash->{Text}; - $self->setName($hash->{Text}); - } elsif( $elem eq 'setdescription' ) { - $self->SUPER::end_document(); - $self->set_handler(undef); + my ($self,$hash,$r) = @_; + $self->SUPER::end_element($hash,$r); + if( $self->{in_desc} ) + { + if( $self->{in_desc} == $hash->{Depth} ) + { + $self->set_handler( undef ); + } + } + else + { + my $elem = $hash->{Name}; + if( $elem =~ /^setSpec|setName$/ ) + { + $self->$elem( $hash->{Text} ); + } } } diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/UserAgent.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/UserAgent.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/UserAgent.pm 2011-06-23 13:38:23.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/UserAgent.pm 2014-04-03 12:45:44.000000000 +0000 @@ -26,121 +26,140 @@ sub redirect_ok { 1 } -sub request -{ - my $self = shift; - my ($request, $arg, $size, $previous, $response) = @_; - if( ref($request) eq 'HASH' ) { - $request = HTTP::Request->new(GET => _buildurl(%$request)); - } +sub _oai { + my( $self, @args ) = @_; + my $cb = ref($args[0]) eq "CODE" ? shift @args : undef; + my %args = @args; + $cb = delete $args{onRecord} || $cb || $self->{onRecord}; - my $delay = $self->delay; - if( defined $delay ) - { - if( ref($delay) eq "CODE" ) - { - $delay = &$delay( $self->last_request_completed ); - } - select(undef,undef,undef,$delay) if $delay > 0; + my $handlers = delete $args{handlers} || {}; + + if( !$args{force} && (my @errors = HTTP::OAI::Repository::validate_request(%args)) ) { + return new HTTP::OAI::Response( + code=>503, + message=>'Invalid Request (use \'force\' to force a non-conformant request): ' . $errors[0]->toString, + errors=>\@errors + ); } - if( !defined $response ) - { - $response = $self->SUPER::request(@_); - $self->last_request_completed( time ); - return $response; + # Get rid of any empty arguments + for( keys %args ) { + delete $args{$_} if !defined($args{$_}) || !length($args{$_}); } + my $request = HTTP::Request->new( GET => $self->_buildurl(%args) ); + + delete $args{force}; + + my $response = HTTP::OAI::Response->new( + %args, + handlers => $handlers, + onRecord => $cb, + ); + $response->request( $request ); my $parser = XML::LibXML->new( - Handler => HTTP::OAI::SAXHandler->new( - Handler => $response->headers - )); - $parser->{request} = $request; + Handler => HTTP::OAI::SAX::Trace->new( + Handler => HTTP::OAI::SAX::Text->new( + Handler => $response + ) ) ); $parser->{content_length} = 0; $parser->{content_buffer} = Encode::encode('UTF-8',''); - $response->code(200); - $response->message('lwp_callback'); - $response->headers->set_handler($response); -HTTP::OAI::Debug::trace( $response->verb . " " . ref($parser) . "->parse_chunk()" ); + +HTTP::OAI::Debug::trace( $args{verb} . " " . ref($parser) . "->parse_chunk()" ); my $r; { local $SIG{__DIE__}; $r = $self->SUPER::request($request,sub { - $self->lwp_callback( $parser, @_ ) - }); - $self->lwp_endparse( $parser ) if $r->is_success; + $self->lwp_callback( $parser, @_ ) + }); + if( $r->is_success && !defined $r->headers->header( 'Client-Aborted' ) ) + { + eval { $self->lwp_endparse( $parser ) }; + if( $@ ) + { + $r->headers->header( 'Client-Aborted', 'die' ); + $r->headers->header( 'X-Died', $@ ); + } + } } - if( defined($r) && defined($r->headers->header( 'Client-Aborted' )) && $r->headers->header( 'Client-Aborted' ) eq 'die' ) + if( defined($r->headers->header( 'Client-Aborted' )) && $r->headers->header( 'Client-Aborted' ) eq 'die' ) { my $err = $r->headers->header( 'X-Died' ); - if( $err !~ /^done\n/ ) + if( $err eq "done" ) + { + $r->code(200); + $r->message("OK"); + } + else { $r->code(500); $r->message( 'An error occurred while parsing: ' . $err ); } } - - $response->headers->set_handler(undef); - - # Allow access to the original headers through 'previous' - $response->previous($r); my $cnt_len = $parser->{content_length}; undef $parser; # OAI retry-after if( defined($r) && $r->code == 503 && defined(my $timeout = $r->headers->header('Retry-After')) ) { - $self->last_request_completed( time ); if( $self->{recursion}++ > 10 ) { - $self->{recursion} = 0; - warn ref($self)."::request (retry-after) Given up requesting after 10 retries\n"; - return $response->copy_from( $r ); + $r->code(500); + $r->message("Server did not give a response after 10 retries"); + return $r; } if( !$timeout or $timeout =~ /\D/ or $timeout < 0 or $timeout > 86400 ) { - warn ref($self)." Archive specified an odd duration to wait (\"".($timeout||'null')."\")\n"; - return $response->copy_from( $r ); + $r->code(500); + $r->message("Server specified an unsupported duration to wait (\"".($timeout||'null')."\""); + return $r; } HTTP::OAI::Debug::trace( "Waiting $timeout seconds" ); sleep($timeout+10); # We wait an extra 10 secs for safety - return $self->request($request,undef,undef,undef,$response); + return $self->_oai(@args); # Got an empty response } elsif( defined($r) && $r->is_success && $cnt_len == 0 ) { - $self->last_request_completed( time ); if( $self->{recursion}++ > 10 ) { - $self->{recursion} = 0; - warn ref($self)."::request (empty response) Given up requesting after 10 retries\n"; - return $response->copy_from( $r ); + $r->code(500); + $r->message("No content in server response"); + return $r; } HTTP::OAI::Debug::trace( "Retrying on empty response" ); sleep(5); - return $self->request($request,undef,undef,undef,$response); + return $self->_oai(@args); # An HTTP error occurred } elsif( $r->is_error ) { - $response->copy_from( $r ); - $response->errors(HTTP::OAI::Error->new( - code=>$r->code, - message=>$r->message, - )); + return $r; # An error occurred during parsing } elsif( $@ ) { - $response->code(my $code = $@ =~ /read timeout/ ? 504 : 600); - $response->message($@); - $response->errors(HTTP::OAI::Error->new( - code=>$code, - message=>$@, - )); + $r->code(my $code = $@ =~ /read timeout/ ? 504 : 600); + $r->message($@); + return $r; } - # Reset the recursion timer - $self->{recursion} = 0; - - # Copy original $request => OAI $response to allow easy - # access to the requested URL - $response->request($request); + # access the original response via previous + $response->previous($r); + + return $response; +} + +sub request +{ + my( $self, @args ) = @_; + + my $delay = $self->delay; + if( defined $delay ) + { + if( ref($delay) eq "CODE" ) + { + $delay = &$delay( $self->last_request_completed ); + } + select(undef,undef,undef,$delay) if $delay > 0; + } + + my $r = $self->SUPER::request( @args ); $self->last_request_completed( time ); - $response; + return $r; } sub lwp_badchar @@ -217,23 +236,22 @@ } sub _buildurl { - my %attr = @_; - Carp::confess "_buildurl requires baseURL" unless $attr{'baseURL'}; - Carp::confess "_buildurl requires verb" unless $attr{'verb'}; - my $uri = new URI(delete($attr{'baseURL'})); - if( defined($attr{resumptionToken}) && !$attr{force} ) { - $uri->query_form(verb=>$attr{'verb'},resumptionToken=>$attr{'resumptionToken'}); + my( $self, %args ) = @_; + + Carp::confess "Requires verb parameter" unless $args{'verb'}; + + my $uri = URI->new( $self->baseURL ); + return $uri->as_string if $uri->scheme eq "file"; + + if( defined($args{resumptionToken}) && !$args{force} ) { + $uri->query_form(verb=>$args{'verb'},resumptionToken=>$args{'resumptionToken'}); } else { - delete $attr{force}; + delete $args{force}; # http://www.cshc.ubc.ca/oai/ breaks if verb isn't first, doh - $uri->query_form(verb=>delete($attr{'verb'}),%attr); + $uri->query_form(verb=>delete($args{'verb'}),%args); } - return $uri->as_string; -} -sub url { - my $self = shift; - return _buildurl(@_); + return $uri->as_string; } sub decompress { @@ -309,10 +327,6 @@ metadataPrefix => $mdp set => $set -=item $str = $ua->url(baseURL=>$baseref, verb=>$verb, ...) - -Takes the same arguments as request, but returns the URL that would be requested. - =item $time_d = $ua->delay( $time_d ) Return and optionally set a time (in seconds) to wait between requests. $time_d may be a CODEREF. diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI/Verb.pm libhttp-oai-perl-4.03/lib/HTTP/OAI/Verb.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI/Verb.pm 1970-01-01 00:00:00.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI/Verb.pm 2014-04-03 12:45:44.000000000 +0000 @@ -0,0 +1,62 @@ +package HTTP::OAI::Verb; + +@ISA = qw( HTTP::OAI::MemberMixin HTTP::OAI::SAX::Base ); + +use strict; + +# back compatibility +sub toDOM +{ + shift->dom +} +sub errors { shift->_multi('error',@_) } +for(qw( parse_string parse_file )) +{ + no strict; + my $fn = $_; + *$fn = sub { + my( $self, $io ) = @_; + + my $r = HTTP::OAI::Response->new( + verb => $self->verb, + handlers => $self->{handlers}, + ); + $r->$fn( $io ); + if( $r->is_error ) + { + die "Error parsing: ".$r->code." ".$r->message; + } + elsif( $r->error ) + { + $self->errors( $r->error ); + } + else + { + my $content = ($r->content)[-1]; + # HACK HACK HACK + %$self = %$content; + } + }; +} + +sub verb +{ + my $class = ref($_[0]); + $class =~ s/^.*:://; + return $class; +} + +sub generate +{ + my( $self, $driver ) = @_; + + $driver->start_element( 'OAI-PMH', + 'xsi:schemaLocation' => 'http://www.openarchives.org/OAI/2.0/ http://www.openarchives.org/OAI/2.0/OAI-PMH.xsd', + ); + $driver->start_element( $self->verb ); + $self->generate_body( $driver ); + $driver->end_element( $self->verb ); + $driver->end_element( 'OAI-PMH' ); +} + +1; diff -Nru libhttp-oai-perl-3.27/lib/HTTP/OAI.pm libhttp-oai-perl-4.03/lib/HTTP/OAI.pm --- libhttp-oai-perl-3.27/lib/HTTP/OAI.pm 2011-08-04 14:26:42.000000000 +0000 +++ libhttp-oai-perl-4.03/lib/HTTP/OAI.pm 2014-04-07 12:03:40.000000000 +0000 @@ -2,7 +2,9 @@ use strict; -our $VERSION = '3.27'; +our $VERSION = '4.03'; + +use constant OAI_NS => 'http://www.openarchives.org/OAI/2.0/'; # perlcore use Carp; @@ -13,6 +15,8 @@ use HTTP::Headers; use HTTP::Request; use HTTP::Response; +require LWP::UserAgent; +require LWP::MemberMixin; # xml related stuff use XML::SAX; @@ -22,11 +26,23 @@ use XML::LibXML::SAX::Parser; use XML::LibXML::SAX::Builder; +use HTTP::OAI::SAX::Driver; +use HTTP::OAI::SAX::Text; + # debug use HTTP::OAI::Debug; +use HTTP::OAI::SAX::Trace; + +# generic superclasses +use HTTP::OAI::SAX::Base; +use HTTP::OAI::MemberMixin; +use HTTP::OAI::Verb; +use HTTP::OAI::PartialList; + +# utility classes +use HTTP::OAI::Response; # oai data objects -use HTTP::OAI::Encapsulation; # Basic XML handling stuff use HTTP::OAI::Metadata; # Super class of all data objects use HTTP::OAI::Error; use HTTP::OAI::Header; @@ -35,13 +51,6 @@ use HTTP::OAI::ResumptionToken; use HTTP::OAI::Set; -# parses OAI headers and other utility bits -use HTTP::OAI::Headers; - -# generic superclasses -use HTTP::OAI::Response; -use HTTP::OAI::PartialList; - # oai verbs use HTTP::OAI::GetRecord; use HTTP::OAI::Identify; @@ -66,6 +75,23 @@ HTTP::OAI::Debug::level( '+sax' ); } +our %VERSIONS = ( + 'http://www.openarchives.org/oai/1.0/oai_getrecord' => '1.0', + 'http://www.openarchives.org/oai/1.0/oai_identify' => '1.0', + 'http://www.openarchives.org/oai/1.0/oai_listidentifiers' => '1.0', + 'http://www.openarchives.org/oai/1.0/oai_listmetadataformats' => '1.0', + 'http://www.openarchives.org/oai/1.0/oai_listrecords' => '1.0', + 'http://www.openarchives.org/oai/1.0/oai_listsets' => '1.0', + 'http://www.openarchives.org/oai/1.1/oai_getrecord' => '1.1', + 'http://www.openarchives.org/oai/1.1/oai_identify' => '1.1', + 'http://www.openarchives.org/oai/1.1/oai_listidentifiers' => '1.1', + 'http://www.openarchives.org/oai/1.1/oai_listmetadataformats' => '1.1', + 'http://www.openarchives.org/oai/1.1/oai_listrecords' => '1.1', + 'http://www.openarchives.org/oai/1.1/oai_listsets' => '1.1', + 'http://www.openarchives.org/oai/2.0/' => '2.0', + 'http://www.openarchives.org/oai/2.0/static-repository' => '2.0s', +); + 1; __END__ diff -Nru libhttp-oai-perl-3.27/Makefile.PL libhttp-oai-perl-4.03/Makefile.PL --- libhttp-oai-perl-3.27/Makefile.PL 2011-08-04 14:21:02.000000000 +0000 +++ libhttp-oai-perl-4.03/Makefile.PL 2014-04-03 12:45:44.000000000 +0000 @@ -9,7 +9,7 @@ WriteMakefile( NAME => 'HTTP-OAI', VERSION_FROM => 'lib/HTTP/OAI.pm', - EXE_FILES => [ qw( bin/oai_browser.pl ) ], + EXE_FILES => [ qw( bin/oai_browser.pl bin/oai_pmh.pl ) ], PREREQ_PM => { 'Encode' => 2.12, 'XML::LibXML' => 1.60, diff -Nru libhttp-oai-perl-3.27/MANIFEST libhttp-oai-perl-4.03/MANIFEST --- libhttp-oai-perl-3.27/MANIFEST 2010-04-08 08:17:02.000000000 +0000 +++ libhttp-oai-perl-4.03/MANIFEST 2014-04-07 12:03:35.000000000 +0000 @@ -1,7 +1,7 @@ bin/oai_browser.pl +bin/oai_pmh.pl bin/oai_static_gateway.pl CHANGES -LICENSE examples/badbytes.xml examples/getrecord.xml examples/identify.xml @@ -14,12 +14,12 @@ lib/HTTP/OAI/GetRecord.pm lib/HTTP/OAI/Harvester.pm lib/HTTP/OAI/Header.pm -lib/HTTP/OAI/Headers.pm lib/HTTP/OAI/Identify.pm lib/HTTP/OAI/ListIdentifiers.pm lib/HTTP/OAI/ListMetadataFormats.pm lib/HTTP/OAI/ListRecords.pm lib/HTTP/OAI/ListSets.pm +lib/HTTP/OAI/MemberMixin.pm lib/HTTP/OAI/Metadata.pm lib/HTTP/OAI/Metadata/METS.pm lib/HTTP/OAI/Metadata/OAI_DC.pm @@ -31,13 +31,21 @@ lib/HTTP/OAI/Repository.pm lib/HTTP/OAI/Response.pm lib/HTTP/OAI/ResumptionToken.pm +lib/HTTP/OAI/SAX/Base.pm +lib/HTTP/OAI/SAX/Driver.pm +lib/HTTP/OAI/SAX/Text.pm +lib/HTTP/OAI/SAX/Trace.pm lib/HTTP/OAI/SAXHandler.pm lib/HTTP/OAI/Set.pm lib/HTTP/OAI/UserAgent.pm +lib/HTTP/OAI/Verb.pm +LICENSE Makefile.PL MANIFEST MANIFEST.SKIP META.yml +MYMETA.json +MYMETA.yml README t/000xml_sax.t t/00static.t diff -Nru libhttp-oai-perl-3.27/META.yml libhttp-oai-perl-4.03/META.yml --- libhttp-oai-perl-3.27/META.yml 2011-08-04 14:27:03.000000000 +0000 +++ libhttp-oai-perl-4.03/META.yml 2014-04-07 12:04:30.000000000 +0000 @@ -1,6 +1,6 @@ --- #YAML:1.0 name: HTTP-OAI -version: 3.27 +version: 4.03 abstract: ~ author: [] license: unknown diff -Nru libhttp-oai-perl-3.27/README libhttp-oai-perl-4.03/README --- libhttp-oai-perl-3.27/README 2007-06-28 11:16:40.000000000 +0000 +++ libhttp-oai-perl-4.03/README 2014-04-03 12:45:44.000000000 +0000 @@ -54,9 +54,14 @@ Net::OAI::Harvester by Ed Summers. +Development +----------- + +git clone git://github.com/timbrody/perl-oai-lib.git + Author ------ -Copyright 2004 © Tim Brody +Copyright 2012 © Tim Brody This module is released under the same terms as Perl. diff -Nru libhttp-oai-perl-3.27/t/00static.t libhttp-oai-perl-4.03/t/00static.t --- libhttp-oai-perl-3.27/t/00static.t 2009-06-24 09:32:41.000000000 +0000 +++ libhttp-oai-perl-4.03/t/00static.t 2014-04-03 12:45:44.000000000 +0000 @@ -1,4 +1,4 @@ -use Test::More tests => 20; +use Test::More tests => 21; use strict; @@ -10,7 +10,7 @@ my $fn = "file:".$ENV{PWD}."/examples/repository.xml"; my $repo = HTTP::OAI::Harvester->new(baseURL=>$fn); -ok($repo); +ok($repo, "Harvester"); # Identify my $id = $repo->Identify; @@ -18,7 +18,7 @@ { BAIL_OUT( "Error parsing static repository: " . $id->message ); } -ok($id->is_success); +ok($id->is_success, "Identify is_success"); ok($id->repositoryName && $id->repositoryName eq 'Demo repository'); ok($repo->Identify->version eq '2.0s'); @@ -35,33 +35,34 @@ my $lr = $repo->ListRecords(metadataPrefix=>'oai_rfc1807'); ok($lr->is_success); my $rec = $lr->next; +is(ref($rec), 'HTTP::OAI::Record', 'ListRecords::next returns Record'); ok($rec && $rec->identifier && $rec->identifier eq 'oai:arXiv:cs/0112017'); # ListIdentifiers my $li = $repo->ListIdentifiers(metadataPrefix=>'oai_dc'); -ok($li->is_success); +ok($li->is_success, 'ListIdentifiers: '.$li->message); my @recs = $li->identifier; ok(@recs && $recs[-1]->identifier eq 'oai:perseus:Perseus:text:1999.02.0084'); # ListSets my $ls = $repo->ListSets(); -ok($ls->is_success); +ok($ls->is_success, 'ListSets'); my @errs = $ls->errors; ok(@errs && $errs[-1]->code eq 'noSetHierarchy'); # GetRecord my $gr = $repo->GetRecord(metadataPrefix=>'oai_dc',identifier=>'oai:perseus:Perseus:text:1999.02.0084'); -ok($gr->is_success); +ok($gr->is_success, 'GetRecord '.$gr->code." ".$gr->message); $rec = $gr->next; ok($rec && $rec->identifier eq 'oai:perseus:Perseus:text:1999.02.0084'); # Errors -$gr = $repo->GetRecord(metadataPrefix=>'oai_dc',identifier=>'invalid'); -ok($gr->is_error); +$gr = $repo->GetRecord(metadataPrefix=>'oai_dc',identifier=>'invalid',force=>1); +ok($gr->is_error, 'GetRecord bad id'); @errs = $gr->errors; -ok(@errs && $errs[0]->code eq 'idDoesNotExist'); +is(eval { $errs[0]->code }, 'idDoesNotExist', 'idDoesNotExist'); $lr = $repo->ListRecords(metadataPrefix=>'invalid'); -ok($lr->is_error); +ok($lr->is_error, "invalid metadataPrefix is_error"); @errs = $lr->errors; -ok(@errs && $errs[0]->code eq 'cannotDisseminateFormat'); +ok(@errs && $errs[0]->code eq 'cannotDisseminateFormat', "is_error is cannotDisseminateFormat"); diff -Nru libhttp-oai-perl-3.27/t/error.t libhttp-oai-perl-4.03/t/error.t --- libhttp-oai-perl-3.27/t/error.t 2007-06-28 11:16:39.000000000 +0000 +++ libhttp-oai-perl-4.03/t/error.t 2014-04-03 12:45:44.000000000 +0000 @@ -1,4 +1,4 @@ -use Test::More tests => 5; +use Test::More tests => 6; use strict; use warnings; @@ -18,12 +18,13 @@ is($r->toDOM->toString, $expected, 'badVerb'); -$r = HTTP::OAI::Identify->new(); +$r = HTTP::OAI::Response->new; $r->parse_string("\n"); +ok($r->is_error, 'Junk XML is_error'); is($r->code, 600, 'Chunk xml'); -$r = HTTP::OAI::Identify->new(); +$r = HTTP::OAI::Response->new; $r->parse_string($expected); ok($r->is_error, 'Parse_string'); @@ -32,6 +33,6 @@ 0000-00-00T00:00:00Zhttp://localhost/path/script?Requested identifier does not exist EOF -$r = HTTP::OAI::GetRecord->new(); +$r = HTTP::OAI::Response->new; $r->parse_string($err_noid); ok($r->is_error); diff -Nru libhttp-oai-perl-3.27/t/getrecord.t libhttp-oai-perl-4.03/t/getrecord.t --- libhttp-oai-perl-3.27/t/getrecord.t 2007-06-28 11:16:39.000000000 +0000 +++ libhttp-oai-perl-4.03/t/getrecord.t 2014-04-03 12:45:44.000000000 +0000 @@ -42,6 +42,7 @@ ok($sets[0] eq 'a:a', 'header/setSpec'); my $str = < Symplectic Computation of Lyapunov Exponents Habib, Salman @@ -53,14 +54,13 @@ text http://arXiv.org/abs/acc-phys/9411001 + EOF $rec->metadata(new HTTP::OAI::Metadata()); -my $parser = XML::LibXML::SAX::Parser->new(Handler=>$rec->metadata); -$parser->parse_string($str); +$rec->metadata->parse_string($str); $r->record($rec); -#warn $r->toDOM->toString; { # hopefully if we can re-parse our own output we're ok, because we can't # compare against the ever changing XML output