package Weather::TW::Forecast; use strict; use warnings; use utf8; use LWP::Simple; use Moose; use Moose::Util::TypeConstraints; use Mojo::DOM; use DateTime; use Carp; my %area_zh_v7 = ( 台北市 => 'Taipei_City.htm', 新北市 => 'New_Taipei_City.htm', 台中市 => 'Taichung_City.htm', 台南市 => 'Tainan_City.htm', 高雄市 => 'Kaohsiung_City.htm', 基隆北海岸 => 'Keelung_North_Coast.htm', 桃園 => 'Taoyuan.htm', 新竹 => 'Hsinchu.htm', 苗栗 => 'Miaoli.htm', 彰化 => 'Changhua.htm', 南投 => 'Nantou.htm', 雲林 => 'Yunlin.htm', 嘉義 => 'Chiayi.htm', 屏東 => 'Pingtung.htm', 恆春半島 => 'Hengchun_Peninsula.htm', 宜蘭 => 'Yilan.htm', 花蓮 => 'Hualien.htm', 台東 => 'Taitung.htm', 澎湖 => 'Penghu.htm', 金門 => 'Kinmen.htm', 馬祖 => 'Matsu.htm', ); =encoding utf8 =head1 NAME Weather::TW::Forecast - Get Taiwan forecasts =head1 SYNOPSIS use Weather::TW::Forecast; my $weather = Weather::TW::Forecast->new( location => '台北', ); foreach ($weather->short_forecasts){ say $_->start; say $_->end; # DateTime objects specify forecast time interval say $_->temperature; # Temperature string, ex: '23 ~ 25' say $_->weather; # Weather string, ex "陰短暫陣雨" say $_->confortable; # ex '舒適' say $_->rain; # probabilty to rain, 0~100% } foreach ($weather->weekly_forecasts){ say $_->day; # DateTime object say $_->temperature; # Temperature string, ex: '23 ~ 25' say $_->weather; # Weather string, ex "陰短暫陣雨" } my $hash_ref = $weather->montly_mean; say $hash_ref->{temp_high}; # Maximum temperature say $hash_ref->{temp_low}; # Mininum temperature say $hash_ref->{rain}; # Rain precipitation (mm) =head1 DESCRIPTION This module reimplement L with new web address (from V6 to V7) and new parser (use L instead of L). The methods in L will be deprecated and shiped to L. More submodules will be develop to handle obsevations and detail rain infos. L will be a abstract class to access these submodules. =head1 METHODS =head2 C my $weather = Weather::TW::Forecast->new( location => '台北', ); Construct a new Weather::TW::Forecast object. Available locations are 台北市 新北市 台中市 台南市 高雄市 基隆北海岸 桃園 新竹 苗栗 彰化 南投 雲林 嘉義 屏東 恆春半島 宜蘭 花蓮 台東 澎湖 金門 馬祖 Weather::TW::Forecast will do the fetching right after location is set. =head2 C $weather->location('台中市'); # Change location to 台中市 and do the fetching $location = $weather->location(); # Get the location string of $weather Setter and getter of location. =cut has location => ( is => 'rw', isa => enum([qw|台北市 新北市 台中市 台南市 高雄市 基隆北海岸 桃園 新竹 苗栗 彰化 南投 雲林 嘉義 屏東 恆春半島 宜蘭 花蓮 台東 澎湖 金門 馬祖|]), trigger => \&_fetch_forecast, ); =head2 C Simply return all available locations =cut sub all_locations { qw| 台北市 新北市 台中市 台南市 高雄市 基隆北海岸 桃園 新竹 苗栗 彰化 南投 雲林 嘉義 屏東 恆春半島 宜蘭 花蓮 台東 澎湖 金門 馬祖|; } =head2 C foreach ($weather->short_forecasts){ say $_->start; say $_->end; # DateTime objects specify forecast time interval say $_->temperature; # Temperature string, ex: '23 ~ 25' say $_->weather; # Weather string, ex "陰短暫陣雨" say $_->confortable; # ex '舒適' say $_->rain; # probabilty to rain, 0~100% } This method returns an array of C objects. The object owns six attributes, as shown as above. =cut has _short_forecasts => ( traits => ['Array'], is => 'bare', isa => 'ArrayRef[Weather::TW::Forecast::ShortForecast]', clearer => '_clear_short_forecast', handles => { _add_short_forecast => 'push', short_forecasts => 'elements', }, ); =head2 C foreach ($weather->weekly_forecasts){ say $_->day; # DateTime object say $_->temperature; # Temperature string, ex: '23 ~ 25' say $_->weather; # Weather string, ex "陰短暫陣雨" } Returns a sequence of L objects, the contents of the object is as same as above. =cut has _weekly => ( traits => ['Array'], is => 'bare', isa => 'ArrayRef[Weather::TW::Forecast::Weekly]', clearer => '_clear_weekly', handles => { weekly_forecasts => 'elements', _add_weekly => 'push', }, ); =head2 C my $hash_ref = $weather->montly_mean; say $hash_ref->{temp_high}; # Maximum temperature say $hash_ref->{temp_low}; # Mininum temperature say $hash_ref->{rain}; # Rain precipitation (mm) A hash references contains maximum temperature, minimun temperature, and rain precipitation (mm). =cut has monthly_mean => ( is => 'ro', isa => 'HashRef', writer => '_set_monthly_mean', ); sub _fetch_forecast { my $self=shift; my $url = 'http://www.cwb.gov.tw/V7/forecast/taiwan/'. $area_zh_v7{$self->location()}; my $content = get $url or croak "Can't fetch url $url"; my $dom = Mojo::DOM->new($content); my @titles = $dom->find('h3.CenterTitle')->each; my @tables = $dom->find('table.FcstBoxTable01')->each; my $title; my $table; # start to parse short forecasts $self->_clear_short_forecast; do { $title = shift @titles or croak "Can't get 今明預報 in $url"; $table = shift @tables; }until $title->all_text =~ qr|今明預報.+(2\d\d\d)/\d+/\d+|; my $year = $1; #get year information for DateTime $table->find('tbody > tr')->each(sub{ my $e = shift; my @tds = $e->find('td')->each; # # 今晚至明晨 11/19 18:00~11/20 06:00 # 20 ~ 23 # 陰短暫陣雨 # 舒適 # 100 % # my $time_range = $e->at('th')->all_text or croak "Can't get time range"; my $temp_range = (shift @tds)->text or croak "Can't get temperature"; my $weather = (shift @tds)->at('img')->attrs('title') or croak "Can't get weather info"; my $confortable = (shift @tds)->text or croak "Can't get confortable info"; my $rain = (shift @tds)->text or croak "Can't get rain info"; $rain=~s/\s+%\s*//; $time_range =~ qr|(\d+)/(\d+)\s(\d+):(\d+)~(\d+)/(\d+)\s(\d+):(\d+)|; $self->_add_short_forecast(Weather::TW::Forecast::ShortForecast->new( start => DateTime->new( year => $year, month => $1, day => $2, hour => $3, minute => $4, time_zone => 'Asia/Taipei'), end => DateTime->new( year => $year, month => $5, day=>$6, hour=>$7, minute=>$8, time_zone => 'Asia/Taipei'), temperature => $temp_range, weather => $weather, confortable => $confortable, rain => $rain, )); }); # end of parsing short forecasts # start parsing weekly forecasts $self->_clear_weekly; do { $title = shift @titles or croak "Can't get 1週預報 in $url"; $table = shift @tables; }until $title->all_text =~ qr|1週預報|; # skip left most th, it's 預報地區, not day info my $first_day = ($table->find('thead > tr > th')->each)[1]; $first_day->all_text =~ qr|(\d+)/(\d+)|; my $week_day = DateTime->new( year => $year, month => $1, day => $2,); $table->find('tbody > tr > td')->each(sub{ my $e = shift; my $temperature = $e->all_text or croak "Can't get temperature (weekly)"; my $weather = $e->at('img')->attrs('title') or croak "can't get weather (weekly)"; $self->_add_weekly(Weather::TW::Forecast::Weekly->new( day => $week_day, temperature => $temperature, weather => $weather, )); # use add (days=>1) can avoid bug when passing a year $week_day->add(days=>1); }); # end of parsing weekly forecasts # start parsing monthly mean do { $title = shift @titles or croak "Can't get 月平均 in $url"; $table = shift @tables; }until $title->all_text =~ qr|月平均|; my @monthly = $table->find('td')->each; $self->_set_monthly_mean({ temp_high => $monthly[0]->text, temp_low => $monthly[1]->text, rain => $monthly[2]->text, }); #end of parsing monthly mean }; package Weather::TW::Forecast::ShortForecast; use DateTime; use Moose; has start => qw|is ro isa DateTime|; has end => qw|is ro isa DateTime|; has temperature => qw|is ro isa Str|; has weather => qw|is ro isa Str|; has confortable => qw|is ro isa Str|; has rain => qw|is ro isa Int|; package Weather::TW::Forecast::Weekly; use DateTime; use Moose; has day => qw|is ro isa DateTime|; has temperature => qw|is ro isa Str|; has weather => qw|is ro isa Str|; 1; __END__