view release on metacpan or  search on metacpan

lib/App/ElasticSearch/Utilities/Connection.pm  view on Meta::CPAN

has 'timeout' => (
    is      => 'ro',
    isa     => Int,
    default => sub { 10 },
);


has 'username' => (
    is      => 'ro',
    isa     => Str,
    default => sub { $ENV{USER} },
);


has 'password' => (
    is => 'ro',
);


has 'ssl_opts' => (
    is      => 'ro',
    isa     => HashRef,
    default => sub { {} },
);


has 'ua' => (
    is  => 'lazy',
    isa => InstanceOf["LWP::UserAgent"],
);

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

    # Construct the UA Object
    ## no critic
    my $local_version = eval '$VERSION' || '999.9';
    ## use critic
    my $ua = LWP::UserAgent->new(
        keep_alive        => 3,
        agent             => sprintf("%s/%s (Perl %s)", __PACKAGE__, $local_version, $^V),
        protocols_allowed => [qw(http https)],
        timeout           => $self->timeout,
        ssl_opts          => $self->ssl_opts,
    );
    debug({color=>'cyan'}, sprintf "Initialized a UA: %s%s", $ua->agent, $self->password ? ' (password provided)' : '');

    # Decode the JSON Automatically
    $ua->add_handler( response_done => sub {
        my ($response,$lwp_ua,$headers) = @_;
        debug( {color=>'magenta'}, "respone_done handler, got:");

        debug_var($response);
        my $ctype = $response->content_type() || 'invalid';
        # JSON Transform
        if( $ctype =~ m{^application/json\b} ) {
            debug({color=>'yellow',indent=>1},"JSON Decoding Response Content");
            eval {
                my $decoded = decode_json( $response->content );
                $response->content($decoded);
            };
        }
        elsif ( $response->is_success && $ctype =~ m{^text/plain} ) {
            # Plain text transform for the _cat API
            debug({color=>'yellow',indent=>1},"Plain Text Transform Response Content");
            my $decoded = [
                grep { defined && length && !/^\s+$/ }
                split /\r?\n/, $response->content
            ];
            debug_var($decoded);
            $response->content($decoded);
        }
        if( my $content = $response->content ) {
            debug({color=>'yellow'}, "After translation:");
            if( is_ref($content) ) {
                debug_var( $content );
            }
            else{
                debug( $content );
            }
        }
        $_[0] = $response;
    });

    # Warn About Basic Auth without TLS
    warn "HTTP Basic Authorization configured and not using TLS, this is not supported"
        if length $self->password && $self->proto ne 'https';

    return $ua;
}


sub request {
    my ($self,$url,$options,$body) = @_;

    # Build the Path
    $options->{command} ||= $url;
    my @path = grep { defined and length } @{ $options }{qw(index command)};

    my $path = join('/', @path);

    debug(sprintf "calling %s->request(%s)", ref $self, $path);

    # Build a URI
    my $uri = URI->new( sprintf "%s://%s:%d",
        $self->proto,
        $self->host,
        $self->port,
    );
    $uri->path($path);

    # Query String
    if( exists $options->{uri_param} and is_hashref($options->{uri_param}) ) {
        foreach my $k ( keys %{ $options->{uri_param} } ) {
            $uri->query_param( $k => $options->{uri_param}{$k} );
        }
    }
    # Body Translations
    if(!defined $body && exists $options->{body}) {
        $body ||= delete $options->{body};
    }

    # Determine request method
    my $method = exists $options->{method} ? uc $options->{method} : 'GET';

    # Special Case for Index Creation
    if( $method eq 'PUT' && $options->{index} && $options->{command} eq '/' ) {
        $uri->path($options->{index});
    }

    debug({color=>'magenta'}, sprintf "Issuing %s with URI of '%s'", $method, $uri->as_string);