view release on metacpan or  search on metacpan

PAR/PerlRun.pm  view on Meta::CPAN

package Apache::PAR::PerlRun;

use strict;

# for version detection
require mod_perl;

# Exporter
require Exporter;
use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION);
%EXPORT_TAGS = ( 'all' => [ qw( ) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw( );
@ISA = qw(Exporter);

$VERSION = '0.30';

unless ($mod_perl::VERSION < 1.99) {
	@ISA = qw(Exporter Apache::PAR::RegistryCooker);
	require Apache::PAR::RegistryCooker;
	require Apache::Const;
	import Apache::Const qw(OK);
}
else {
	@ISA = qw(Exporter Apache::PAR::ScriptBase Apache::PerlRun);
	require Apache::PerlRun;
	require Apache::PAR::ScriptBase;
	require Apache::Constants;
	import Apache::Constants qw(OK);
}

my $parent = 'Apache::PAR::RegistryCooker';

my %aliases = (
	new             => 'new',
	init            => 'init',
	default_handler => 'default_handler',
	run             => 'run',
	make_namespace  => 'make_namespace',
	namespace_root  => 'namespace_root',
	is_cached       => 'FALSE',
	should_compile  => 'TRUE',
	flush_namespace => 'flush_namespace_normal',
	cache_it        => 'NOP',
	rewrite_shebang => 'rewrite_shebang',
	chdir_file      => 'chdir_file_normal',
	get_mark_line   => 'get_mark_line',
	compile         => 'compile',
	error_check     => 'error_check',
	strip_end_data_segment             => 'strip_end_data_segment',
	convert_script_to_compiled_handler => 'convert_script_to_compiled_handler',
	can_compile     => $parent . '::can_PAR_compile',
	read_script     => $parent . '::read_PAR_script',
	set_script_name => $parent . '::set_PAR_script_name',
	namespace_from  => $parent . '::namespace_from_PAR',
);

unless ($mod_perl::VERSION < 1.99) {
	__PACKAGE__->install_aliases(\%aliases);
}

sub can_compile {
	my $pr = shift;

	my $status = $pr->SUPER::can_compile();
	return $status unless $status eq OK();
	return $pr->_can_compile();
}

sub namespace_from {
	my $pr = shift;
	my $r  = $pr->{r};

	my $uri = $r->uri;

	my $path_info = $pr->{_extra_path_info};
	my $script_name = $path_info && $uri =~ /$path_info$/ ?
		substr($uri, 0, length($uri)-length($path_info)) :
		$uri;

	if($Apache::Registry::NameWithVirtualHost && $r->server->is_virtual) {
		my $name = $r->get_server_name;
		$script_name = join "", $name, $script_name if $name;
	}
	$script_name =~ s:/+$:/__INDEX__:;

	return $script_name;
}

sub compile {
	my ($pr, $eval) = @_;
	$pr->_set_path_info();