File Coverage

blib/lib/Test/Smoke/Poster/HTTP_Tiny.pm
Criterion Covered Total %
statement 25 27 92.5
branch 3 8 37.5
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 35 42 83.3


line stmt bran cond sub pod time code
1             package Test::Smoke::Poster::HTTP_Tiny;
2 4     4   28 use warnings;
  4         7  
  4         134  
3 4     4   21 use strict;
  4         8  
  4         142  
4              
5             our $VERSION = '0.001';
6              
7 4     4   52 use base 'Test::Smoke::Poster::Base';
  4         6  
  4         420  
8              
9 4     4   26 use URI::Escape qw(uri_escape);
  4         8  
  4         1390  
10              
11             =head1 NAME
12              
13             Test::Smoke::Poster::HTTP_Tiny - Poster subclass using HTTP::Tiny.
14              
15             =head1 DESCRIPTION
16              
17             This is a subclass of L.
18              
19             =head2 Test::Smoke::Poster::HTTP_Tiny->new(%arguments)
20              
21             =head3 Extra Arguments
22              
23             None.
24              
25             =cut
26              
27             sub new {
28 5     5 1 24 my $class = shift;
29 5         125 my $self = $class->SUPER::new(@_);
30              
31 5         48 require HTTP::Tiny;
32 5 100       62 $self->{_ua} = HTTP::Tiny->new(
33             agent => $self->agent_string(),
34             ( $self->ua_timeout ? (timeout => $self->ua_timeout) : () ),
35             );
36              
37 5         550 return $self;
38             }
39              
40             =head2 $poster->_post_data()
41              
42             Post the json to CoreSmokeDB using HTTP::Tiny.
43              
44             =cut
45              
46             sub _post_data {
47 1     1   2 my $self = shift;
48              
49 1         14 $self->log_info("Posting to %s via %s.", $self->smokedb_url, $self->poster);
50 1         8 $self->log_debug("Report data: %s", my $json = $self->get_json);
51              
52 1         40 my $form_data = sprintf("json=%s", uri_escape($json));
53 1         89 my $response = $self->ua->request(
54             POST => $self->smokedb_url,
55             {
56             headers => {
57             'Content-Type' => 'application/x-www-form-urlencoded',
58             'Content-Length' => length($form_data),
59             },
60             content => $form_data,
61             },
62             );
63              
64 1 50       4708 if (!$response->{success}) {
65             $self->log_warn(
66             "POST failed: %s %s%s",
67             $response->{status},
68             $response->{reason},
69 0 0       0 ($response->{content} ? " ($response->{content})" : ""),
70             );
71             die sprintf(
72             "POST to '%s' failed: %s %s%s\n",
73             $self->smokedb_url,
74             $response->{status}, $response->{reason},
75 0 0       0 ($response->{content} ? " ($response->{content})" : ""),
76             );
77             }
78              
79 1         5 $self->log_debug("[CoreSmokeDB] %s", $response->{content});
80              
81 1         6 return $response->{content};
82             }
83              
84             1;
85              
86             =head1 COPYRIGHT
87              
88             (c) 2002-2013, Abe Timmerman All rights reserved.
89              
90             With contributions from Jarkko Hietaniemi, Merijn Brand, Campo
91             Weijerman, Alan Burlison, Allen Smith, Alain Barbet, Dominic Dunlop,
92             Rich Rauenzahn, David Cantrell.
93              
94             This library is free software; you can redistribute it and/or modify
95             it under the same terms as Perl itself.
96              
97             See:
98              
99             =over 4
100              
101             =item * L
102              
103             =item * L
104              
105             =back
106              
107             This program is distributed in the hope that it will be useful,
108             but WITHOUT ANY WARRANTY; without even the implied warranty of
109             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
110              
111             =cut