view release on metacpan or  search on metacpan

lib/CGI/Info.pm  view on Meta::CPAN

		Carp::croak('Illegal Operation: This method can only be called by a subclass or ourself');
	}

	$self->_trace(__PACKAGE__ . ': entering _find_paths');

	require File::Basename && File::Basename->import() unless File::Basename->can('basename');

	# Determine script name
	my $script_name = $self->_get_env('SCRIPT_NAME') // $0;
	$self->{script_name} = $self->_untaint_filename({
		filename => File::Basename::basename($script_name)
	});

	# Determine script path
	if(my $script_path = $self->_get_env('SCRIPT_FILENAME')) {
		$self->{script_path} = $script_path;
	} elsif($script_name = $self->_get_env('SCRIPT_NAME')) {
		if(my $document_root = $self->_get_env('DOCUMENT_ROOT')) {
			$script_name = $self->_get_env('SCRIPT_NAME');

			# It's usually the case, e.g. /cgi-bin/foo.pl
			$script_name =~ s{^/}{};

			$self->{script_path} = File::Spec->catfile($document_root, $script_name);
		} else {
			if(File::Spec->file_name_is_absolute($script_name) && (-r $script_name)) {
				# Called from a command line with a full path
				$self->{script_path} = $script_name;
			} else {
				require Cwd unless Cwd->can('abs_path');

				if($script_name =~ /^\/(.+)/) {
					# It's usually the case, e.g. /cgi-bin/foo.pl
					$script_name = $1;
				}

				$self->{script_path} = File::Spec->catfile(Cwd::abs_path(), $script_name);
			}
		}
	} elsif(File::Spec->file_name_is_absolute($0)) {
		# Called from a command line with a full path
		$self->{script_path} = $0;
	} else {
		$self->{script_path} = File::Spec->rel2abs($0);
	}

	# Untaint and finalize script path
	$self->{script_path} = $self->_untaint_filename({
		filename => $self->{script_path}
	});
}

=head2 script_path

Finds the full path name of the script.

	use CGI::Info;

	my $info = CGI::Info->new();
	my $fullname = $info->script_path();
	my @statb = stat($fullname);

	if(@statb) {
		my $mtime = localtime $statb[9];
		print "Last-Modified: $mtime\n";
		# TODO: only for HTTP/1.1 connections
		# $etag = Digest::MD5::md5_hex($html);
		printf "ETag: \"%x\"\n", $statb[9];
	}
=cut

sub script_path {
	my $self = shift;

	unless($self->{script_path}) {
		$self->_find_paths();
	}
	return $self->{script_path};
}

=head2 script_dir

Returns the file system directory containing the script.

	use CGI::Info;
	use File::Spec;

	my $info = CGI::Info->new();

	print 'HTML files are normally stored in ', $info->script_dir(), '/', File::Spec->updir(), "\n";

	# or
	use lib CGI::Info::script_dir() . '../lib';

=cut

sub script_dir
{
	my $self = shift;

	# Ensure $self is an object
	$self = __PACKAGE__->new() unless ref $self;

	# Set script path if it is not already defined
	$self->_find_paths() unless $self->{script_path};

	# Extract directory from script path based on OS
	# Don't use File::Spec->splitpath() since that can leave the trailing slash
	my $dir_regex = $^O eq 'MSWin32' ? qr{(.+)\\.+?$} : qr{(.+)/.+?$};

	return $self->{script_path} =~ $dir_regex ? $1 : $self->{script_path};
}

=head2 host_name

Return the host-name of the current web server, according to CGI.
If the name can't be determined from the web server, the system's host-name
is used as a fall back.
This may not be the same as the machine that the CGI script is running on,
some ISPs and other sites run scripts on different machines from those
delivering static content.