File Coverage

blib/lib/Connector/Proxy/HTTP.pm
Criterion Covered Total %
statement 37 96 38.5
branch 4 32 12.5
condition 0 15 0.0
subroutine 8 12 66.6
pod 3 3 100.0
total 52 158 32.9


line stmt bran cond sub pod time code
1             # Proxy class to get/set data using HTTP POST
2             #
3             package Connector::Proxy::HTTP;
4              
5 1     1   156557 use strict;
  1         13  
  1         29  
6 1     1   5 use warnings;
  1         9  
  1         24  
7 1     1   5 use English;
  1         3  
  1         13  
8 1     1   960 use Template;
  1         22756  
  1         32  
9              
10 1     1   545 use Moose;
  1         480710  
  1         7  
11             extends 'Connector::Proxy';
12             with qw(
13             Connector::Role::SSLUserAgent
14             Connector::Role::LocalPath
15             );
16            
17             # If not set, the path items are added to the base url as uri path
18             # if set, the keys from named parameters are combined and used as query string
19             # not implemented
20             #has named_parameters => (
21             # is => 'rw',
22             # isa => 'ArrayRef|Str|Undef',
23             # trigger => \&_convert_parameters,
24             # );
25            
26              
27             has content => (
28             is => 'rw',
29             isa => 'Str',
30             );
31              
32             has header => (
33             is => 'ro',
34             isa => 'HashRef',
35             );
36              
37             has content_type => (
38             is => 'rw',
39             isa => 'Str',
40             );
41              
42             has http_method => (
43             is => 'rw',
44             isa => 'Str',
45             default => 'PUT',
46             );
47              
48             has http_auth => (
49             is => 'ro',
50             isa => 'HashRef',
51             );
52              
53             has undef_on_404 => (
54             is => 'ro',
55             isa => 'Bool',
56             default => 0,
57             );
58              
59             has chomp_result => (
60             is => 'ro',
61             isa => 'Bool',
62             default => 0,
63             );
64              
65              
66             # If named_parameters is set using a string (necessary atm for Config::Std)
67             # its converted to an arrayref. Might be removed if Config::* improves
68             # This might create indefinite loops if something goes wrong on the conversion!
69             sub _convert_parameters {
70 0     0   0 my ( $self, $new, $old ) = @_;
71              
72             # Test if the given value is a non empty scalar
73 0 0 0     0 if ($new && !ref $new && (!$old || $new ne $old)) {
      0        
      0        
74 0         0 my @attrs = split(" ", $new);
75 0         0 $self->named_parameters( \@attrs )
76             }
77              
78             }
79            
80             sub get {
81 1     1 1 7 my $self = shift;
82              
83 1         10 my @args = $self->_build_path( shift );
84              
85 1         40 my $url = $self->LOCATION();
86 1 50       4 if (@args) {
87 0         0 $url .= '/'.join('/', @args);
88             }
89 1         23 $self->log()->debug('Make LWP call to ' . $url );
90              
91 1         19 my $req = HTTP::Request->new('GET' => $url);
92              
93             # use basic auth if supplied
94 1         8631 my $auth=$self->http_auth();
95 1 50       4 if ($auth){
96 0         0 $req->authorization_basic($auth->{user},$auth->{pass});
97             }
98              
99             # extra headers
100 1         31 my $header = $self->header();
101 1         2 foreach my $key (%{$header}) {
  1         5  
102 0         0 $req->header($key, $header->{$key} );
103             }
104              
105 1         32 my $response = $self->agent()->request($req);
106            
107 1 50       518163 if (!$response->is_success) {
108 0 0 0     0 if ( $response->code == 404 && $self->undef_on_404()) {
109 0         0 $self->log()->warn("Resource not found");
110 0         0 return $self->_node_not_exists();
111             }
112 0         0 $self->log()->error($response->status_line);
113 0         0 die "Unable to retrieve data from server";
114             }
115              
116 1         20 return $self->_parse_result($response);
117             }
118              
119             sub set {
120              
121 0     0 1 0 my $self = shift;
122 0         0 my $file = shift;
123 0         0 my $data = shift;
124             # build url
125 0         0 my $url = $self->_sanitize_path( $file, $data );
126             # create content from template
127 0         0 my $content;
128 0 0       0 if ($self->content()) {
129 0         0 $self->log()->debug('Process template for content ' . $self->content());
130 0         0 my $template = Template->new({});
131              
132 0 0       0 $data = { DATA => $data } if (ref $data eq '');
133              
134 0 0       0 $template->process( \$self->content(), $data, \$content) || die "Error processing content template.";
135             } else {
136 0 0       0 if (ref $data ne '') {
137 0         0 die "You need to define a content template if data is not a scalar";
138             }
139 0         0 $content = $data;
140             }
141              
142             # create request
143 0         0 my $req = HTTP::Request->new($self->http_method() => $url);
144             # use basic auth if supplied
145 0         0 my $auth=$self->http_auth();
146 0 0       0 if ($auth){
147 0         0 $req->authorization_basic($auth->{user},$auth->{pass});
148             }
149             # set content_type if supplied
150 0 0       0 if ($self->content_type()){
151 0         0 $req->content_type($self->content_type());
152             }
153              
154             # extra headers
155 0         0 my $header = $self->header();
156 0         0 foreach my $key (%{$header}) {
  0         0  
157 0         0 $req->header($key, $header->{$key} );
158             }
159              
160             # set generated content
161 0         0 $req->content($content);
162              
163 0         0 my $response = $self->agent()->request($req);
164             # error handling
165 0 0       0 if (!$response->is_success) {
166 0         0 $self->log()->error($response->status_line);
167 0         0 $self->log()->error($response->decoded_content);
168 0         0 die "Unable to upload data to server";
169             }
170              
171 0         0 $self->log()->debug("Set responded with: " . $response->status_line);
172 0 0       0 $self->log()->trace($response->decoded_content) if ($self->log()->is_trace());
173              
174 0         0 return 1;
175             }
176              
177             sub get_meta {
178 0     0 1 0 my $self = shift;
179              
180             # If we have no path, we tell the caller that we are a connector
181 0         0 my @path = $self->_build_path_with_prefix( shift );
182 0 0       0 if (scalar @path == 0) {
183 0         0 return { TYPE => "connector" };
184             }
185              
186 0         0 return {TYPE => "scalar" };
187             }
188              
189              
190             sub _sanitize_path {
191              
192 0     0   0 my $self = shift;
193 0         0 my $inargs = shift;
194 0         0 my $data = shift;
195              
196 0         0 my @args = $self->_build_path_with_prefix( $inargs );
197              
198 0         0 my $file = $self->_render_local_path( \@args, $data );
199              
200 0         0 my $filename = $self->LOCATION();
201 0 0 0     0 if (defined $file && $file ne "") {
202 0         0 $filename .= '/'.$file;
203             }
204              
205 0         0 $self->log()->debug('Filename evaluated to ' . $filename);
206              
207 0         0 return $filename;
208             }
209              
210             sub _parse_result {
211              
212 1     1   3 my $self = shift;
213 1         3 my $response = shift;
214              
215 1         9 my $res = $response->decoded_content;
216 1 50       16627 chomp $res if ($self->chomp_result());
217 1         72 return $res;
218             }
219              
220              
221 1     1   8769 no Moose;
  1         2  
  1         6  
222             __PACKAGE__->meta->make_immutable;
223              
224             1;
225             __END__
226              
227             =head1 NAME
228              
229             Connector::Proxy::HTTP
230              
231             =head1 DESCRIPTION
232              
233             Send or retrieve data from a defined URI using HTTP.
234              
235             =head1 USAGE
236              
237             =head2 minimal setup
238              
239             Connector::Proxy::HTTP->new({
240             LOCATION => 'https://127.0.0.1/my/base/url',
241             });
242              
243             =head2 connection settings
244              
245             See Connector::Role::SSLUserAgent for SSL and HTTP related settings
246              
247             =head2 additional options
248              
249             =over
250              
251             =item named_parameters
252              
253             not implemented yet
254              
255             =item header
256              
257             A HashRef, the key/value pairs are set as HTTP headers.
258              
259             =item http_auth
260              
261             A HashRef with I<user> and I<pass> used as credentials to perform a
262             HTTP Basic Authentication.
263              
264             =item chomp_result
265              
266             When working with text documents the transport layer adds a trailing
267             newline which might be unhandy when working with scalar values. If
268             set to a true value, a trailing newline will be removed by calling C<chomp>.
269              
270             =item undef_on_404
271              
272             By default, the connector will die if a resource is not found. If set
273             to a true value the connector returns undef, note that die_on_undef
274             will be obeyed.
275              
276             =back
277              
278             =head2 Parameter used with set
279              
280             =over
281              
282             =item file/path
283              
284             You can append a templated string to the LOCATION by setting I<file>,
285             I<path> or simply pass I<ARGS>. See Connector::Role::LocalPath for details.
286              
287             =item content
288              
289             A template toolkit string to generate the payload, receives the payload
290             argument as HasRef in I<DATA>.
291              
292             =item content_type
293              
294             The Content-Type header to use, default is no header.
295              
296             =item http_method
297              
298             The http method to use, default is PUT.
299              
300             =back
301              
302              
303             =head1 Result Handling
304              
305             If you need to parse the result returned by get, inherit from the class
306             an implement I<_parse_result>. This method receives the response object
307             from the user agent call and must return a scalar value which is returned
308             to the caller.