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-15 23:38:32 +01:00
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-02-16 23:13:41 +01:00
use Getopt::Long qw( GetOptionsFromArray ) ;
2020-01-26 14:20:15 +01:00
sub initialize {
2020-02-15 23:38:32 +01:00
my ( $ self , % conf ) = @ _ ;
2020-05-04 22:21:35 +02:00
$ self - > { pbot } - > { commands } - > register ( sub { $ self - > cmd_weather ( @ _ ) } , "weather" , 0 ) ;
2020-01-26 14:20:15 +01:00
}
sub unload {
2020-02-15 23:38:32 +01:00
my $ self = shift ;
$ self - > { pbot } - > { commands } - > unregister ( "weather" ) ;
2020-01-26 14:20:15 +01:00
}
2020-05-04 22:21:35 +02:00
sub cmd_weather {
my ( $ self , $ context ) = @ _ ;
2020-05-20 23:19:10 +02:00
my $ usage = "Usage: weather (<location> | -u <user account>)" ;
2020-02-15 23:38:32 +01:00
my $ getopt_error ;
local $ SIG { __WARN__ } = sub {
$ getopt_error = shift ;
chomp $ getopt_error ;
} ;
2020-05-04 22:21:35 +02:00
my $ arguments = $ context - > { arguments } ;
2020-02-15 23:38:32 +01:00
Getopt::Long:: Configure ( "bundling" ) ;
my ( $ user_override , $ show_usage ) ;
2020-02-16 23:13:41 +01:00
my @ opt_args = $ self - > { pbot } - > { interpreter } - > split_line ( $ arguments , strip_quotes = > 1 ) ;
GetOptionsFromArray (
\ @ opt_args ,
2020-02-15 23:38:32 +01:00
'u=s' = > \ $ user_override ,
'h' = > \ $ show_usage
) ;
return $ usage if $ show_usage ;
return "/say $getopt_error -- $usage" if defined $ getopt_error ;
2020-02-16 23:13:41 +01:00
$ arguments = "@opt_args" ;
2020-02-15 23:38:32 +01:00
2020-05-04 22:21:35 +02:00
my $ hostmask = defined $ user_override ? $ user_override : $ context - > { hostmask } ;
my $ location_override = $ self - > { pbot } - > { users } - > get_user_metadata ( $ context - > { from } , $ hostmask , 'location' ) // '' ;
2020-02-15 23:38:32 +01:00
$ arguments = $ location_override if not length $ arguments ;
2020-08-03 19:36:20 +02:00
if ( defined $ user_override and not length $ location_override ) { return "No location set or user account does not exist. They may use the `my` command to set the `location` user metadata their user account." ; }
2020-02-15 23:38:32 +01:00
if ( not length $ arguments ) { return $ usage ; }
return $ self - > get_weather ( $ arguments ) ;
2020-01-26 14:20:15 +01:00
}
sub get_weather {
2020-02-15 23:38:32 +01:00
my ( $ self , $ location ) = @ _ ;
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
my % cache_opt = (
'namespace' = > 'accuweather' ,
'default_expires_in' = > 3600
) ;
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
my $ ua = PBot::Utils::LWPUserAgentCached - > new ( \ % cache_opt , timeout = > 10 ) ;
my $ response = $ ua - > get ( "http://rss.accuweather.com/rss/liveweather_rss.asp?metric=0&locCode=$location" ) ;
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
my $ xml ;
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
if ( $ response - > is_success ) { $ xml = $ response - > decoded_content ; }
else { return "Failed to fetch weather data: " . $ response - > status_line ; }
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
my $ dom = XML::LibXML - > load_xml ( string = > $ xml ) ;
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
my $ result = '' ;
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
foreach my $ channel ( $ dom - > findnodes ( '//channel' ) ) {
my $ title = $ channel - > findvalue ( './title' ) ;
my $ description = $ channel - > findvalue ( './description' ) ;
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
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\")." ;
}
2020-01-26 14:20:15 +01:00
2020-02-15 23:38:32 +01:00
$ title =~ s/ - AccuW.*$// ;
$ result . = "Weather for $title: " ;
2020-01-26 14:20:15 +01:00
}
2020-02-15 23:38:32 +01:00
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 ;
}
2020-01-26 14:20:15 +01:00
}
2020-02-15 23:38:32 +01:00
return $ result ;
2020-01-26 14:20:15 +01:00
}
sub fix_temps {
2020-02-15 23:38:32 +01:00
my ( $ self , $ text ) = @ _ ;
2020-04-28 23:54:36 +02:00
$ text =~ s | ( - ? \ d + ) \ s * F | my $ f = $ 1 ; my $ c = ( $ f - 32 ) * 5 / 9; $c = sprintf("%.1d", $c); "${c}C/ $ { f } F " | eg ;
2020-02-15 23:38:32 +01:00
return $ text ;
2020-01-26 14:20:15 +01:00
}
1 ;