view release on metacpan or  search on metacpan

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

package Consul::Simple;
$Consul::Simple::VERSION = '1.142430';
use strict;use warnings;
use LWP::UserAgent;
use HTTP::Response;
use HTTP::Request::Common;
use MIME::Base64;
use JSON;
use Data::Dumper;

sub new {
    my $class = shift;
    my $self = {};
    bless ($self,$class);
    my %args;
    {   my @args = @_;
        die 'Consul::Simple::new: even number of arguments required'
            if scalar @args % 2;
        %args = @args;
    }
    $self->{consul_server} = $args{consul_server} || 'localhost';
    $args{kv_prefix} = $args{kvPrefix} if $args{kvPrefix};
    $self->{kv_prefix} = $args{kv_prefix} || '/';
    $self->{kv_prefix} =~ s/\/\//\//g;
    $self->{kv_prefix} =~ s/\/\//\//g;
    $self->{kv_prefix} =~ s/\/\//\//g;
    if($self->{kv_prefix} !~ /^\//) {
        $self->{kv_prefix} = '/' . $self->{kv_prefix};
    }
    if($self->{kv_prefix} !~ /\/$/) {
        $self->{kv_prefix} = $self->{kv_prefix} . '/';
    }
    {   my %ua_args = ();
        $ua_args{ssl_opts} = $args{ssl_opts} if $args{ssl_opts};
        $self->{ua} = LWP::UserAgent->new(%ua_args);
    }

    $self->{proto} = $args{proto} || 'http';
    $self->{consul_port} = $args{port} || 8500;
    $self->{constructor_args} = \%args;
    $self->{warning_handler} = $args{warning_handler} || sub {
        my $warnstr = shift;
        my %args = @_;
        print STDERR "[WARN]: $warnstr\n";
    };
    return $self;
}

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);
        };

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

        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__

=head1 NAME

Consul::Simple - Easy access to Consul (http://www.consul.io/)

=head1 SYNOPSIS

    my $c = Consul::Simple->new();
    $c->KVPut('foo/bar', 'something');
    my @recs = $c->KVGet('foo/bar');
    #@recs = [
    #      {
    #        'Value' => 'one',
    #        'LockIndex' => 0,
    #        'CreateIndex' => 4,
    #        'Flags' => 0,
    #        'ModifyIndex' => 4,
    #        'Key' => 'foo/bar'
    #      }
    #    ];

    $c->KVPut('foo/fuz', { something => 'rich' });
    my @recs = $c->KVGet('foo/bar', recurse => 1);
    #@recs = [
    #      {
    #        'Value' => 'one',
    #        'LockIndex' => 0,
    #        'CreateIndex' => 4,
    #        'Flags' => 0,
    #        'ModifyIndex' => 4,
    #        'Key' => 'foo/bar'
    #      },
    #      {
    #        'Value' => {
    #                     'something' => 'rich'
    #                   },
    #        'LockIndex' => 0,
    #        'CreateIndex' => 5,
    #        'Flags' => 0,
    #        'ModifyIndex' => 5,
    #        'Key' => 'foo/fuz'
    #      }
    #    ];
    $c->KVDelete('foo/bar');

=head1 DESCRIPTION

Simple interface to Consul (http://www.consul.io/)

=head1 METHODS/CONSTRUCTOR