my %day = ( 'today' => 0, 'tomorrow' => 1 );
####
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} };
}
####
$passed_params{type} = $type{ $passed_params{type} // 'all' }//0;
####
$passed_params{day} = _get_day($passed_params{day});
. . .
func(..., $passed_params{day}, ...);
####
#!/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.06";
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 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 =~ /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 - OO Interface for meteoalarm.eu
=head1 SYNOPSIS
This Module gets weather warnings from meteoalarm.eu.
For further reading of terms and conditions see 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