APR-Emulate-PSGI

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

sub _version ($) {
	my $s = shift || 0;
	my $d =()= $s =~ /(\.)/g;
	if ( $d >= 2 ) {
		# Normalise multipart versions
		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

sub _cmp ($$) {
	_version($_[1]) <=> _version($_[2]);
}

# Cloned from Params::Util::_CLASS

inc/Module/Install/Makefile.pm  view on Meta::CPAN

	for my $subdir (@_) {
		push @$subdirs, $subdir;
	}
}

sub clean_files {
	my $self  = shift;
	my $clean = $self->makemaker_args->{clean} ||= {};
	  %$clean = (
		%$clean,
		FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
	);
}

sub realclean_files {
	my $self      = shift;
	my $realclean = $self->makemaker_args->{realclean} ||= {};
	  %$realclean = (
		%$realclean,
		FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
	);
}

sub libs {
	my $self = shift;
	my $libs = ref $_[0] ? shift : [ shift ];
	$self->makemaker_args( LIBS => $libs );
}

sub inc {

lib/APR/Emulate/PSGI.pm  view on Meta::CPAN

    return $self->{'psgi_env'}{'QUERY_STRING'};
}

=item read

Emulates L<Apache2::RequestIO/read>.

=cut

sub read {
    my ($self, $buffer, $length, $offset) = @_;
    $offset ||= 0;
    # We use $_[1] instead of $buffer, because we need to modify the original instead of a copy.
    if ($self->{'cgi_mode'}) {
        return CORE::read(\*STDIN, $_[1], $length, $offset);
    }
    return $self->{'psgi_env'}{'psgi.input'}->read($_[1], $length, $offset);
}

=item pool

Emulates L<Apache2::RequestRec/pool>.

=cut

sub pool {
    my ($self) = @_;

lib/APR/Emulate/PSGI.pm  view on Meta::CPAN

=item print

Emulates L<Apache2::RequestIO/print>.

=cut

sub print {
    my ($self, @content) = @_;
    my $success = CORE::print @content;
    return $success
        ? length(join('', @content))
        : 0;
}

=item rflush

Emulates L<Apache2::RequestIO/rflush>.

=cut

sub rflush {}

t/10_psgi.t  view on Meta::CPAN

my $request_body = 'hello=world';
my $response_body = 'howdy';
open my $fh_in, '<', \do { $request_body };
open my $fh_errors, '>', \$error_string;

# Set up PSGI environment.
my $psgi_env = {
    'REMOTE_ADDR'    => '192.168.1.1',
    'REQUEST_METHOD' => 'POST',
    'CONTENT_TYPE'   => 'application/x-www-form-urlencoded',
    'CONTENT_LENGTH' => length($request_body),
    'HTTP_HOK'       => 'gahaha',
    'psgi.errors'    => $fh_errors,
    'psgi.input'     => $fh_in,
};

# Create instance.
my $r = APR::Emulate::PSGI->new($psgi_env);

isa_ok(
    $r,

t/10_psgi.t  view on Meta::CPAN

);

is(
    $r->headers_in()->header('CONTENT_TYPE'),
    'application/x-www-form-urlencoded',
    'Content-type is available.',
);

is(
    $r->headers_in()->header('CONTENT_LENGTH'),
    length($request_body),
    'Content length is available.',
);

is(
    $r->headers_in()->header('HTTP_HOK'),
    'gahaha',
    'Custom header is available.',
);

my $actual;
is(
    $r->read($actual, length($request_body)),
    length($request_body),
    'POST content is read.',
);

is(
    $actual,
    $request_body,
    'POST content is correct.',
);

# Set headers for the response.

t/10_psgi.t  view on Meta::CPAN

is(
	exists($headers->{'Cache-control'}),
	'',
	'Received no Cache-control header.',
);

my $body_fh = IO::File->new_tmpfile();
{
    local *STDOUT = $body_fh;
    #my $length = $r->print($response_body);
    is(
        #$length,
        $r->print($response_body),
        length($response_body),
        'Content is printed.',
    );

}

$body_fh->seek(0, 0);  # Reset filehandle back to the beginning.
is(
    $body_fh->getline(),
    $response_body,
    'Received expected content.',

t/20_cgi_mode.t  view on Meta::CPAN

my $error_string;
my $request_body = 'hello=world';
my $response_body = 'howdy';
open my $fh_in, '<', \do { $request_body };
open my $fh_errors, '>', \$error_string;

# Set up CGI environment.
$ENV{'REMOTE_ADDR'}    = '192.168.1.1';
$ENV{'REQUEST_METHOD'} = 'POST';
$ENV{'CONTENT_TYPE'}   = 'application/x-www-form-urlencoded';
$ENV{'CONTENT_LENGTH'} = length($request_body);
$ENV{'HTTP_HOK'}       = 'gahaha';

# Create instance.
my $r = APR::Emulate::PSGI->new();  # In CGI mode, no environment is passed in.

isa_ok(
    $r,
    'APR::Emulate::PSGI',
    'Object is instantiated.',
);

t/20_cgi_mode.t  view on Meta::CPAN

);

is(
    $r->headers_in()->header('CONTENT_TYPE'),
    'application/x-www-form-urlencoded',
    'Content-type is available.',
);

is(
    $r->headers_in()->header('CONTENT_LENGTH'),
    length($request_body),
    'Content length is available.',
);

is(
    $r->headers_in()->header('HTTP_HOK'),
    'gahaha',
    'Custom header is available.',
);

{
    local *STDIN = $fh_in;
    my $actual;
    is(
        $r->read($actual, length($request_body)),
        length($request_body),
        'POST content is read.',
    );

    is(
        $actual,
        $request_body,
        'POST content is correct.',
    );
}

t/20_cgi_mode.t  view on Meta::CPAN

is(
    $headers_fh->getline(),
    "\n",
    'Received end-of-headers indicator.',
);

my $body_fh = IO::File->new_tmpfile();
{
    local *STDOUT = $body_fh;
    #my $length = $r->print($response_body);
    is(
        #$length,
        $r->print($response_body),
        length($response_body),
        'Content is printed.',
    );

}

$body_fh->seek(0, 0);  # Reset filehandle back to the beginning.
is(
    $body_fh->getline(),
    $response_body,
    'Received expected content.',