2020-01-26 14:20:15 +01:00
# File: Weather.pm
#
2021-07-11 00:00:22 +02:00
# Purpose: Weather command. See Wttr.pm for a more featureful command.
2020-01-26 14:20:15 +01:00
2023-02-21 06:31:52 +01:00
# SPDX-FileCopyrightText: 2007-2023 Pragmatic Software <pragma78@gmail.com>
2021-07-11 00:00:22 +02:00
# SPDX-License-Identifier: MIT
2020-01-26 14:20:15 +01:00
2021-07-14 04:45:56 +02:00
package PBot::Plugin::Weather ;
use parent 'PBot::Plugin::Base' ;
2020-01-26 14:20:15 +01:00
2021-06-19 06:23:34 +02:00
use PBot::Imports ;
2020-01-26 14:20:15 +01:00
2021-07-24 04:22:25 +02:00
use PBot::Core::Utils::LWPUserAgentCached ;
2020-01-26 14:20:15 +01:00
use XML::LibXML ;
2023-04-14 02:01:23 +02:00
sub initialize ($self, %conf) {
2021-07-31 04:01:24 +02:00
$ self - > { pbot } - > { commands } - > add (
name = > 'weather' ,
help = > 'Provides weather service via AccuWeather' ,
subref = > sub { $ self - > cmd_weather ( @ _ ) } ,
) ;
2020-01-26 14:20:15 +01:00
}
2023-04-14 02:01:23 +02:00
sub unload ($self) {
2021-07-31 04:01:24 +02:00
$ self - > { pbot } - > { commands } - > remove ( 'weather' ) ;
2020-01-26 14:20:15 +01:00
}
2023-04-14 02:01:23 +02:00
sub cmd_weather ($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
2020-05-04 22:21:35 +02:00
my $ arguments = $ context - > { arguments } ;
2021-07-31 00:01:38 +02:00
my % opts ;
2020-02-15 23:38:32 +01:00
2021-07-31 00:01:38 +02:00
my ( $ opt_args , $ opt_error ) = $ self - > { pbot } - > { interpreter } - > getopt (
$ arguments ,
\ % opts ,
[ 'bundling' ] ,
'u=s' ,
'h' ,
2020-02-15 23:38:32 +01:00
) ;
2021-07-31 00:01:38 +02:00
return $ usage if $ opts { h } ;
return "/say $opt_error -- $usage" if defined $ opt_error ;
$ arguments = "@$opt_args" ;
my $ user_override = $ opts { u } ;
2020-02-15 23:38:32 +01:00
2020-09-03 22:33:15 +02:00
if ( defined $ user_override ) {
2021-07-09 23:39:35 +02:00
my $ userdata = $ self - > { pbot } - > { users } - > { storage } - > get_data ( $ user_override ) ;
2020-09-03 22:33:15 +02:00
return "No such user account $user_override." if not defined $ userdata ;
return "User account does not have `location` set." if not exists $ userdata - > { location } ;
$ arguments = $ userdata - > { location } ;
} else {
if ( not length $ arguments ) {
$ arguments = $ self - > { pbot } - > { users } - > get_user_metadata ( $ context - > { from } , $ context - > { hostmask } , 'location' ) // '' ;
}
}
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
}
2023-04-14 02:01:23 +02:00
sub get_weather ($self, $location) {
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
2021-07-24 04:22:25 +02:00
my $ ua = PBot::Core::Utils::LWPUserAgentCached - > new ( \ % cache_opt , timeout = > 10 ) ;
2020-02-15 23:38:32 +01:00
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
}
2023-04-14 02:01:23 +02:00
sub fix_temps ($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 ;