File Coverage

blib/lib/Pinto/Locator/Stratopan.pm
Criterion Covered Total %
statement 43 43 100.0
branch 9 10 90.0
condition 1 2 50.0
subroutine 11 11 100.0
pod 0 2 0.0
total 64 68 94.1


line stmt bran cond sub pod time code
1             # ABSTRACT: Locate targets using Stratopan services
2              
3             package Pinto::Locator::Stratopan;
4              
5 51     51   337 use Moose;
  51         122  
  51         383  
6 51     51   341862 use MooseX::StrictConstructor;
  51         122  
  51         497  
7 51     51   166005 use MooseX::MarkAsMethods ( autoclean => 1 );
  51         127  
  51         476  
8              
9 51     51   203416 use URI;
  51         116  
  51         1582  
10 51     51   252 use JSON qw(decode_json);
  51         100  
  51         478  
11 51     51   22806 use HTTP::Request::Common qw(GET);
  51         75055  
  51         3915  
12              
13 51     51   390 use Pinto::Util qw(whine);
  51         119  
  51         2417  
14 51     51   315 use Pinto::Constants qw(:stratopan);
  51         111  
  51         3163  
15              
16             #-----------------------------------------------------------------------------
17              
18             our $VERSION = '0.14'; # VERSION
19              
20             #-----------------------------------------------------------------------------
21              
22             extends qw(Pinto::Locator);
23              
24             #-----------------------------------------------------------------------------
25              
26             sub locate_package {
27 6     6 0 22 my ($self, %args) = @_;
28              
29 6         24 return $self->_locate_any(%args);
30             }
31              
32             #-----------------------------------------------------------------------------
33              
34             sub locate_distribution {
35 3     3 0 15 my ($self, %args) = @_;
36              
37 3         13 return $self->_locate_any(%args);
38             }
39              
40             #-----------------------------------------------------------------------------
41              
42             sub _locate_any {
43 9     9   32 my ($self, %args) = @_;
44              
45 9         46 my $uri = $PINTO_STRATOPAN_LOCATOR_URI->clone;
46 9         171 $uri->query_form(q => $args{target}->to_string);
47 9         814 my $response = $self->request(GET($uri));
48              
49 9 100       11738 if (!$response->is_success) {
50 1         14 my $status = $response->status_line;
51 1         27 whine "Stratopan is not responding: $status";
52 1         11 return;
53             }
54              
55 8         92 my $structs = eval { decode_json($response->content) };
  8         26  
56 8 100 50     206 whine "Invalid response from Stratopan: $@" and return if $@;
57              
58 7 100       54 return unless my $latest = $structs->[0];
59              
60             # Avoid autovivification here...
61             $latest->{version} = version->parse($latest->{version})
62 3 100       36 if exists $latest->{version};
63              
64             # Avoid autovivification here...
65             $latest->{uri} = URI->new($latest->{uri})
66 3 50       21 if exists $latest->{uri};
67              
68 3         314 return $latest;
69             }
70              
71             #-----------------------------------------------------------------------------
72              
73             __PACKAGE__->meta->make_immutable;
74              
75             #-----------------------------------------------------------------------------
76             1;
77              
78             __END__
79              
80             =pod
81              
82             =encoding UTF-8
83              
84             =for :stopwords Jeffrey Ryan Thalhammer
85              
86             =head1 NAME
87              
88             Pinto::Locator::Stratopan - Locate targets using Stratopan services
89              
90             =head1 VERSION
91              
92             version 0.14
93              
94             =head1 AUTHOR
95              
96             Jeffrey Ryan Thalhammer <jeff@stratopan.com>
97              
98             =head1 COPYRIGHT AND LICENSE
99              
100             This software is copyright (c) 2015 by Jeffrey Ryan Thalhammer.
101              
102             This is free software; you can redistribute it and/or modify it under
103             the same terms as the Perl 5 programming language system itself.
104              
105             =cut