www.meteoalarm.eu offers data for extreme weather situations in 30 european countries. I wrote this object oriented interface to retrieve data from the website.
Although I did my best to provide valid data there can be no guarantee for the reliability of the data from the module. I wrote the module only for informational purposes and it is not meant to use it for anything critical.
#!/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 Fire
+fox/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}->{'warning
+s'}}){
print "Event: $warning, severity: $countries->{$country_co
+de}->{'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 = $co
+de\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' => 'tod
+ay');
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}->{$deta
+il}\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 spe
+cified country
$meteo -> details returns hashref of detailled warnings for a specifie
+d 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' || 'fores
+tfire' ||
'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
Update: With the detailed advice from
wfsp I changed the evaluation of the html code from regexp to HTML::Treebuilder. That allows more robust parsing of the data. There is still plenty of space for more improvements (I am not happy with
sub _parse_details{
...
).
I did not want to split the object to sub classes, so I kept the original structure of one object with a couple of methods in subs.
Update2: added
wfsp suggestion for sub _parse_details and better utf8 handling
Update3: changed sub _parse_details to process no warnings pages, changed $VERSION = 0.02
Update4: changed URL for in sub _make_country_url to correctly parse countries, changed to $VERSION = 0.03
2014-01-04 Update5: The website http://www.meteoalarm got a makeover. That made adaptations of of code necessary, changed to $VERSION = 0.04
2014-01-06 Update6: New features added, changed to $VERSION = 0.05