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   1409 use strict;
  2         4  
  2         48  
4 2     2   8 use warnings;
  2         3  
  2         37  
5 2     2   1223 use HTTP::Tiny ();
  2         58727  
  2         55  
6 2     2   783 use HTTP::Status qw/:constants/;
  2         7713  
  2         715  
7 2     2   12 use JSON::XS ();
  2         4  
  2         43  
8 2     2   752 use Util::H2O qw/h2o/;
  2         8265  
  2         88  
9 2     2   1021 use Weather::NHC::TropicalCyclone::Storm ();
  2         5  
  2         1443  
10              
11             our $VERSION = q{0.33};
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 5284 my $pkg = shift;
24 4         14 my $self = {
25             _obj => undef,
26             _storms => {},
27             };
28 4         16 return bless $self, $pkg;
29             }
30              
31             sub fetch {
32 4     4 1 1385 my ( $self, $timeout ) = @_;
33 4         22 my $http = HTTP::Tiny->new();
34              
35 4     1   457 local $SIG{ALRM} = sub { die "Request has timed out.\n" };
  1         1000204  
36              
37 4   66     94 alarm( $timeout // $DEFAULT_TIMEOUT );
38              
39             # get content via $DEFAULT_URL unless --file option is passed
40 4         15 local $@;
41 4         9 my $response = eval { $http->get($DEFAULT_URL) };
  4         19  
42 4 50 66     79 if ( $@ or not $response or $response->{status} ne HTTP_OK ) {
      66        
43 1         44 die qq{request error\n};
44             }
45              
46 3         21 alarm 0;
47              
48 3         12 my $content = $response->{content};
49              
50 3         7 my $ref = eval { JSON::XS::decode_json $content };
  3         369  
51              
52 3 50 33     37 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         21 $ref = h2o -recurse, $ref;
58              
59 3         609 $self->{_obj} = $ref;
60              
61             # reset and update storms cache
62 3         15 $self->_update_storm_cache;
63              
64 3         60 return $self;
65             }
66              
67             sub active_storms {
68 4     4 1 5589 my $self = shift;
69 4         10 return [ values %{ $self->{_storms} } ];
  4         26  
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 788 my ( $self, $id ) = @_;
76 2         6 return $self->{_storms}->{$id};
77             }
78              
79             # returns storm Ids
80             sub get_storm_ids {
81 1     1 1 608 my $self = shift;
82 1         2 return [ keys %{ $self->{_storms} } ];
  1         6  
83             }
84              
85             sub _update_storm_cache {
86 3     3   7 my $self = shift;
87              
88             # purge cache
89 3         10 $self->{_storms} = {};
90              
91             REBUILD_STORMS_CACHE:
92 3         6 for my $storm ( @{ $self->{_obj}->{activeStorms} } ) {
  3         13  
93 6         33 my $s = Weather::NHC::TropicalCyclone::Storm->new($storm);
94 6         15126 my $storm_id = $s->id;
95              
96             # key storm by id (e.g., al182020, etc)
97 6         51 $self->{_storms}->{$storm_id} = $s;
98             }
99              
100             }
101              
102             sub fetch_rss_atlantic {
103 3     3 0 2190133 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 9204 my ( $self, $local_file ) = @_;
109 3         19 return $self->_fetch_rss( $DEFAULT_RSS_EAST_PACIFIC, $local_file );
110             }
111              
112             sub fetch_rss_central_pacific {
113 3     3 0 32600 my ( $self, $local_file ) = @_;
114 3         17 return $self->_fetch_rss( $DEFAULT_RSS_CENTRAL_PACIFIC, $local_file );
115             }
116              
117             sub _fetch_rss {
118 9     9   35 my ( $self, $rss_url, $local_file ) = @_;
119              
120 9         101 my $http = HTTP::Tiny->new;
121              
122 9         1538 my $response = $http->get($rss_url);
123              
124 9 100       960266 if ( not $response->{success} ) {
125 3   50     8 my $status = $response->{status} // q{Unknown};
126 3         24 die qq{Fetching of $rss_url failed. HTTP status: $status\n};
127             }
128              
129 6 100       46 if ($local_file) {
130 3 50       433 open my $fh, q{>}, $local_file or die qq{Error writing RSS file, $local_file: $!\n};
131 3         792 print $fh $response->{content};
132             }
133              
134 6         193 return $response->{content};
135             }
136              
137             1;
138              
139             __END__