File Coverage

blib/lib/Test/Smoke/Poster/LWP_UserAgent.pm
Criterion Covered Total %
statement 26 29 89.6
branch 2 6 33.3
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::LWP_UserAgent;
2 4     4   25 use warnings;
  4         10  
  4         131  
3 4     4   20 use strict;
  4         9  
  4         165  
4              
5             our $VERSION = '0.001';
6              
7 4     4   23 use base 'Test::Smoke::Poster::Base';
  4         8  
  4         454  
8              
9 4     4   29 use Test::Smoke::Util::LoadAJSON;
  4         8  
  4         40  
10              
11             =head1 NAME
12              
13             Test::Smoke::Poster::LWP_UserAgent - Poster subclass using LWP::UserAgent.
14              
15             =head1 DESCRIPTION
16              
17             This is a subclass of L.
18              
19             =head2 Test::Smoke::Poster::LWP_UserAgent->new(%arguments)
20              
21             =head3 Extra Arguments
22              
23             =over
24              
25             =item ua_timeout => a timeout te feed to L.
26              
27             =back
28              
29             =cut
30              
31             sub new {
32 1     1 1 26 my $class = shift;
33 1         55 my $self = $class->SUPER::new(@_);
34              
35 1         19 require LWP::UserAgent;
36 1         2 my %extra_args;
37 1 50       103 if (defined $self->ua_timeout) {
38 0         0 $extra_args{timeout} = $self->ua_timeout;
39             }
40 1         26 $self->{_ua} = LWP::UserAgent->new(
41             agent => $self->agent_string(),
42             %extra_args
43             );
44              
45 1         3983 return $self;
46             }
47              
48             =head2 $poster->_post_data()
49              
50             Post the json to CoreSmokeDB using LWP::UserAgent.
51              
52             =cut
53              
54             sub _post_data {
55 1     1   3 my $self = shift;
56              
57 1         11 $self->log_info("Posting to %s via %s.", $self->smokedb_url, $self->poster);
58 1         7 $self->log_debug("Report data: %s", my $json = $self->get_json);
59              
60 1         12 my $response = $self->ua->post(
61             $self->smokedb_url,
62             { json => $json }
63             );
64 1 50       72531 if ( !$response->is_success ) {
65 0         0 $self->log_warn("POST failed: %s", $response->status_line);
66 0 0       0 die sprintf(
67             "POST to '%s' failed: %s%s\n",
68             $self->smokedb_url,
69             $response->status_line,
70             ($response->content ? sprintf(" (%s)", $response->content) : ""),
71             );
72             }
73              
74 1         41 $self->log_debug("[CoreSmokeDB] %s", $response->content);
75              
76 1         10 return $response->content;
77             }
78              
79             1;
80              
81             =head1 COPYRIGHT
82              
83             (c) 2002-2015, Abe Timmerman All rights reserved.
84              
85             With contributions from Jarkko Hietaniemi, Merijn Brand, Campo
86             Weijerman, Alan Burlison, Allen Smith, Alain Barbet, Dominic Dunlop,
87             Rich Rauenzahn, David Cantrell.
88              
89             This library is free software; you can redistribute it and/or modify
90             it under the same terms as Perl itself.
91              
92             See:
93              
94             =over 4
95              
96             =item * L
97              
98             =item * L
99              
100             =back
101              
102             This program is distributed in the hope that it will be useful,
103             but WITHOUT ANY WARRANTY; without even the implied warranty of
104             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
105              
106             =cut