view release on metacpan or  search on metacpan

lib/Consul/Simple.pm  view on Meta::CPAN

}

sub _warn {
    my $self = shift;
    $self->{warning_handler}->(@_);
}

sub _do_request {
    my $self = shift;
    my $req = shift;
    my %req_args = @_;
    my $ret;
    my $tries = $self->{constructor_args}->{retries} || 5;
    my $timeout = $self->{constructor_args}->{timeout} || 2;
    while($tries--) {
        eval {
            local $SIG{ALRM} = sub { die "timed out\n"; };
            alarm $timeout;
            $ret = $self->{ua}->request($req, %req_args);
        };
        alarm 0;
        last if $ret->status_line =~ /^404 /;
        last if $ret and $ret->is_success;
        my $err;
        if($@) {
            $err = $@;
        } else {
            $err = 'http request failed with ' . $ret->status_line;
        }
        $self->_warn("request failed: $err", response => $ret);
        sleep 1;
    }
    return $ret;
}

sub KVGet {
    my $self = shift;
    my $key = shift;
    die 'Consul::Simple::KVGet: key required as first argument' unless defined $key;
    my %args;
    {   my @args = @_;
        die 'Consul::Simple::KVGet: even number of arguments required'
            if scalar @args % 2;
        %args = @args;
    }
    my @entries = ();
    eval {
        my $url = $self->_mk_kv_url($key);
        $url .= '?recurse' if $args{recurse};
        my $res = $self->_do_request(GET $url);
        my $content = $res->content;
        my $values = JSON::decode_json($content);
        @entries = @$values;
    };
    my @ret = ();
    foreach my $entry (@entries) {
        #The returned entry Value is always base64 encoded
        $entry->{Value} = MIME::Base64::decode_base64($entry->{Value});

        #the idea below is to try to JSON decode it.  If that works,
        #return the JSON decoded value.  Otherwise, return it un-decoded
        my $value;
        eval {
            $value = JSON::decode_json($entry->{Value});
        };
        $value = $entry->{Value} unless $value;
        $entry->{Value} = $value;
        push @ret, $entry;
    }

    return @ret;
}


sub KVPut {
    my $self = shift;
    my $key = shift;
    die 'Consul::Simple::KVPut: key required as first argument' unless defined $key;
    my $value = shift or die 'Consul::Simple::KVPut: value required as second argument';
    if(ref $value) {
        $value = JSON::encode_json($value);
    }
    my %args;
    {   my @args = @_;
        die 'Consul::Simple::KVPut: even number of arguments required'
            if scalar @args % 2;
        %args = @args;
    }
    my $res = $self->_do_request(PUT $self->_mk_kv_url($key), Content => $value);
    return $res;
}

sub _mk_kv_url {
    my $self = shift;
    my $key = shift;
    return $self->{proto} . '://' . $self->{consul_server} . ':' . $self->{consul_port} . '/v1/kv' . $self->{kv_prefix} . $key;
}

sub KVDelete {
    my $self = shift;
    my $key = shift;
    die 'Consul::Simple::KVDelete: key required as first argument' unless defined $key;
    my %args;
    {   my @args = @_;
        die 'Consul::Simple::KVPut: even number of arguments required'
            if scalar @args % 2;
        %args = @args;
    }
    my $url = $self->_mk_kv_url($key);
    $url .= '?recurse' if $args{recurse};
    my $res = $self->_do_request(
        HTTP::Request::Common::_simple_req(
            'DELETE',
            $url
        )
    );
    return $res;
}
1;

__END__