<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package CGI::PathInfo;

use strict;

BEGIN {
	$CGI::PathInfo::VERSION = '1.02';
}

# check for mod_perl and include the 'Apache' module if needed
if (exists $ENV{'MOD_PERL'}) {
	$| = 1;
	require Apache;
}

sub new {
	my $proto   = shift;
	my $package = __PACKAGE__;
	my $class;
	if (ref($proto)) {
		$class = ref ($proto);
	} elsif ($proto) {
		$class = $proto;
	} else {
		$class = $package;
	}
	my $self    = bless {},$class;

	$self-&gt;{$package}-&gt;{'field_names'} = [];
	$self-&gt;{$package}-&gt;{'field'}       = {};
	$self-&gt;{$package}-&gt;{'settings'} = {
								       'eq' =&gt; '-',
								  'spliton' =&gt; '/',
						'stripleadingslash' =&gt; 1,
					   'striptrailingslash' =&gt; 1,
							};

	my $parms;
	if ($#_ == 0) {
		$parms = shift;
	} elsif ($#_ &gt; 0) {
		if (0 == $#_ % 2) {
			require Carp;
			Carp::croak('[' . localtime(time) . "] [error] $package" . '::new() - odd number of passed parameters');
		}
		%$parms = @_;
	} else {
		$parms = {};
	}
	if (ref($parms) ne 'HASH') {
		require Carp;
		Carp::croak('[' . localtime(time) . "] [error] $package" . '::new() - Passed parameters do not appear to be valid');
	}
	my @parm_keys = keys %$parms;
	foreach my $parm_name (@parm_keys) {
		my $lc_parm_name = lc ($parm_name);
		if (not exists $self-&gt;{$package}-&gt;{'settings'}-&gt;{$lc_parm_name}) {
			require Carp;
			Carp::croak('[' . localtime(time) . "] [error] $package" . "::new() - Passed parameter name '$parm_name' is not valid here");
		}
		$self-&gt;{$package}-&gt;{'settings'}-&gt;{$lc_parm_name} = $parms-&gt;{$parm_name};
	}
	$self-&gt;_decode_path_info;

	return $self;
}

#######################################################################

sub param {
	my $self = shift;
	my $package = __PACKAGE__;

	if (1 &lt; @_) {
		my $n_parms = @_;
		if (($n_parms % 2) == 1) {
			require Carp;
			Carp::croak('[' . localtime(time) . "] [error] $package" . "::param() - Odd number of parameters  passed");
		}
		my $parms = { @_ };
		$self-&gt;_set($parms);
		return;
	}
	if ((@_ == 1) and (ref ($_[0]) eq 'HASH')) {
		my $parms = shift;
		$self-&gt;_set($parms);
		return;
	}

	my @result = ();
	if ($#_ == -1) {
		@result = @{$self-&gt;{$package}-&gt;{'field_names'}};
	} else {
		my ($fieldname)=@_;
		if (defined($self-&gt;{$package}-&gt;{'field'}-&gt;{$fieldname})) {
			@result = @{$self-&gt;{$package}-&gt;{'field'}-&gt;{$fieldname}-&gt;{'value'}};
		}
	}


	if (wantarray) {
		return @result;
	} else {
		return $result[0];
	}
}

#######################################################################

sub calling_parms_table {
	my $self = shift;
	my $package = __PACKAGE__;

	require HTML::Entities;

	my $outputstring = "&lt;table border=\"1\" cellspacing=\"0\"&gt;&lt;tr&gt;&lt;th colspan=\"2\"&gt;PATH_INFO Fields&lt;/th&gt;&lt;/tr&gt;&lt;tr&gt;&lt;th&gt;Field&lt;/th&gt;&lt;th&gt;Value&lt;/th&gt;&lt;/tr&gt;\n";
	my @field_list = $self-&gt;param;
	foreach my $fieldname (sort @field_list) {
		my @values = $self-&gt;param($fieldname);
		my $sub_field_counter= $#values;
		for (my $fieldn=0; $fieldn &lt;= $sub_field_counter; $fieldn++) {
			my $e_fieldname = HTML::Entities::encode_entities($fieldname);
			my $fieldvalue  = HTML::Entities::encode_entities($values[$fieldn]);
			$outputstring .= "&lt;tr&gt;&lt;td&gt;$e_fieldname (#$fieldn)&lt;/td&gt;&lt;td&gt; $fieldvalue&lt;/td&gt;&lt;/tr&gt;\n";
		}
	}

	$outputstring .= "&lt;/table&gt;\n";

	return $outputstring;
}

#######################################################################

sub url_encode {
	my $self   = shift;
	my ($line) = @_;

	return '' if (! defined ($line));
	$line =~ s/([^a-zA-Z0-9])/"\%".unpack("H",$1).unpack("h",$1)/egs;
	return $line;
}

#######################################################################

sub url_decode {
	my $self   = shift;
	my ($line) = @_;

	return '' if (! defined ($line));
	$line =~ s/\+/ /gos;
	$line =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/egs;
	return $line;
}


########################################################################
# Performs PATH_INFO decoding

sub _decode_path_info {
	my $self = shift;
	my $package = __PACKAGE__;

	my $buffer = '';
	if (exists $ENV{'MOD_PERL'}) {
			  $buffer = Apache-&gt;request-&gt;path_info;
	} else {
			  $buffer = $ENV{'PATH_INFO'} if (defined $ENV{'PATH_INFO'});
	}
	$self-&gt;_burst_URL_encoded_buffer($buffer);

	return;
}

##########################################################################
# Bursts normal URL encoded buffers
# Takes: $buffer   - the actual data to be burst
#
# parameters are presumed to be seperated by ';' characters
#

sub _burst_URL_encoded_buffer {
	my $self = shift;
	my $package = __PACKAGE__;

	my ($buffer) = @_;
	my $settings = $self-&gt;{$package}-&gt;{'settings'};
	if ($settings-&gt;{'stripleadingslash'})  { $buffer =~ s#^/+##s; }
	if ($settings-&gt;{'striptrailingslash'}) { $buffer =~ s#/+$##s; }

	my $spliton  = $settings-&gt;{'spliton'};
	my $eq_mark  = $settings-&gt;{'eq'};

	# Split the name-value pairs on the selected split char
	my @pairs = ();
	if ($buffer) {
		@pairs = split(/$spliton/, $buffer);
	}

	# Initialize the field hash and the field_names array
	$self-&gt;{$package}-&gt;{'field'}       = {};
	$self-&gt;{$package}-&gt;{'field_names'} = [];

	foreach my $pair (@pairs) {
		my ($name, $data) = split(/$eq_mark/,$pair,2);

		# Anything that didn't split is omitted from the output
		next if (not defined $data);

		# De-URL encode %-encoding
		$name = $self-&gt;url_decode($name);
		$data = $self-&gt;url_decode($data);

		if (! defined ($self-&gt;{$package}-&gt;{'field'}-&gt;{$name}-&gt;{'count'})) {
			push (@{$self-&gt;{$package}-&gt;{'field_names'}},$name);
			$self-&gt;{$package}-&gt;{'field'}-&gt;{$name}-&gt;{'count'} = 0;
		}
		my $record      = $self-&gt;{$package}-&gt;{'field'}-&gt;{$name};
		my $field_count = $record-&gt;{'count'};
		$record-&gt;{'count'}++;
		$record-&gt;{'value'}-&gt;[$field_count]     = $data;
	}
	return;
}

##################################################################
#
# Sets values into the object directly
# Pass an anon hash for name/value pairs. Values may be
# anon lists or simple strings
#
##################################################################

sub _set {
	my $self = shift;
	my $package = __PACKAGE__;

	my ($parms) = @_;
	foreach my $name (keys %$parms) {
		my $value = $parms-&gt;{$name};
		my $data  = [];
		my $data_type = ref $value;
		if (not $data_type) {
			$data = [ $value ];
		} elsif ($data_type eq 'ARRAY') {
			# Shallow copy the anon array to prevent action at a distance
			@$data = map {$_} @$value;
		} else {
			require Carp;
			Carp::croak ('[' . localtime(time) . "] [error] $package"  . "::_set() - Parameter '$name' has illegal data type of '$data_type'");
		}

		if (! defined ($self-&gt;{$package}-&gt;{'field'}-&gt;{$name}-&gt;{'count'})) {
			push (@{$self-&gt;{$package}-&gt;{'field_names'}},$name);
		}
		my $record = {};
		$self-&gt;{$package}-&gt;{'field'}-&gt;{$name} = $record;
		$record-&gt;{'count'} = @$data;
		$record-&gt;{'value'} = $data;
	}
	return;
}

##########################################################################

1;
</pre></body></html>