File Coverage

blib/lib/Weather/NHC/TropicalCyclone.pm
Criterion Covered Total %
statement 74 75 98.6
branch 7 10 70.0
condition 8 14 57.1
subroutine 18 18 100.0
pod 5 8 62.5
total 112 125 89.6


line stmt bran cond sub pod time code
1             package Weather::NHC::TropicalCyclone;
2              
3 2     2   1776 use strict;
  2         4  
  2         65  
4 2     2   10 use warnings;
  2         3  
  2         52  
5 2     2   1544 use HTTP::Tiny ();
  2         77220  
  2         79  
6 2     2   1140 use HTTP::Status qw/:constants/;
  2         10002  
  2         898  
7 2     2   20 use JSON::XS ();
  2         5  
  2         44  
8 2     2   1210 use Util::H2O qw/h2o/;
  2         10187  
  2         121  
9 2     2   1498 use Weather::NHC::TropicalCyclone::Storm ();
  2         8  
  2         1715  
10              
11             our $VERSION = q{0.20};
12             our $DEFAULT_URL = q{https://www.nhc.noaa.gov/CurrentStorms.json};
13             our $DEFAULT_RSS_ATLANTIC = q{https://www.nhc.noaa.gov/index-at.xml};
14             our $DEFAULT_RSS_EAST_PACIFIC = q{https://www.nhc.noaa.gov/index-ep.xml};
15             our $DEFAULT_RSS_CENTRAL_PACIFIC = q{https://www.nhc.noaa.gov/index-cp.xml};
16             our $DEFAULT_TIMEOUT = 10;
17              
18             # container class for requesting JSON and providing
19             # iterator access and meta operations for the storms
20             # contained in the JSON returned by NHC
21              
22             sub new {
23 4     4 1 5263 my $pkg = shift;
24 4         20 my $self = {
25             _obj => undef,
26             _storms => {},
27             };
28 4         1232 return bless $self, $pkg;
29             }
30              
31             sub fetch {
32 4     4 1 1818 my ( $self, $timeout ) = @_;
33 4         37 my $http = HTTP::Tiny->new();
34              
35 4     1   621 local $SIG{ALRM} = sub { die "Request has timed out.\n" };
  1         1000311  
36              
37 4   66     86 alarm( $timeout // $DEFAULT_TIMEOUT );
38              
39             # get content via $DEFAULT_URL unless --file option is passed
40 4         13 local $@;
41 4         12 my $response = eval { $http->get($DEFAULT_URL) };
  4         20  
42 4 50 66     67 if ( $@ or not $response or $response->{status} ne HTTP_OK ) {
      66        
43 1         49 die qq{request error\n};
44             }
45              
46 3         23 alarm 0;
47              
48 3         14 my $content = $response->{content};
49              
50 3         9 my $ref = eval { JSON::XS::decode_json $content };
  3         301  
51              
52 3 50 33     23 if ( $@ or not $ref ) {
53 0         0 die qq{JSON decode error\n};
54             }
55              
56             # add accessors based on elements in returned hash ref
57 3         22 $ref = h2o -recurse, $ref;
58              
59 3         474 $self->{_obj} = $ref;
60              
61             # reset and update storms cache
62 3         18 $self->_update_storm_cache;
63              
64 3         96 return $self;
65             }
66              
67             sub active_storms {
68 4     4 1 3751 my $self = shift;
69 4         11 return [ values %{ $self->{_storms} } ];
  4         30  
70             }
71              
72             # there is no checking, if the storm is not in the cache,
73             # an undefined value is returned
74             sub get_storm_by_id {
75 2     2 1 964 my ( $self, $id ) = @_;
76 2         7 return $self->{_storms}->{$id};
77             }
78              
79             # returns storm Ids
80             sub get_storm_ids {
81 1     1 1 771 my $self = shift;
82 1         3 return [ keys %{ $self->{_storms} } ];
  1         7  
83             }
84              
85             sub _update_storm_cache {
86 3     3   7 my $self = shift;
87              
88             # purge cache
89 3         9 $self->{_storms} = {};
90              
91             REBUILD_STORMS_CACHE:
92 3         8 for my $storm ( @{ $self->{_obj}->{activeStorms} } ) {
  3         13  
93 6         36 my $s = Weather::NHC::TropicalCyclone::Storm->new($storm);
94 6         181 my $storm_id = $s->id;
95              
96             # key storm by id (e.g., al182020, etc)
97 6         57 $self->{_storms}->{$storm_id} = $s;
98             }
99              
100             }
101              
102             sub fetch_rss_atlantic {
103 3     3 0 2154612 my ( $self, $local_file ) = @_;
104 3         14 return $self->_fetch_rss( $DEFAULT_RSS_ATLANTIC, $local_file );
105             }
106              
107             sub fetch_rss_east_pacific {
108 3     3 0 7157 my ( $self, $local_file ) = @_;
109 3         16 return $self->_fetch_rss( $DEFAULT_RSS_EAST_PACIFIC, $local_file );
110             }
111              
112             sub fetch_rss_central_pacific {
113 3     3 0 6163 my ( $self, $local_file ) = @_;
114 3         15 return $self->_fetch_rss( $DEFAULT_RSS_CENTRAL_PACIFIC, $local_file );
115             }
116              
117             sub _fetch_rss {
118 9     9   38 my ( $self, $rss_url, $local_file ) = @_;
119              
120 9         406 my $http = HTTP::Tiny->new;
121              
122 9         1333 my $response = $http->get($rss_url);
123              
124 9 100       1485861 if ( not $response->{success} ) {
125 3   50     9 my $status = $response->{status} // q{Unknown};
126 3         29 die qq{Fetching of $rss_url failed. HTTP status: $status\n};
127             }
128              
129 6 100       33 if ($local_file) {
130 3 50       490 open my $fh, q{>}, $local_file or die qq{Error writing RSS file, $local_file: $!\n};
131 3         585 print $fh $response->{content};
132             }
133              
134 6         139 return $response->{content};
135             }
136              
137             1;
138              
139             __END__