3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-25 13:29:29 +01:00
pbot/applets/map.pl
Pragmatic Software 3d97dc2c33 Rename "modules" to "applets"
"Applet" is a much better name for the external command-line
scripts and programs that can be loaded as PBot commands. They
will no longer be confused with Perl modules.

https://en.wikipedia.org/wiki/Applet
2021-11-19 18:05:50 -08:00

93 lines
1.9 KiB
Perl
Executable File
Vendored

#!/usr/bin/env perl
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
use LWP::Simple;
my ($text, $buffer, $location);
if ($#ARGV < 0) {
print "Try again. Please specify the location you would like to search for nearby cities around.\n";
die;
}
$location = join("+", @ARGV);
$location =~ s/,/%2C/;
if ($location =~ m/\+-(.*)/) {
# -arguments?
$location =~ s/\+-.*//;
}
$text = get("http://weather.yahoo.com/search/weather2?p=$location");
$location =~ s/\+/ /g;
$location =~ s/%2C/,/g;
if ($text =~ m/No match found/) {
print "$location is not a valid location for this service.\n";
die;
}
my $found = 0;
my $buf;
my $i;
if ($text =~ m/location matches\:/g) {
$buf = "Multiple locations found: ";
while ($text =~ m/<a\shref="\/forecast\/(.*?)">(.*?)<\/a>/g) {
$i = $1;
$buffer = $2;
$buffer =~ s/<b>//g;
$buffer =~ s/<\/b>//g;
$buffer =~ s/^\s+//;
$buf = $buf . "$buffer - ";
if ($location =~ m/$buffer/i) {
$text = get("http://weather.yahoo.com/forecast/$i");
$found = 1;
}
}
$buf = $buf . "please specify one of these.\n";
if (not $found) {
print $buf;
die;
}
}
my ($country, $state, $city);
$text =~ m/<a href="\/">Weather<\/a>\s>/g;
$text =~ m/<a href=.*?>(.*?)<\/a>\s>/g;
$country = $1;
if ($country eq "North America") {
$text =~ m/<a href=.*?>(.*?)<\/a>\s>/g;
$country = $1;
}
if ($country ne "Canada") {
$text =~ m/<a href=.*?>(.*?)<\/a>\s>/g;
$state = $1;
}
$text =~ m/^(.*?)<\/b><\/font>/mg;
$city = $1;
$text =~ m/Nearby.*?Locations/sgi;
print "$country, $state, $city - Nearby Locations: ";
while ($text =~ m/<a href=\"\/forecast\/.*?\.html\">(.*?)<\/a>/gi) {
$buf = $1;
$buf =~ s/<.*?>//gi;
print "$buf, ";
}
print "\n";