File Coverage

blib/lib/Weather/NHC/TropicalCyclone.pm

Criterion	Covered	Total	%
statement	75	79	94.9
branch	8	12	66.6
condition	8	16	50.0
subroutine	18	18	100.0
pod	5	8	62.5
total	114	133	85.7

package Weather::NHC::TropicalCyclone;

use strict;
use warnings;
use HTTP::Tiny ();
use HTTP::Status qw/:constants/;
use JSON::XS ();
use Util::H2O qw/h2o/;
use Weather::NHC::TropicalCyclone::Storm ();

our $VERSION                     = q{0.34};
our $DEFAULT_URL                 = q{https://www.nhc.noaa.gov/CurrentStorms.json};
our $DEFAULT_RSS_ATLANTIC        = q{https://www.nhc.noaa.gov/index-at.xml};
our $DEFAULT_RSS_EAST_PACIFIC    = q{https://www.nhc.noaa.gov/index-ep.xml};
our $DEFAULT_RSS_CENTRAL_PACIFIC = q{https://www.nhc.noaa.gov/index-cp.xml};
our $DEFAULT_TIMEOUT             = 10;

# container class for requesting JSON and providing
# iterator access and meta operations for the storms
# contained in the JSON returned by NHC

sub new {
    my $pkg  = shift;
    my $self = {
        _obj    => undef,
        _storms => {},
    };
    return bless $self, $pkg;
}

sub fetch {
    my ( $self, $timeout, $file ) = @_;
    my $http = HTTP::Tiny->new();

    local $SIG{ALRM} = sub { die "Request has timed out.\n" };

    alarm( $timeout // $DEFAULT_TIMEOUT );

    # get content via $DEFAULT_URL unless --file option is passed
    local $@;
    my $response = eval { $http->get($DEFAULT_URL) };
    if ( $@ or not $response or $response->{status} ne HTTP_OK ) {
        die qq{request error\n};
    }

    alarm 0;

    my $content = $response->{content};

    # if $file is provided, contents directly from the GET are
    # written
    if ($file) {
      open my $fh, q{>}, $file || die qq{Can't open '$file': $!\n};
      print $fh $content;
      close $fh;
    }

    my $ref = eval { JSON::XS::decode_json $content };

    if ( $@ or not $ref ) {
        die qq{JSON decode error\n};
    }

    # add accessors based on elements in returned hash ref
    $ref = h2o -recurse, $ref;

    $self->{_obj} = $ref;

    # reset and update storms cache
    $self->_update_storm_cache;

    return $self;
}

sub active_storms {
    my $self = shift;
    return [ values %{ $self->{_storms} } ];
}

# there is no checking, if the storm is not in the cache,
# an undefined value is returned
sub get_storm_by_id {
    my ( $self, $id ) = @_;
    return $self->{_storms}->{$id};
}

# returns storm Ids
sub get_storm_ids {
    my $self = shift;
    return [ keys %{ $self->{_storms} } ];
}

sub _update_storm_cache {
    my $self = shift;

    # purge cache
    $self->{_storms} = {};

  REBUILD_STORMS_CACHE:
    for my $storm ( @{ $self->{_obj}->{activeStorms} } ) {
        my $s        = Weather::NHC::TropicalCyclone::Storm->new($storm);
        my $storm_id = $s->id;

        # key storm by id (e.g., al182020, etc)
        $self->{_storms}->{$storm_id} = $s;
    }

}

sub fetch_rss_atlantic {
    my ( $self, $local_file ) = @_;
    return $self->_fetch_rss( $DEFAULT_RSS_ATLANTIC, $local_file );
}

sub fetch_rss_east_pacific {
    my ( $self, $local_file ) = @_;
    return $self->_fetch_rss( $DEFAULT_RSS_EAST_PACIFIC, $local_file );
}

sub fetch_rss_central_pacific {
    my ( $self, $local_file ) = @_;
    return $self->_fetch_rss( $DEFAULT_RSS_CENTRAL_PACIFIC, $local_file );
}

sub _fetch_rss {
    my ( $self, $rss_url, $local_file ) = @_;

    my $http = HTTP::Tiny->new;

    my $response = $http->get($rss_url);

    if ( not $response->{success} ) {
        my $status = $response->{status} // q{Unknown};
        die qq{Fetching of $rss_url failed. HTTP status: $status\n};
    }

    if ($local_file) {
        open my $fh, q{>}, $local_file or die qq{Error writing RSS file, $local_file: $!\n};
        print $fh $response->{content};
    }

    return $response->{content};
}

1;

__END__