Added simple hyperlinks support & perl-config file support

README.md

@@ -16,6 +16,7 @@ Feel free to change 'time' into 'scalar localtime' in the code if you prefer hum
 ## Dependencies
 * cpan Net::Jabber
 * cpan Net::Jabber::Bot
+* cpan LWP::Protocol::https
 
 ## Files
 * src/jplbot.pl         -- main executable file.

src/config.pl

@@ -0,0 +1,22 @@
+### USER VARIABLES SECTION START #############################################
+#
+# Nick name and XMPP resource name used by bot. 
+$name = 'AimBot';
+# Path to file for karma saving routine
+$karmafile = '/tmp/karma';
+# Address of XMPP server of the bot's account
+$server = 'zhmylove.ru';
+# Port of XMPP server of the bot's account
+$port = 5222;
+# Username of bot's account on the server
+$username = 'aimbot';
+# Password for this username
+$password = 'password';
+# Interval in seconds between background_checks() calee
+$loop_sleep_time = 60;
+# Address of a conference server, where forums are expected to be
+$conference_server = 'conference.jabber.ru';
+# MUC forums (chatrooms) with their passwords
+%forum_passwords = ('ubuntulinux' => 'ubuntu');
+#
+### USER VARIABLES SECTION END   #############################################

src/jplbot.pl

@@ -8,29 +8,32 @@
 
 use Net::Jabber::Bot;
 use Storable;
+use LWP;
 
-### USER VARIABLES SECTION START #############################################
-#
-# Nick name and XMPP resource name used by bot. 
-my $name = 'AimBot';
+### DEFAULT VALUES ###
+our $name = 'AimBot';
 # Path to file for karma saving routine
-my $karmafile = '/tmp/karma';
+our $karmafile = '/tmp/karma';
 # Address of XMPP server of the bot's account
-my $server = 'zhmylove.ru';
+our $server = 'zhmylove.ru';
 # Port of XMPP server of the bot's account
-my $port = 5222;
+our $port = 5222;
 # Username of bot's account on the server
-my $username = 'aimbot';
+our $username = 'aimbot';
 # Password for this username
-my $password = 'password';
+our $password = 'password';
 # Interval in seconds between background_checks() calee
-my $loop_sleep_time = 60;
+our $loop_sleep_time = 60;
 # Address of a conference server, where forums are expected to be
-my $conference_server = 'conference.jabber.ru';
+our $conference_server = 'conference.jabber.ru';
 # MUC forums (chatrooms) with their passwords
-my %forum_passwords = ('ubuntulinux' => 'ubuntu');
-#
-### USER VARIABLES SECTION END   #############################################
+our %forum_passwords = ('ubuntulinux' => 'ubuntu');
+
+unless (my $ret = do './config.pl') {
+   warn "couldn't parse config.pl: $@" if $@;
+   warn "couldn't do config.pl: $!"    unless defined $ret;
+   warn "couldn't run config.pl"       unless $ret;
+}
 
 my $qname = quotemeta($name);
 store {}, $karmafile unless -r $karmafile;
@@ -102,6 +105,43 @@ sub new_bot_message {
             "$from: опустил карму $1 до " . $karma{lc($1)});
       }
 
+      when (m{(https?://\S+)}) {
+         my $uri = $1;
+         my $ua = LWP::UserAgent->new();
+         $ua->timeout(10);
+         $ua->env_proxy;
+         $ua->agent('Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:46.0) Gecko/20100101 Firefox/46.0');
+
+         my $response = $ua->request(
+            HTTP::Request->new(HEAD => $uri)
+         );
+
+         my %type;
+         foreach($response->header("Content-type")){
+            given ($_) {
+               when (m{^text/html}) { $type{'html'}++; }
+               when (m{^image/}) { $type{'image'}++; }
+            }
+         }
+
+         if ($type{'html'}) {
+            my $response = $ua->request(
+               HTTP::Request->new(GET => $uri)
+            );
+            my $content = $response->decoded_content;
+            $content =~ m{.*<title[^>]*>(.*?)</title.*}i;
+            $bot->SendGroupMessage($msg{'reply_to'},
+               "$from: Title: $1");
+         } elsif ($type{'image'}) {
+            $bot->SendGroupMessage($msg{'reply_to'},
+               "$from: Content-Length: " .
+               $response->header('Content-Length') . " байт.");
+         } else {
+            $bot->SendGroupMessage($msg{'reply_to'},
+               "$from: да ну нафиг это парсить...");
+         }
+      }
+
       default {
          $bot->SendGroupMessage($msg{'reply_to'},
             "$from: how about no, братиша?") if $to_me;