APR-Emulate-PSGI

 view release on metacpan or  search on metacpan

META.yml  view on Meta::CPAN

---
abstract: 'Class that Emulates the mod_perl2 APR Object (Apache2::RequestRec, et al)'
author:
  - 'Nathan Gray, <kolibrie@cpan.org>'
build_requires:
  ExtUtils::MakeMaker: 6.59
  IO::File: 0
  Test::More: 0.88
configure_requires:
  ExtUtils::MakeMaker: 6.59
distribution_type: module
dynamic_config: 1
generated_by: 'Module::Install version 1.06'
license: perl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: 1.4
name: APR-Emulate-PSGI
no_index:
  directory:
    - inc

README.pod  view on Meta::CPAN


=cut

=item status_line

Emulates L<Apache2::RequestRec/status_line>.


=cut

=item content_type

Emulates L<Apache2::RequestRec/content_type>.

If no PSGI enviroment is provided to L</new>, calling this
method with a parameter will cause HTTP headers to be sent.


=cut

=item print

Emulates L<Apache2::RequestIO/print>.

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


# If we are passed a param, do a "newer than" comparison.
# Otherwise, just return the MakeMaker version.
sub makemaker {
	( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
}

# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
# as we only need to know here whether the attribute is an array
# or a hash or something else (which may or may not be appendable).
my %makemaker_argtype = (
 C                  => 'ARRAY',
 CONFIG             => 'ARRAY',
# CONFIGURE          => 'CODE', # ignore
 DIR                => 'ARRAY',
 DL_FUNCS           => 'HASH',
 DL_VARS            => 'ARRAY',
 EXCLUDE_EXT        => 'ARRAY',
 EXE_FILES          => 'ARRAY',
 FUNCLIST           => 'ARRAY',
 H                  => 'ARRAY',

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

 DEFINE    => 'APPENDABLE',
 INC       => 'APPENDABLE',
 LDDLFLAGS => 'APPENDABLE',
 LDFROM    => 'APPENDABLE',
);

sub makemaker_args {
	my ($self, %new_args) = @_;
	my $args = ( $self->{makemaker_args} ||= {} );
	foreach my $key (keys %new_args) {
		if ($makemaker_argtype{$key}) {
			if ($makemaker_argtype{$key} eq 'ARRAY') {
				$args->{$key} = [] unless defined $args->{$key};
				unless (ref $args->{$key} eq 'ARRAY') {
					$args->{$key} = [$args->{$key}]
				}
				push @{$args->{$key}},
					ref $new_args{$key} eq 'ARRAY'
						? @{$new_args{$key}}
						: $new_args{$key};
			}
			elsif ($makemaker_argtype{$key} eq 'HASH') {
				$args->{$key} = {} unless defined $args->{$key};
				foreach my $skey (keys %{ $new_args{$key} }) {
					$args->{$key}{$skey} = $new_args{$key}{$skey};
				}
			}
			elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
				$self->makemaker_append($key => $new_args{$key});
			}
		}
		else {
			if (defined $args->{$key}) {
				warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
			}
			$args->{$key} = $new_args{$key};
		}
	}

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


my @boolean_keys = qw{
	sign
};

my @scalar_keys = qw{
	name
	module_name
	abstract
	version
	distribution_type
	tests
	installdirs
};

my @tuple_keys = qw{
	configure_requires
	build_requires
	requires
	recommends
	bundles

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

	while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
		$self->feature( $name, @$mods );
	}
	return $self->{values}->{features}
		? @{ $self->{values}->{features} }
		: ();
}

sub no_index {
	my $self = shift;
	my $type = shift;
	push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
	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');

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

    my @headers = ();

    my $status = $self->psgi_status();
    if ($status eq '204' || $status eq '304' || $status =~ /^1/) {
        # 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;
        }
    );

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

Emulates L<Apache2::RequestRec/status_line>.

=cut

sub status_line {
    my ($self, @value) = @_;
    $self->{'status_line'} = $value[0] if scalar(@value);
    return $self->{'status_line'};
}

=item content_type

Emulates L<Apache2::RequestRec/content_type>.

If no PSGI enviroment is provided to L</new>, calling this
method with a parameter will cause HTTP headers to be sent.

=cut

sub content_type {
    my ($self, @value) = @_;
    if (scalar(@value)) {
        $self->{'content_type'} = $value[0];

        if ($self->{'cgi_mode'}) {
            $self->_send_http_headers();
        }
    }
    return $self->{'content_type'};
}

sub _send_http_headers {
    my ($self) = @_;
    return if ($self->{'headers_sent'});
    if (my $status = $self->status_line() || $self->status() || '200 OK') {
        my $url_scheme = uc($self->{'psgi_env'}{'psgi.url_scheme'} || 'http');
        print $url_scheme . '/1.1 ' . $status . "\n";
    }
    print 'Content-Type: ' . ($self->{'content_type'} || 'text/html') . "\n";
    $self->headers_out()->do(
        sub {
            my ($key, $value) = @_;
            print join(': ', $key, $value) . "\n";
        }
    );
    print "\n\n";
    $self->{'headers_sent'} = 1;
    return 1;
}

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


is(
    $r->method(),
    'POST',
    'Request method is available.',
);

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'),

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


# Set headers for the response.

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.',
);

my $headers = +{ @{$r->psgi_headers()} };
is(
    $headers->{'Content-Type'},
    'text/html',
    'Received expected content type.',
);

is(
    $headers->{'X-Foo'},
    'Bar',
    'Received expected custom header.',
);

is(
	$r->no_cache(1),

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


is(
    $r->method(),
    'POST',
    'Request method is available.',
);

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'),

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

is(
    $r->headers_out()->add('X-Foo' => 'Bar'),
    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.',
);

is(
    $headers_fh->getline(),
    "X-Foo: Bar\n",
    'Received expected custom header.',
);

is(
    $headers_fh->getline(),



( run in 3.399 seconds using v1.01-cache-2.11-cpan-df04353d9ac )