#!/usr/bin/perl
#
#
package Meteoalarm;
use strict;
use warnings;
use Carp;
use LWP;
use HTML::Entities;
use HTML::TreeBuilder;
use utf8;
binmode STDOUT, ":encoding(UTF-8)";

our $VERSION = "0.07";

my %countries = (
    'AT' => { code=>10,  name=>'AT-Austria', },
    'BA' => { code=>10,  name=>'BA_Bosnia-Herzegovina', },
    'BE' => { code=>801, name=>'BE-Belgium', },
    'BG' => { code=>28,  name=>'BG-Bulgaria', },
    'CH' => { code=>319, name=>'CH-Switzerland', },
    'CY' => { code=>1,   name=>'CY-Cyprus', },
    'CZ' => { code=>14,  name=>'CZ-Czechia', },
    'DE' => { code=>808, name=>'DE-Germany', },
    'DK' => { code=>8,   name=>'DK-Denmark', },
    'EE' => { code=>805, name=>'EE-Estonia', },
    'ES' => { code=>831, name=>'ES-Spain', },
    'FI' => { code=>813, name=>'FI-Finland', },
    'FR' => { code=>94,  name=>'FR-France', },
    'GR' => { code=>16,  name=>'GR-Greece', },
    'HR' => { code=>806, name=>'HR-Croatia', },
    'HU' => { code=>7,   name=>'HU-Hungary', },
    'IE' => { code=>804, name=>'IE-Ireland', },
    'IL' => { code=>803, name=>'IL-Israel', },
    'IS' => { code=>11,  name=>'IS-Iceland', },
    'IT' => { code=>20,  name=>'IT-Italy', },
    'LT' => { code=>801, name=>'LT-Lithuania', },
    'LU' => { code=>2,   name=>'LU-Luxemburg', },
    'LV' => { code=>804, name=>'LV-Latvia', },
    'MD' => { code=>37,  name=>'MD-Moldova', },
    'ME' => { code=>3,   name=>'ME-Montenegro', },
    'MK' => { code=>6,   name=>'MK-Former Yugoslav Republic of Macedonia', },
    'MT' => { code=>1,   name=>'MT-Malta', },
    'NL' => { code=>807, name=>'NL-Netherlands', },
    'NO' => { code=>814, name=>'NO-Norway', },
    'PL' => { code=>802, name=>'PL-Poland', },
    'PT' => { code=>26,  name=>'PT-Portugal', },
    'RO' => { code=>42,  name=>'RO-Romania', },
    'RS' => { code=>11,  name=>'RS-Serbia', },
    'SE' => { code=>813, name=>'SE-Sweden', },
    'SI' => { code=>801, name=>'SI-Slovenia', },
    'SK' => { code=>16,  name=>'SK-Slovakia', },
    'UK' => { code=>16,  name=>'UK-United-Kingdom' },
);

my %day = (
    'today' => 0,
    'tomorrow' => 1
);

my %type = (
    'all'                      => 0,
    'wind'                     => 1,
    'snow'                     => 2,
    'ice'                      => 2,
    'snow/ice'                 => 2,
    'thunderstorm'             => 3,
    'fog'                      => 4,
    'extreme high temperature' => 5,
    'extreme low temperature'  => 6,
    'coastal event'            => 7,
    'forestfire'               => 8,
    'avalanches'               => 9,
    'rain'                     => 10,
    'unnamed'                  => 11,
    'flood'                    => 12,
    'rainflood'                => 13
);

my %weather_to_text = (    # lower case for consistency
    1  => 'wind',
    2  => 'snow/ice',
    3  => 'thunderstorm',
    4  => 'fog',
    5  => 'extreme high temperature',
    6  => 'extreme low temperature',
    7  => 'coastal event',
    8  => 'forestfire',
    9  => 'avalanches',
    10 => 'rain',
    11 => 'unnamed',
    12 => 'flood',
    13 => 'rainflood'
);

my $url_base = "http://meteoalarm.eu/en_UK";

sub new {
    my $class = shift;
    my $self  = {};
    my %args  = @_;
    $self->{'user_agent'} = _make_user_agent( $args{'user_agent'} );
    bless( $self, $class );
    return $self;
}

sub countries {
    my $self = shift;
    my %args = @_;

    my $type = _get_type($args{type});
    my $day = _get_day($args{day});

    my $url = _make_country_url( $day, $type );
    my $content = $self->_fetch_content( $url );
    return _parse_country_warnings($content);
}

sub regions {
    my $self = shift;
    my %args = @_;

    croak "Invalid country_code: $args{country_code}"
      unless $args{country_code};

    my $day = _get_day($args{day});
    my $type = _get_type($args{type});
    my $country_name = _get_country_name($args{country_code});

    my $url = _make_country_url($day, $type, $country_name);

    my $content = $self->_fetch_content( $url );
    return _parse_region_warnings($content);
}

sub details {
    my $self = shift;
    my %args = @_;

    my ( $region, $code ) =
      $args{region_code} =~ /^([ABCDEFGHILMNPRSU][A-Z])(\d\d\d)/;
    $code =~ s /^0//;
    croak "Invalid region_code: $args{region_code}"
      unless ( exists $countries{$region}
        and ( $code <= $countries{$region}{code} ) );

    my $country_name = _get_country_name($region);
    my $type = _get_type($args{type});
    my $day = _get_day($args{day});

    my $url = _make_country_url($day, $type, $country_name);
    my $content = $self->_fetch_content( $url );
    return _parse_details($content);
}

sub codes {
    my $self = shift;
    my @codes;
    my @countries_short;

    if (@_) {
        @countries_short = @_;
    }
    else {
        @countries_short = _get_all_short_country_codes();
    }

    foreach my $country_short (@countries_short) {
        my $url = _make_country_url(0, 0, _get_country_name($country_short));
        my $content = $self->_fetch_content( $url );
        push @codes, _parse_codes($content);
    }
    return @codes;
}

sub _make_country_url {
    my ( $day, $type, $country_name ) = @_;

    $country_name //= 'EU-Europe';

    return "$url_base/$day/$type/$country_name.html";
}

sub _fetch_content {
    my ( $self, $url ) = @_;
    my $ua = LWP::UserAgent->new;
    $ua->agent($self->{user_agent});
    my $res = $ua->request( HTTP::Request->new( GET => $url ) );

    croak " Can't fetch http://meteoalarm.eu: $res->status_line \n"
      unless ( $res->is_success );

    return $res->decoded_content;
}

sub _parse_country_warnings {
    my $content = shift;
    my $p       = HTML::TreeBuilder->new_from_content($content);
    my (%data);

    my @cells = $p->look_down( _tag => q{td}, class => qr/^col[12]$/ );
    for my $cell (@cells) {
        my @src;
        my $div = $cell->look_down( _tag => q{div} );
        my $id  = $div->id;
        my $alt = $div->attr(q{alt});

        $data{$id}{fullname} = $alt;

        my @weather_events =
          $div->look_down( _tag => 'span', class => qr{warn awt} );
        $data{$id}{warnings} =
          _parse_weather_events( \@weather_events );

        #
        # get tendency
        #
        my $tendency = $div->look_down(
            _tag  => 'div',
            class => qr{tendenz awt nt l\d}
        );
        if ( $tendency->{class} ) {
            $tendency->{class} =~ /tendenz awt nt l(\d)/;
            $data{$id}{tendency} = $1;
        }
    }
    return \%data;
}

sub _parse_region_warnings {
    my $content = shift;
    my $p       = HTML::TreeBuilder->new_from_content($content);

    my (%data);

    my @cells = $p->look_down(_tag=>qr{div}, id=>qr{area});
    for my $cell (@cells) {
        $cell->id =~ /area_([A-Z][A-Z]\d+)/;
    my $id = $1;
    my $fullname = $cell->look_down(_tag=>'span',id=>'cname')->as_text;
        my $div = $cell->look_down( _tag => q{div} );
        $data{$id}{fullname} = $fullname;

        my @weather_events =
          $div->look_down(_tag=> 'span', class=>qr{warnflag warn2});
        $data{$id}{warnings} =
          _parse_weather_events( \@weather_events );

        #
        # get tendency
        #
        my $tendency = $div->look_down(
            _tag  => 'span',
            class => qr{tendenz awt\d l\d}
        );
        if ( $tendency->{class} ) {
            $tendency->{class} =~ /tendenz awt\d l(\d)/;
            $data{$id}{tendency} = $1;
        }
    }
    return \%data;
}

sub _parse_weather_events {
    my $events = shift;

    my %literal_warnings;
    for my $event (@$events) {
        #print $event->{class}, "\n";
        $event->{class} =~ /warn\d* awt\d l(\d+) t(\d+)/;
        my $warn_level = $1;
        my $weather    = $2;
        $literal_warnings{ $weather_to_text{$weather} } = $warn_level;
    }
    return \%literal_warnings;
}

sub _parse_details {
    my $content = shift;
    my (%data);
    my $p = HTML::TreeBuilder->new_from_content( decode_entities $content);
    $data{fullname} = $p->look_down( _tag => q{h1} )->as_text;

    if (
        $p->look_down(
            _tag  => q{div},
            class => q{warnbox awt nt l l1}
        )
      )
    {
        $data{warnings} = 'no warnings';
    }
    else {

        my @warnboxes = $p->look_down(
            _tag  => q{div},
            class => qr/warnbox awt/
        );

        for my $warnbox (@warnboxes) {

            my ($as_txt);

            my @info_divs = $warnbox->look_down(
                _tag  => q{div},
                class => q{info}
            );

            $as_txt = $info_divs[0]->as_text;

            my ( $from, $until ) = $as_txt =~ /valid from (.*) Until (.*)$/;

            $as_txt = $info_divs[1]->as_text;
            my ( $warning, $level ) =
              $as_txt =~ /(.+?)\s+Awareness Level:\s+(.*)/;
            $warning =~ s/s$//;

            my $text = $warnbox->look_down(
                _tag  => q{div},
                class => q{text}
            )->as_text;

            $data{warnings}{ lc $warning } =
              {    #lower case for constistency
                level => $level,
                from  => $from,
                until => $until,
                text  => $text,
              };
        }
    }
    return \%data;
}

sub _parse_codes {
    my $content = shift;
    my $p       = HTML::TreeBuilder->new_from_content($content);
    my (%data);

    #my @cells = $p->look_down( _tag => 'div', class => 'flags' );
    my @cells = $p->look_down( _tag => qr{a} );
    for my $cell (@cells) {
        if ( $cell->attr('xlink:href') ) {
            if ( $cell->attr('xlink:href') =~ /\/([A-Z][A-Z]\d+)-(.+?).html/ ) {
                my $code     = $1;
                my $fullname = $2;
                $data{$fullname} = $code;
            }
        }

    }
    return \%data;
}

sub _make_user_agent {
    my $ua = shift;
    $ua =
'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:55.0) Gecko/20100101 Firefox/55.0'
      unless ($ua);
    return $ua;
}

sub _extract_details_fullname {
    my $content = shift;
    my $region;
    if ( $content =~ /<h1>Weather warnings: (.+?)<\/h1>/ ) {
        $region = $1;
        decode_entities($region);
        if ( $region =~ /.??<.*<\/a>/ ) {
            $region =~ s/.??<.*<\/a>//;
        }
    }
    else {
        carp "Can't get region name\n";
    }
    return $region;
}

sub _get_day {
    my $day = shift;
    return $day{ $day // 'today' } // 0;
}

sub _get_type {
    my $type = shift;
    return $type{ $type // 'all' } // 0;
}

sub _get_all_short_country_codes {
    return sort keys %countries;
}

sub _get_country_code {
    my $region = shift;
    croak "Invalid region $region" unless exists $countries{$region};
    # $region === $countries{$region}{code} with the current data ... but who knows about future updates?
    return $countries{$region}{code};
}

sub _get_country_name {
    my $code = shift;
    croak "Invalid country_code: $code" unless $code and exists $countries{$code};
    return $countries{$code}{name};
}

1;

__END__

=head1 NAME
B<Meteoalarm> - OO Interface for meteoalarm.eu

=head1 SYNOPSIS
 
This Module gets weather warnings from meteoalarm.eu.
For further reading of terms and conditions see L<meteoalarm.eu|http://meteoalarm.eu/terms.php?lang=en_UK/>

 use Meteoalarm; 
my $meteo = Meteoalarm->new( 'user_agent' => 'Meteobot 0.001' );
my $countries = $meteo -> countries ('type' => 'all', 'day' => 'today');
foreach my $country_code (sort keys %{$countries}){
    print "Country: $countries->{$country_code}->{'fullname'}\n";
    print "Tendency = $countries->{$country_code}->{tendency}\n" if ( $countries->{$country_code}->{'tendency'});
    if (keys %{$countries->{$country_code}->{'warnings'}}){
    foreach my $warning (keys %{$countries->{$country_code}->{'warnings'}}){
            print "Event: $warning, severity: $countries->{$country_code}->{'warnings'}->{$warning}\n";
    }
}
    else {print "No Warnings\n";}
}

 my $regions = $meteo->regions( 'country_code' => 'PT', 'day' => 'today', 'type' => 'all' );
foreach my $code ( sort keys %{$regions} ) {
    print "Region : $regions->{$code}->{'fullname'}: region_code = $code\n" if ( keys %{ $regions->{$code}->{'warnings'} } );
    print "Tendency = $regions->{$code}->{tendency}\n" if ( $regions->{$code}->{'tendency'});
    foreach my $type ( keys %{ $regions->{$code}->{'warnings'} } ) {
        print
"$type Severity: $regions->{$code}->{'warnings'}->{$type}\n";
    }
}

 my $details = $meteo->details( 'region_code' => 'UK010', 'day' => 'today');
my $name = $details->{'fullname'};
print "$name\n";

if ( $details->{warnings} eq 'no warnings' ) {
    print $details->{warnings}, "\n";
}
else {
    foreach my $warning ( keys %{ $details->{'warnings'} } ) {
        print "$warning\n";
        foreach my $detail ( keys %{ $details->{'warnings'}->{$warning} } ) {
            print "$detail: $details->{'warnings'}->{$warning}->{$detail}\n";
        }
    }
}

 my $codes = $meteo->codes('FR');
my @codes = $meteo->codes();
foreach my $code (@codes) {
    foreach my $region ( sort keys %{$code} ) {
        print "Region name: $region, region code: $code->{$region}\n";
    }
}

=head1 DESCRIPTION

$meteo -> countries returns hashref of warnings for all countries.

$meteo -> regions returns hashref of warnings for all regions in a specified country

$meteo -> details returns hashref of detailled warnings for a specified region

$meteo -> codes returns arrayref of hash of name and region code of a country

=head1 METHODS

=head1
    new( )

    creates a new meteoalarm object

=head2 Optional Arguments:
        new( 'user_agent' => 'Meteobot 0.001');

        changes the user agent string

=head1
    my $country = $meteo -> countries ();

=head2 Optional Arguments:

        'day' => 'today' || 'tomorrow'
        if day is not defined, default value is today

        'type' => 'all' || 'wind' || 'snow' || 'ice' || 'snow/ice' || 'snow' || 'ice' ||
                'thunderstorm' || 'fog' || 'extreme high temperature' ||
                'extreme low temperature' || 'coastal event' || 'forestfire' ||
                'avalanches' || 'rain'

        if type is not defined, default type is all

=head1
    $regions = $meteo -> regions ('country_code' => 'DE');

    country_code is a 2 letter abbreviation

=head2 Optional arguments:

    day=> 'today' || 'tomorrow'
    if day is not defined, default value is today

=head1 $details = $meteo->details ('region_code' => 'ES005');

region_code consits of 2 letters for the country and 3 digits

=head2 Optional arguments:

    day=> 'today' || 'tomorrow'
    if day is not defined, default value is today

=head1
$code = $meteo -> codes ();

Returns arrayref of hash for region names and codes for all countries

=head2 Optional Arguments

    $code = $meteo -> codes ('PL');
    Countrycode for a specific country

=cut