view release on metacpan or  search on metacpan

CIPP.pm  view on Meta::CPAN

package Apache::CIPP;

$VERSION = "0.13";
$REVISION = q$Revision: 1.4 $;

use strict;

use FileHandle;
use Apache::Constants ':common';
use CIPP;
use Config;
use File::Path;

# this global hash holds the timestamps of the compiled perl
# subroutines for this instance

%Apache::CIPP::compiled = ();

sub handler {
	my $r = shift;
	
	# should we mangle remote_ip with proxy X-Forwarded-For?
	# (thanks to Ask Bjoern Hansen for his mod_proxy_add_forward.c.
	#  this code snippet is stolen from his documentation ;)

	if ( $r->dir_config ("mangle_proxy_remote_ip") ) {
		if ( $r->connection->remote_ip eq '127.0.0.1' ) {
			if ( my ($ip) = $r->header_in('X-Forwarded-For') =~
				/([^,\s]+)$/ ) {
				$r->connection->remote_ip($ip);
			}
		}
	}

	# print listing if a directory is requested

	my $filename = $r->filename;
	if ( -d $filename ) {
		if ( not -f "$filename/index.cipp" ) {
			print_directory_listing ($r, $filename);
			return;
		} else {
			$filename = "$filename/index.cipp";
		}
	}

	# check if file exists and is readable for us
	# if not: Server Error
	
	return NOT_FOUND if not -f $filename;
	return FORBIDDEN if not -r $filename;
	
	# handle the request
	
	if ( not $r->header_only ) {
	
		my $request = new Apache::CIPP ($r);
		if ( not $request->process ) {
			$request->error;
		}
		$request->debug if $r->dir_config ("debug");
	} else {
	
		$r->send_http_header;
	}
	
	return OK;
}

sub print_directory_listing {
	my $r = shift;
	my ($dir) = @_;
	
	$r->content_type ("text/html");
	$r->send_http_header;
	
	$r->print (qq{<A HREF="../">../</A><BR>\n});
	while (<$dir/*>) {
		$_ .= "/" if -d $_;
		s!$dir/!!;
		$r->print (qq{<A HREF="$_">$_</A><BR>\n});
	}
}

sub new {
	my $type = shift;
	my ($r) = @_;