APR-Emulate-PSGI
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
# Define metadata
name 'APR-Emulate-PSGI';
all_from 'lib/APR/Emulate/PSGI.pm';
readme_pod_from 'lib/APR/Emulate/PSGI.pm';
# Specific dependencies
requires 'URI' => '0';
requires 'HTTP::Headers' => '0';
test_requires 'Test::More' => '0.88';
test_requires 'IO::File' => '0';
auto_set_repository;
WriteAll;
=cut
=item psgi_status
Returns the numeric HTTP response that should be used when building
a PSGI response.
my $status = $r->psgi_status();
The value is determined by looking at the current value of L</status_line>,
or if that is not set, the current value of L</status>, or if that is not
set, defaults to 200.
=cut
=item psgi_headers
Returns an arrayref of headers which can be used when building a PSGI
response.
A Content-Length header is not included, and must be added in accordance
inc/Module/Install.pm view on Meta::CPAN
#line 1
package Module::Install;
# For any maintainers:
# The load order for Module::Install is a bit magic.
# It goes something like this...
#
# IF ( host has Module::Install installed, creating author mode ) {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
# 3. The installed version of inc::Module::Install loads
# 4. inc::Module::Install calls "require Module::Install"
# 5. The ./inc/ version of Module::Install loads
# } ELSE {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
# 3. The ./inc/ version of Module::Install loads
# }
use 5.005;
use strict 'vars';
use Cwd ();
use File::Find ();
use File::Path ();
use vars qw{$VERSION $MAIN};
inc/Module/Install.pm view on Meta::CPAN
my $self = $class->new(@_);
my $who = $self->_caller;
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
not:
inc/Module/Install/Makefile.pm view on Meta::CPAN
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
$args->{NAME} =~ s/-/::/g;
$args->{VERSION} = $self->version or die <<'EOT';
ERROR: Can't determine distribution version. Please specify it
explicitly via 'version' in Makefile.PL, or set a valid $VERSION
in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
$args->{test} = {
TESTS => (join ' ', grep {!$seen{$_}++} @tests),
};
} elsif ( $Module::Install::ExtraTests::use_extratests ) {
# Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
# So, just ignore our xt tests here.
} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
$args->{test} = {
TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
};
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = join ', ', @{$self->author || []};
}
inc/Module/Install/Makefile.pm view on Meta::CPAN
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
if ( $self->makemaker(6.48) ) {
$args->{MIN_PERL_VERSION} = $perl_version;
}
}
if ($self->installdirs) {
warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
$args->{INSTALLDIRS} = $self->installdirs;
}
my %args = map {
( $_ => $args->{$_} ) } grep {defined($args->{$_} )
} keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
inc/Module/Install/Metadata.pm view on Meta::CPAN
}
$self->{values}->{perl_version} = $version;
}
sub all_from {
my ( $self, $file ) = @_;
unless ( defined($file) ) {
my $name = $self->name or die(
"all_from called with no args without setting name() first"
);
$file = join('/', 'lib', split(/-/, $name)) . '.pm';
$file =~ s{.*/}{} unless -e $file;
unless ( -e $file ) {
die("all_from cannot find $file from $name");
}
}
unless ( -f $file ) {
die("The path '$file' does not exist, or is not a file");
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
return $self->{values}->{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
} else {
$self->can($key)->($self, $value);
}
}
inc/Module/Install/Repository.pm view on Meta::CPAN
use vars qw($VERSION);
$VERSION = '0.06';
use base qw(Module::Install::Base);
sub _execute {
my ($command) = @_;
`$command`;
}
sub auto_set_repository {
my $self = shift;
return unless $Module::Install::AUTHOR;
my $repo = _find_repo(\&_execute);
if ($repo) {
$self->repository($repo);
} else {
warn "Cannot determine repository URL\n";
}
lib/APR/Emulate/PSGI.pm view on Meta::CPAN
}
=item psgi_status
Returns the numeric HTTP response that should be used when building
a PSGI response.
my $status = $r->psgi_status();
The value is determined by looking at the current value of L</status_line>,
or if that is not set, the current value of L</status>, or if that is not
set, defaults to 200.
=cut
sub psgi_status {
my ($self) = @_;
my $status = $self->status_line() || $self->status() || '200';
$status =~ s/\D//g;
return $status;
}
lib/APR/Emulate/PSGI.pm view on Meta::CPAN
# Must not return Content-Type header, per PSGI spec.
}
else {
# Add Content-Type header.
push @headers, (
'Content-Type',
($self->{'content_type'} || 'text/html'),
);
}
# Add other headers that have been set.
$self->headers_out()->do(
sub {
my ($key, $value) = @_;
push @headers, $key, $value;
}
);
return \@headers;
};
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
my ($self, $value) = @_;
my $previous_value = $self->{'no_cache'} || 0;
$self->{'no_cache'} = $value ? 1 : 0;
return $previous_value if ($previous_value eq $self->{'no_cache'});
# Set headers.
if ($self->{'no_cache'}) {
$self->headers_out()->add('Pragma' => 'no-cache');
$self->headers_out()->add('Cache-control' => 'no-cache');
}
# Unset headers.
else {
$self->headers_out()->unset('Pragma', 'Cache-control');
}
return $previous_value;
}
=item status
Emulates L<Apache2::RequestRec/status>.
=cut
lib/APR/Emulate/PSGI.pm view on Meta::CPAN
sub clear {
my ($self) = @_;
my (@keys) = keys %$self;
foreach my $key (@keys) {
delete $self->{$key};
}
return 1;
}
sub set {
my ($self, @pairs) = @_;
while (@pairs) {
my ($key, $value) = splice(@pairs, 0, 2);
$self->{$key} = $value;
}
return 1;
}
sub unset {
my ($self, @keys) = @_;
foreach my $key (@keys) {
delete $self->{$key};
}
return 1;
}
sub add {
# TODO: When implemented properly, this should allow duplicate keys.
my ($self, $key, $value) = @_;
t/10_psgi.t view on Meta::CPAN
is(
$r->headers_out()->add('X-Foo' => 'Bar'),
1,
'Header added.',
);
is(
$r->content_type('text/html'),
'text/html',
'Content-type is set.',
);
# Verify that data comes out as expected (response).
is(
$r->psgi_status(),
'200',
'Received expected status.',
);
t/10_psgi.t view on Meta::CPAN
is(
$headers->{'X-Foo'},
'Bar',
'Received expected custom header.',
);
is(
$r->no_cache(1),
0,
'No cache is set.',
);
$headers = +{ @{$r->psgi_headers()} };
is(
$headers->{'Pragma'},
'no-cache',
'Received Pragma header for cache.',
);
is(
$headers->{'Cache-control'},
'no-cache',
'Received Cache-control header for cache.',
);
is(
$r->no_cache(0),
1,
'No cache is unset.',
);
$headers = +{ @{$r->psgi_headers()} };
is(
exists($headers->{'Pragma'}),
'',
'Received no Pragma header.',
);
is(
t/10_psgi.t view on Meta::CPAN
#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
1,
'Header added.',
);
my $headers_fh = IO::File->new_tmpfile();
{
local *STDOUT = $headers_fh;
is(
$r->content_type('text/html'),
'text/html',
'Content-type is set.',
);
}
$headers_fh->seek(0, 0); # Reset filehandle back to the beginning.
is(
$headers_fh->getline(),
"HTTP/1.1 200 OK\n",
'Received expected status line.',
);
is(
$headers_fh->getline(),
"Content-Type: text/html\n",
'Received expected content type.',
t/20_cgi_mode.t view on Meta::CPAN
#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.',
);
( run in 1.532 second using v1.01-cache-2.11-cpan-49f99fa48dc )