File Coverage

blib/lib/Net/Plywood/Simple.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Net::Plywood::Simple;
2 1     1   16713 use 5.006;
  1         5  
  1         47  
3 1     1   7 use strict;
  1         1  
  1         48  
4 1     1   6 use warnings;
  1         7  
  1         47  
5              
6 1     1   911 use HTTP::Tiny;
  1         40038  
  1         55  
7 1     1   524 use Try::Tiny;
  1         1154  
  1         51  
8 1     1   179 use JSON;
  0            
  0            
9              
10             our $VERSION = 0.06;
11              
12             ############
13             ## Public ##
14             ############
15              
16             sub new
17             {
18             my $class = shift;
19             my $params = ref($_[0]) ? $_[0] : {@_};
20             if (!$params->{scheme} || !$params->{host} || !$params->{port}) {
21             die "arguments 'scheme', 'host' and 'port' are required";
22             }
23             $params->{_url} = "$params->{scheme}://$params->{host}:$params->{port}";
24             $params->{_json} = JSON->new->utf8;
25             return bless($params, $class);
26             }
27              
28             sub disjoin
29             {
30             my ($self, $tree_key, $disjoin) = @_;
31             if (!$disjoin->{key} || !$disjoin->{value}) {
32             die "arguments 'key', 'value' are required to disjoin a tree";
33             }
34             return $self->mutate(
35             $tree_key,
36             {
37             filter => {
38             field => $disjoin->{key},
39             op => '!=',
40             value => $disjoin->{value},
41             }
42             },
43             );
44             }
45              
46             sub get
47             {
48             my ($self, $tree_key, @path) = @_;
49             my $path = join('/', @path);
50             my $response;
51             try {
52             $response = HTTP::Tiny->new->get($self->_url . "/tree/$tree_key/$path");
53             } catch {
54             die "could not get tree, error was: $_";
55             };
56             if (!$response->{success}) {
57             die "$response->{reason} ($response->{status}): $response->{content}";
58             }
59             return $response;
60             }
61              
62             sub mutate
63             {
64             my ($self, $tree_key, $data) = @_;
65             my $response;
66             my $json = $self->_to_json($data);
67             try {
68             $response = HTTP::Tiny->new->post(
69             $self->_url . "/mutate/$tree_key",
70             {content => $json},
71             );
72             } catch {
73             die "could not mutate tree, error was: $_";
74             };
75             if (!$response->{success}) {
76             die "$response->{reason} ($response->{status}): $response->{content}";
77             }
78             return $response;
79             }
80              
81             sub put
82             {
83             my ($self, $tree_key, $data) = @_;
84             if ($tree_key =~ m/\//) {
85             die 'can not have forward slash ( / ) characters in key names';
86             }
87             my $response;
88             my $json = $self->_to_json($data);
89             try {
90             $response = HTTP::Tiny->new->put(
91             $self->_url . "/tree/$tree_key",
92             {content => $json},
93             );
94             } catch {
95             die "could not store tree, error was: $_";
96             };
97             if (!$response->{success}) {
98             die "$response->{reason} ($response->{status}): $response->{content}";
99             }
100             return $response;
101             }
102              
103             #############
104             ## Private ##
105             #############
106              
107             sub _to_json
108             {
109             my ($self, $data) = @_;
110             my $json;
111             try {
112             $json = $self->_json->encode($data);
113             } catch {
114             die "could not encode data as JSON, error was: $_";
115             };
116             return $json;
117             }
118              
119             sub _from_json
120             {
121             my ($self, $json) = @_;
122             my $data;
123             try {
124             $data = $self->_json->decode($json);
125             } catch {
126             die "could not decode data which we thought was JSON, error was: $_";
127             };
128             return $data;
129             }
130              
131             sub _json {return shift->{_json}}
132             sub _url {return shift->{_url}}
133              
134             1;
135              
136             __END__