view release on metacpan or  search on metacpan

lib/HTTP/OAI/Repository.pm  view on Meta::CPAN

package HTTP::OAI::Repository;

use strict;
use warnings;

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
require Exporter;

our $VERSION = '4.13';

@ISA = qw(Exporter);

@EXPORT = qw();
@EXPORT_OK = qw( &validate_request &validate_request_1_1 &validate_date &validate_metadataPrefix &validate_responseDate &validate_setSpec );
%EXPORT_TAGS = (validate=>[qw(&validate_request &validate_date &validate_metadataPrefix &validate_responseDate &validate_setSpec)]);

use HTTP::OAI::Error qw(%OAI_ERRORS);

# Copied from Simeon Warner's tutorial at
# http://library.cern.ch/HEPLW/4/papers/3/OAIServer.pm
# (note: corrected grammer for ListSets)
# 0 = optional, 1 = required, 2 = exclusive
my %grammer = (
	'GetRecord' =>
	{
		'identifier' => [1, \&validate_identifier],
		'metadataPrefix' => [1, \&validate_metadataPrefix]
	},
	'Identify' => {},
	'ListIdentifiers' =>
	{
		'from' => [0, \&validate_date],
		'until' => [0, \&validate_date],
		'set' => [0, \&validate_setSpec_2_0],
		'metadataPrefix' => [1, \&validate_metadataPrefix],
		'resumptionToken' => [2, sub { 0 }]
	},
	'ListMetadataFormats' =>
	{
		'identifier' => [0, \&validate_identifier]
	},
	'ListRecords' =>
	{
		'from' => [0, \&validate_date],
		'until' => [0, \&validate_date],
		'set' => [0, \&validate_setSpec_2_0],
		'metadataPrefix' => [1, \&validate_metadataPrefix],
		'resumptionToken' => [2, sub { 0 }]
	},
	'ListSets' =>
	{
		'resumptionToken' => [2, sub { 0 }]
	}
);

sub new {
	my ($class,%args) = @_;
	my $self = bless {}, $class;
	$self;
}

sub validate_request { validate_request_2_0(@_); }

sub validate_request_2_0 {
	my %params = @_;
	my $verb = $params{'verb'};
	delete $params{'verb'};

	my @errors;

	return (new HTTP::OAI::Error(code=>'badVerb',message=>'No verb supplied')) unless defined $verb;

	my $grm = $grammer{$verb} or return (new HTTP::OAI::Error(code=>'badVerb',message=>"Unknown verb '$verb'"));

	if( defined $params{'from'} && defined $params{'until'} ) {
		if( granularity($params{'from'}) ne granularity($params{'until'}) ) {
			return (new HTTP::OAI::Error(
				code=>'badArgument',
				message=>'Granularity used in from and until must be the same'
			));
		}
	}