######################################################################
#
# EPrints::Apache::AnApache
#
######################################################################
#
#  This file is part of GNU EPrints 2.
#  
#  Copyright (c) 2000-2004 University of Southampton, UK. SO17 1BJ.
#  
#  EPrints 2 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 2 of the License, or
#  (at your option) any later version.
#  
#  EPrints 2 is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#  
#  You should have received a copy of the GNU General Public License
#  along with EPrints 2; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
######################################################################


=pod

=head1 NAME

B<EPrints::Apache::AnApache> - Load appropriate Apache Module

=head1 DESCRIPTION

Handy way of loading Apache or Apache2 depending on value in SystemSettings.

Plus functions to paper over the cracks between the two interfaces.

=over 4

=cut

package EPrints::Apache::AnApache;

BEGIN
{
	use Exporter;
	our (@ISA, @EXPORT );
	@ISA	 = qw(Exporter);
	@EXPORT  = qw(OK AUTH_REQUIRED FORBIDDEN DECLINED SERVER_ERROR NOT_FOUND DONE);
}

use strict;

######################################################################
=pod

=item EPrints::Apache::AnApache::upload_doc_file( $session, $document, $paramid );

Collect a file named $paramid uploaded via HTTP and add it to the 
specified $document.

=item EPrints::Apache::AnApache::upload_doc_archive( $session, $document, $paramid, $archive_format );

Collect an archive file (.ZIP, .tar.gz, etc.) uploaded via HTTP and 
unpack it then add it to the specified document.

=item EPrints::Apache::AnApache::send_http_header( $request )

Send the HTTP header, if needed.

$request is the current Apache request. 

=item EPrints::Apache::AnApache::header_out( $request, $header, $value )

Set a value in the HTTP headers of the response. $request is the
apache request object, $header is the name of the header and 
$value is the value to give that header.

=item $value = EPrints::Apache::AnApache::header_in( $request, $header )

Return the specified HTTP header from the current request.

=item $request = EPrints::Apache::AnApache::get_request

Return the current Apache request object.

=cut
######################################################################

my $av =  $EPrints::SystemSettings::conf->{apache};
if( defined $av && $av eq "2" )
{
	# Apache 2

	# Detect API version, either 1 or 2 
	$EPrints::Apache::AnApache::ModPerlAPI = 0;

	eval "require Apache2::Util"; 
	unless( $@ ) { $EPrints::Apache::AnApache::ModPerlAPI = 2; }

	if( !$EPrints::Apache::AnApache::ModPerlAPI ) 
	{ 
		eval "require Apache2"; 
		unless( $@ ) { $EPrints::Apache::AnApache::ModPerlAPI = 1; } 
	}

	# no API version, is mod_perl 2 even installed?
	if( !$EPrints::Apache::AnApache::ModPerlAPI )
	{
		# can't find either old OR new mod_perl API

		# not logging functions available to eprints runtime yet
		print STDERR "\n------------------------------------------------------------\n";
		print STDERR "Failed to load mod_perl for Apache 2\n";
		eval "require Apache"; if( !$@ ) {
			print STDERR "However mod_perl for Apache 1.3 is available. Is the 'apache'\nparameter in perl_lib/EPrints/SystemSettings.pm correct?\n";
		}
		print STDERR "------------------------------------------------------------\n";

		die;
	};

	my @modules = ( 
		'ModPerl::Registry' 
	);
	if( $EPrints::Apache::AnApache::ModPerlAPI == 1 )
	{
		push @modules,
			'Apache::SubProcess',
			'Apache::Const',
			'Apache::Connection',
			'Apache::RequestRec';
	}
	if( $EPrints::Apache::AnApache::ModPerlAPI == 2 )
	{
		push @modules,
			'Apache2::SubProcess',
			'Apache2::Const',
			'Apache2::Connection';
	}
	foreach my $module ( @modules )
	{
		eval "use $module"; 
		next unless( $@ );
		die "Error loading module $module:\n$@";
	}

	eval '

		sub send_http_header
		{
			my( $request ) = @_;
	
			# do nothing!
		}

		sub header_out
		{
			my( $request, $header, $value ) = @_;
			
			$request->headers_out->{$header} = $value;
		}

		sub header_in
		{
			my( $request, $header ) = @_;	
	
			return $request->headers_in->{$header};
		}

		sub get_request
		{
			if( $EPrints::Apache::AnApache::ModPerlAPI == 1 )
			{
				return Apache->request;
			}
			if( $EPrints::Apache::AnApache::ModPerlAPI == 2 )
			{
				return Apache2::RequestUtil->request();
			}
			die "Unknown ModPerlAPI version: $EPrints::Apache::AnApache::ModPerlAPI";
		}
	';
	if( $@ ) { die $@; }
}
else
{
	# Apache 1.3
	eval "require Apache"; if( $@ ) {
		# not logging functions available yet
		print STDERR "\n------------------------------------------------------------\n";
		print STDERR "Failed to load mod_perl for Apache 1.3\n";
		my $modperl2 = 0;
		eval "require Apache2"; unless( $@ ) { $modperl2 = 1; }
		eval "require Apache2::Utils"; unless( $@ ) { $modperl2 = 1; }
 		if( $modperl2 )
		{
			print STDERR "However mod_perl for Apache 2 is available. Is the 'apache'\nparameter in perl_lib/EPrints/SystemSettings.pm correct?\n";
		}
		print STDERR "------------------------------------------------------------\n";

		die;
	};
	eval "require Apache::Registry"; if( $@ ) { die $@; }
	eval "require Apache::Constants; "; if( $@ ) { die $@; }
	eval '

		sub OK { &Apache::Constants::OK; }
		sub AUTH_REQUIRED { &Apache::Constants::AUTH_REQUIRED; }
		sub FORBIDDEN { &Apache::Constants::FORBIDDEN; }
		sub DECLINED { &Apache::Constants::DECLINED; }
		sub SERVER_ERROR { &Apache::Constants::SERVER_ERROR; }
		sub NOT_FOUND { &Apache::Constants::NOT_FOUND; }
		sub DONE { &Apache::Constants::DONE; }

		sub send_http_header
		{
			my( $request ) = @_;
	
			$request->send_http_header;
		}


		sub header_out
		{
			my( $request, $header, $value ) = @_;

			$request->header_out( $header => $value );
		}

		sub header_in
		{
			my( $request, $header ) = @_;	
	
			return $request->header_in( $header );
		}
		
		sub get_request
		{
			return Apache->request;
		}
	';
	if( $@ ) { die $@; }
}

######################################################################
=pod

=item $value = EPrints::Apache::AnApache::cookie( $request, $cookieid )

Return the value of the named cookie, or undef if it is not set.

This avoids using CGI.pm, so does not consume the POST data.

=cut
######################################################################

sub cookie
{
	my( $request, $cookieid ) = @_;

	my $cookies = EPrints::Apache::AnApache::header_in( $request, 'Cookie' );

	return unless defined $cookies;

	foreach my $cookie ( split( /;\s*/, $cookies ) )
	{
		my( $k, $v ) = split( '=', $cookie );
		if( $k eq $cookieid )
		{
			return $v;
		}
	}

	return undef;
}


sub upload_doc_file
{
	my( $session, $document, $paramid ) = @_;

	my $cgi = $session->get_query;

	return $document->upload( 
		$cgi->upload( $paramid ), 
		$cgi->param( $paramid ) );	
}

sub upload_doc_archive
{
	my( $session, $document, $paramid, $archive_format ) = @_;

	my $cgi = $session->get_query;

	return $document->upload_archive( 
		$cgi->upload( $paramid ), 
		$cgi->param( $paramid ), 
		$archive_format );	
}

sub send_status_line
{	
	my( $request, $code, $message ) = @_;
	
	if( defined $message )
	{
		$request->status_line( "$code $message" );
	}
	$request->status( $code );
}

1;