view release on metacpan or  search on metacpan

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

sub method {
    my ($self) = @_;
    if ($self->{'cgi_mode'}) {
        return $ENV{'REQUEST_METHOD'};
    }
    return $self->{'psgi_env'}{'REQUEST_METHOD'};
}

=item uri

Emulates L<Apache2::RequestRec/uri>.

=cut

sub uri {
    my ($self) = @_;
    if ($self->{'cgi_mode'}) {
        return $ENV{'PATH_INFO'};
    }
    return $self->{'psgi_env'}{'PATH_INFO'};
}

=item parsed_uri

Emulates L<Apache2::URI/parsed_uri>.

=cut

sub parsed_uri {
    my ($self) = @_;
    if ($self->{'cgi_mode'}) {
        return $self->{'uri'} //= URI->new($ENV{'REQUEST_URI'});
    }
    return $self->{'uri'} //= URI->new($self->{'psgi_env'}{'REQUEST_URI'});
}

=item args

Emulates L<Apache2::RequestRec/args>.

=cut

sub args {
    my ($self) = @_;
    if ($self->{'cgi_mode'}) {
        return $ENV{'QUERY_STRING'};
    }
    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) = @_;
    return $self->{'pool'} //= APR::MyPool->new();
}

=back

=head2 Response Methods

=over 4

=item headers_out

Emulates L<Apache2::RequestRec/headers_out>.

=cut

sub headers_out {
    my ($self) = @_;
    return $self->{'headers_out'} //= APR::MyTable::make();
}

=item err_headers_out

Emulates L<Apache2::RequestRec/err_headers_out>.

=cut

sub err_headers_out {
    my ($self) = @_;
    return $self->{'err_headers_out'} //= APR::MyTable::make();
}

=item no_cache

Emulates L<Apache2::RequestUtil/no_cache>.

=cut

sub no_cache {
    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');