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