view release on metacpan or  search on metacpan

lib/Connector/Proxy/HTTP.pm  view on Meta::CPAN

use Moose;
extends 'Connector::Proxy';
with qw(
    Connector::Role::SSLUserAgent
    Connector::Role::LocalPath
);

has content => (
    is  => 'rw',
    isa => 'Str',
    );

has header => (
    is  => 'ro',
    isa => 'HashRef',
    );

has content_type => (
    is  => 'rw',
    isa => 'Str',
    );

has http_method => (
    is => 'rw',
    isa => 'Str',
    default => 'PUT',
    );

has http_auth => (
    is  => 'ro',
    isa => 'HashRef',
    );

has query_param => (
    is  => 'rw',
    isa => 'HashRef',
    predicate => 'has_query_param',
    );

has undef_on_404 => (
    is  => 'ro',
    isa => 'Bool',
    default => 0,
    );

has chomp_result => (
    is  => 'ro',
    isa => 'Bool',
    default => 0,
    );


sub get {
    my $self = shift;
    my $args = shift;

    my $url = $self->_sanitize_path( $args );
    $self->log()->debug('Make LWP call to ' . $url );

    my $req = HTTP::Request->new('GET' => $url);
    $self->_init_request( $req );

    my $response = $self->agent()->request($req);

    if (!$response->is_success) {
        if ( $response->code == 404 && $self->undef_on_404()) {
            $self->log()->warn("Resource not found");
            return $self->_node_not_exists();
        }
        $self->log()->error($response->status_line);
        die "Unable to retrieve data from server";
    }

     return $self->_parse_result($response);
}

sub set {

    my $self = shift;
    my $args = shift;
    my $data = shift;
    # build url
    my $url = $self->_sanitize_path( $args, $data );
    # create content from template
    my $content;
    if ($self->content()) {
        $self->log()->debug('Process template for content ' . $self->content());
        my $template = Template->new({});

        $data = { DATA => $data } if (ref $data eq '');

        $template->process( \$self->content(), $data, \$content) || die "Error processing content template.";
    } else {
        if (ref $data ne '') {
            die "You need to define a content template if data is not a scalar";
        }
        $content = $data;
    }

    # create request
    my $req = HTTP::Request->new($self->http_method() => $url);
    $self->_init_request( $req );

    # set generated content
    $req->content($content);

    my $response = $self->agent()->request($req);
    # error handling
    if (!$response->is_success) {
        $self->log()->error($response->status_line);
        $self->log()->error($response->decoded_content);
        die "Unable to upload data to server";
    }

    $self->log()->debug("Set responded with: " . $response->status_line);
    $self->log()->trace($response->decoded_content) if ($self->log()->is_trace());

    return 1;
}

sub get_meta {
    my $self = shift;

    # If we have no path, we tell the caller that we are a connector
    my @path = $self->_build_path_with_prefix( shift );
    if (scalar @path == 0) {
        return { TYPE  => "connector" };
    }

    return {TYPE  => "scalar" };
}


sub _init_request {

    my $self = shift;
    my $req = shift;

    # use basic auth if supplied
    my $auth = $self->http_auth();
    if ($auth){
        $req->authorization_basic($auth->{user}, $auth->{pass});
    }

    # set content_type if supplied (does not make much sense with GET)
    if ($self->content_type()){
        $req->content_type($self->content_type());
    }

    # extra headers
    my $header = $self->header();
    foreach my $key (%{$header}) {
        $req->header($key, $header->{$key} );
    }

    $self->log()->trace(Dumper $req) if ($self->log()->is_trace());

}

sub _sanitize_path {