#!/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.05";

sub new {

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

sub countries {

    my $self          = shift;
    my %passed_params = @_;
    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
    );
    if ( !$passed_params{type} ) {
        $passed_params{type} = 0;
    }
    elsif ( !$type{ $passed_params{type} } ) {
        $passed_params{type} = 0;
    }
    else {
        $passed_params{type} = $type{ $passed_params{type} };
    }

    my %day = ( 'today' => 0, 'tomorrow' => 1 );
    if ( !$passed_params{day} ) {
        $passed_params{day} = 0;
    }
    elsif ( !$day{ $passed_params{day} } ) {
        $passed_params{day} = 0;
    }
    else {
        $passed_params{day} = $day{ $passed_params{day} };
    }

    my $url =
      _make_country_url( $passed_params{day}, $passed_params{type} );
    my $content = _fetch_content( $url, $self->{'user_agent'} );
    my $country_warnings = _parse_country_warnings($content);
    return $country_warnings;
}

sub regions {
    my ($self) = shift;
    my %passed_params = @_;

    my %day = ( 'today' => 0, 'tomorrow' => 1 );
    if ( !$passed_params{day} ) {
        $passed_params{day} = 0;
    }
    elsif ( !$day{ $passed_params{day} } ) {
        $passed_params{day} = 0;
    }
    else {
        $passed_params{day} = $day{ $passed_params{day} };
    }

    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
    );
    if ( !$passed_params{type} ) {
        $passed_params{type} = 0;
    }
    elsif ( !$type{ $passed_params{type} } ) {
        $passed_params{type} = 0;
    }
    else {
        $passed_params{type} = $type{ $passed_params{type} };
    }
    croak "Invalid country_code: $passed_params{country_code}"
      unless $passed_params{country_code};

    my $url =
        'http://www.meteoalarm.eu/en_UK/'
      . $passed_params{day} . '/'
      . $passed_params{type} . '/'
      . $passed_params{country_code} . '.html';

    my $content = _fetch_content( $url, $self->{'user_agent'} );
    my $region_warnings = _parse_region_warnings($content);
    return $region_warnings;
}

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

    my %country_codes = (
        'AT' => 10,
        'BE' => 801,
        'BG' => 28,
        'CH' => 8,
        'CY' => 1,
        'CZ' => 14,
        'DE' => 808,
        'DK' => 8,
        'EE' => 805,
        'ES' => 831,
        'FI' => 813,
        'FR' => 94,
        'GR' => 16,
        'HR' => 8,
        'HU' => 7,
        'IE' => 804,
        'IS' => 11,
        'IT' => 20,
        'LU' => 2,
        'LV' => 804,
        'ME' => 3,
        'MK' => 6,
        'MT' => 1,
        'NL' => 807,
        'NO' => 814,
        'PL' => 802,
        'PT' => 26,
        'RO' => 42,
        'RS' => 11,
        'SE' => 813,
        'SI' => 5,
        'SK' => 16,
        'UK' => 16
    );
    my ( $region, $code ) =
      $passed_params{region_code} =~
      /^([ABCDEFGHILMNPRSU][A-Z])(\d\d\d)/;
    $code =~ s /^0//;
    croak "Invalid region_code: $passed_params{region_code}"
      unless ( $country_codes{$region}
        and ( $code <= $country_codes{$region} ) );

    my $details;

    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
    );

    if ( !$passed_params{type} ) {
        $passed_params{type} = 0;
    }
    elsif ( !$type{ $passed_params{type} } ) {
        $passed_params{type} = 0;
    }
    else {
        $passed_params{type} = $type{ $passed_params{type} };
    }

    my %day = ( 'today' => 0, 'tomorrow' => 1 );
    if ( !$passed_params{day} ) {
        $passed_params{day} = 0;
    }
    elsif ( !$day{ $passed_params{day} } ) {
        $passed_params{day} = 0;
    }
    else {
        $passed_params{day} = $day{ $passed_params{day} };
    }

    my $url =
        'http://www.meteoalarm.eu/en_UK/'
      . $passed_params{day} . '/'
      . $passed_params{type} . '/'
      . $passed_params{region_code} . '.html';
    my $content = _fetch_content( $url, $self->{'user_agent'} );
    $details = _parse_details($content);
    return $details;
}

sub codes {

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

    if (@_) {
        @countries_short = @_;
    }
    else {
        @countries_short =
          qw(AT BE BG CH CY CZ DE DK EE ES FI FR GR HR HU IE IS IT LU LV ME MK MT NL NO PL PT RO RS SE SI SK UK);
    }

    foreach my $country_short (@countries_short) {
        my $url =
            'http://www.meteoalarm.eu/index2.php?country='
          . $country_short
          . '&day=0&lang=';

        my $content = _fetch_content( $url, $self->{'user_agent'} );
        push @codes, _parse_codes($content);
    }
    return @codes;
}

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

    my $url =
        'http://www.meteoalarm.eu/en_UK/'
      . $day . '/'
      . $type
      . '/EU-Europe.html';

    return $url;
}

sub _fetch_content {
    my ( $url, $user_agent ) = @_;
    my $ua = LWP::UserAgent->new;
    $ua->agent($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 => 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 @fullname =
          $div->look_down( _tag => 'span', class => 'area' )
          ->content_list;
        my $fullname = $fullname[0];
        $data{$id}{fullname} = $fullname;

        my @weather_events =
          $div->look_down( _tag => 'span', class => qr{warn2 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_weather_events {
    my $events = shift;

    my %weather_to_text = (    # lower case for constistency
        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 %literal_warnings;
    for my $event (@$events) {

        #print $event->{class}, "\n";
        $event->{class} =~ /warn\d* awt 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 => 'td', class => 'flags' );
    for my $cell (@cells) {
        my @divs =
          $cell->look_down( _tag => 'div', class => 'countrys' );
        for my $div (@divs) {
            my $id = $div->id;
            my $fullname =
              $div->look_down( _tag => 'span', class => 'area' )
              ->as_text;
            $data{$fullname} = $id;
        }
    }
    return \%data;
}

sub _make_user_agent {
    my $ua = shift;
    $ua =
'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.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;
}

1;

__END__

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

=head1 SYNOPSIS

This Module gets weather warnings from www.meteoalarm.eu.
For further reading of terms and conditions see http://www.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');
    Countycode for a specific country    

=cut



##</code><code>##

sub _parse_details{
...