The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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