2020-01-26 14:20:15 +01:00
# File: Weather.pm
# Author: pragma-
#
# Purpose: Weather command.
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::Weather ;
2020-02-09 04:48:05 +01:00
use parent 'Plugins::Plugin' ;
2020-01-26 14:20:15 +01:00
2020-02-09 04:48:05 +01:00
use warnings ; use strict ;
2020-01-26 14:20:15 +01:00
use feature 'unicode_strings' ;
2020-01-31 06:17:58 +01:00
use PBot::Utils::LWPUserAgentCached ;
2020-01-26 14:20:15 +01:00
use XML::LibXML ;
2020-01-29 21:02:08 +01:00
use Getopt::Long qw( GetOptionsFromString ) ;
2020-01-26 14:20:15 +01:00
sub initialize {
my ( $ self , % conf ) = @ _ ;
$ self - > { pbot } - > { commands } - > register ( sub { $ self - > weathercmd ( @ _ ) } , "weather" , 0 ) ;
}
sub unload {
my $ self = shift ;
$ self - > { pbot } - > { commands } - > unregister ( "weather" ) ;
}
sub weathercmd {
my ( $ self , $ from , $ nick , $ user , $ host , $ arguments , $ stuff ) = @ _ ;
2020-01-29 21:04:30 +01:00
my $ usage = "Usage: weather [-u <user account>] [location]" ;
2020-01-29 21:02:08 +01:00
my $ getopt_error ;
local $ SIG { __WARN__ } = sub {
$ getopt_error = shift ;
chomp $ getopt_error ;
} ;
2020-02-10 22:35:46 +01:00
Getopt::Long:: Configure ( "bundling" ) ;
2020-01-29 21:02:08 +01:00
my ( $ user_override , $ show_usage ) ;
my ( $ ret , $ args ) = GetOptionsFromString ( $ arguments ,
'u=s' = > \ $ user_override ,
'h' = > \ $ show_usage
) ;
return $ usage if $ show_usage ;
return "/say $getopt_error -- $usage" if defined $ getopt_error ;
$ arguments = "@$args" ;
my $ hostmask = defined $ user_override ? $ user_override : "$nick!$user\@$host" ;
2020-02-10 23:31:28 +01:00
my $ location_override = $ self - > { pbot } - > { users } - > get_user_metadata ( $ from , $ hostmask , 'location' ) // '' ;
2020-01-26 14:20:15 +01:00
$ arguments = $ location_override if not length $ arguments ;
2020-01-29 21:02:08 +01:00
if ( defined $ user_override and not length $ location_override ) {
2020-01-29 21:40:17 +01:00
return "No location set or user account does not exist." ;
2020-01-29 21:02:08 +01:00
}
2020-01-26 14:20:15 +01:00
if ( not length $ arguments ) {
2020-01-29 21:02:08 +01:00
return $ usage ;
2020-01-26 14:20:15 +01:00
}
2020-01-29 18:40:36 +01:00
return $ self - > get_weather ( $ arguments ) ;
2020-01-26 14:20:15 +01:00
}
sub get_weather {
my ( $ self , $ location ) = @ _ ;
my % cache_opt = (
'namespace' = > 'accuweather' ,
'default_expires_in' = > 3600
) ;
2020-01-31 06:17:58 +01:00
my $ ua = PBot::Utils::LWPUserAgentCached - > new ( \ % cache_opt , timeout = > 10 ) ;
2020-01-26 14:20:15 +01:00
my $ response = $ ua - > get ( "http://rss.accuweather.com/rss/liveweather_rss.asp?metric=0&locCode=$location" ) ;
my $ xml ;
if ( $ response - > is_success ) {
$ xml = $ response - > decoded_content ;
} else {
2020-01-29 19:07:30 +01:00
return "Failed to fetch weather data: " . $ response - > status_line ;
2020-01-26 14:20:15 +01:00
}
my $ dom = XML::LibXML - > load_xml ( string = > $ xml ) ;
my $ result = '' ;
foreach my $ channel ( $ dom - > findnodes ( '//channel' ) ) {
my $ title = $ channel - > findvalue ( './title' ) ;
my $ description = $ channel - > findvalue ( './description' ) ;
if ( $ description eq 'Invalid Location' ) {
return "Location $location not found. Use \"<city>, <country abbrev>\" (e.g. \"paris, fr\") or a US Zip Code or \"<city>, <state abbrev>, US\" (e.g., \"austin, tx, us\")." ;
}
$ title =~ s/ - AccuW.*$// ;
$ result . = "Weather for $title: " ;
}
foreach my $ item ( $ dom - > findnodes ( '//item' ) ) {
my $ title = $ item - > findvalue ( './title' ) ;
my $ description = $ item - > findvalue ( './description' ) ;
if ( $ title =~ m/^Currently:/ ) {
$ title = $ self - > fix_temps ( $ title ) ;
$ result . = "$title; " ;
}
if ( $ title =~ m/Forecast$/ ) {
$ description =~ s/ <img.*$// ;
$ description = $ self - > fix_temps ( $ description ) ;
$ result . = "Forecast: $description" ;
last ;
}
}
return $ result ;
}
sub fix_temps {
my ( $ self , $ text ) = @ _ ;
2020-01-26 15:01:45 +01:00
$ text =~ s | ( - ? \ d + ) \ s * F | my $ f = $ 1 ; my $ c = ( $ f - 32 ) * 5 / 9; $c = sprintf("%.1d", $c); "${f}F/ $ { c } C " | eg ;
2020-01-26 14:20:15 +01:00
return $ text ;
}
1 ;