view release on metacpan or  search on metacpan

lib/Async/MicroserviceReq.pm  view on Meta::CPAN

    isa      => 'Ref',
    required => 0,
    lazy     => 1,
    builder  => '_build_json_content'
);
has 'params' => ( is => 'ro', isa => 'Object', required => 1 );
has 'plack_respond' => (
    is       => 'rw',
    isa      => 'CodeRef',
    required => 0,
    clearer  => 'clear_plack_respond'
);
has 'static_dir' =>
    ( is => 'ro', isa => 'Path::Class::Dir', required => 1, coerce => 1 );

has 'base_url' => (
    is       => 'ro',
    isa      => 'URI',
    required => 1,
    lazy     => 1,
    builder  => '_build_base_url'
);
has 'want_json' => (
    is       => 'ro',
    isa      => 'Bool',
    required => 1,
    lazy     => 1,
    builder  => '_build_want_json'
);
has 'jsonp' => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
);
has 'using_frontend_proxy' => (
    is      => 'ro',
    isa     => 'Bool',
    default => 0,
);
has 'pending_ref' => (
    is       => 'ro',
    isa      => 'ScalarRef[Int]',
    required => 1,
);
has 'request_start' => (
    is       => 'ro',
    isa      => 'Num',
    required => 1,
    default  => sub { time() },
);
has 'request_timeout' => ( is => 'ro', isa => 'Num', required => 1 );
has '_warn_running_too_long' => (
    is      => 'ro',
    isa     => 'ArrayRef',
    lazy    => 1,
    builder => '_build_warn_running_too_long'
);

after 'BUILD' => sub {
    my ($self) = @_;
    $self->_warn_running_too_long;    # init timer
    return;
};

sub _build_base_url {
    my ($self) = @_;
    return URI->new('/') if !$self->using_frontend_proxy;

    my $https_on = '';
    $https_on = $self->headers->header('HTTP_X_FORWARDED_HTTPS')
        if $self->headers->header('HTTP_X_FORWARDED_HTTPS');
    $https_on = 'ON'
        if $self->headers->header('HTTP_X_FORWARDED_PROTO')
        && $self->headers->header('HTTP_X_FORWARDED_PROTO') eq
        'https';    # Pound
    my $url_scheme = ( $https_on && uc $https_on eq 'ON' ? 'https' : 'http' );
    my $default_port = $url_scheme eq 'https' ? 443 : 80;

    my $redirect_host;
    my $redirect_port = $default_port;
    if ( $self->headers->header('HTTP_X_FORWARDED_HOST') ) {

        # in apache1 ServerName example.com:443
        if ( $self->headers->header('HTTP_X_FORWARDED_SERVER') ) {
            my ( $host, ) =
                $self->headers->header('HTTP_X_FORWARDED_SERVER') =~
                /([^,\s]+)$/;
            if ( $host =~ /^(.+):(\d+)$/ ) {
                $redirect_port = $2;
                $host          = $1;
            }
            $redirect_host = $host;
        }
        my ( $host, ) =
            $self->headers->header('HTTP_X_FORWARDED_HOST') =~ /([^,\s]+)$/;
        if ( $host =~ /^(.+):(\d+)$/ ) {
            $redirect_port = $2;
            $host          = $1;
        }
        elsif ( $self->headers->header('HTTP_X_FORWARDED_PORT') ) {

            # in apache2 httpd.conf (RequestHeader set X-Forwarded-Port 8443)
            $redirect_port = $self->headers->header('HTTP_X_FORWARDED_PORT');
        }
        $redirect_host = $host;
    }

    unless ($redirect_host) {
        $log->warn(
            'using front-end proxy but no host information in headers, check if your proxy is configured to send correct headers'
        );
        return URI->new('/');
    }

    my $redirect_host_port;
    if (   ( ( $redirect_port eq '80' ) && ( $url_scheme eq 'http' ) )
        || ( ( $redirect_port eq '443' ) && ( $url_scheme eq 'https' ) ) ) {
        $redirect_host_port = $redirect_host;
    }
    else {
        $redirect_host_port = $redirect_host . ':' . $redirect_port;
    }

    return URI->new( $url_scheme . '://' . $redirect_host_port . '/' );
}

sub _build_warn_running_too_long {
    my ($o_self) = @_;

    weaken( my $self = $o_self );
    return AnyEvent->timer(
        'after'    => $self->request_timeout,
        'interval' => $self->request_timeout,
        'cb'       => sub {
            $log->errorf(
                'request %s %s running too long for %d seconds',
                $self->method, $self->path, ( time - $self->request_start ),
            );
        },
    );
}

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

    my $accept = $self->headers->header('Accept');
    return 0
        unless defined($accept) && length($accept);

    my $chosen =
        choose( [ [ 'json', 1.0, 'application/json' ] ], $self->headers, );
    return defined($chosen) ? 1 : 0;
}

sub _build_json_content {
    my ($self) = @_;
    return $json->decode( $self->content );
}

sub BUILD {
    ${ $_[0]->pending_ref }++;
    return;
}

sub DEMOLISH {
    ${ $_[0]->pending_ref }--;
    return;
}

sub text_plain {
    my ( $self, @text ) = @_;
    return $self->respond( 200, [], join( "\n", ( @text, q{} ) ) );
}

sub _should_wrap_payload_as_json {
    my ( $self, $headers_as_hash, $payload ) = @_;
    return (   $self->want_json
            && !ref($payload)
            && !$headers_as_hash->{'content-type'} ) ? 1 : 0;
}

sub _wrap_payload {
    my ( $self, $state ) = @_;

    return $state->{payload}
        unless $self->_should_wrap_payload_as_json( $state->{headers_as_hash},
        $state->{payload} );

    if ( $state->{status} < 400 ) {
        return { 'data' => $state->{payload} };
    }