speakerbot

speakerbot

#!/opt/perl/current/bin/perl
use v5.14;
use utf8;
use strict;
use warnings;

use AnyEvent;
use AnyEvent::HTTP;
use AnyEvent::IRC::Client;
use AnyEvent::IRC::Util qw< rfc_code_to_name >;
use Config::IniFiles;
use Data::Dump          qw< dd pp >;
use DateTime;
use DBI;
use Encode;
use Getopt::Long        qw< GetOptionsFromArray >;
use JSON::XS;
use Time::Duration::fr;


$::PROGRAM = "speakerbot";
$::VERSION = "0.31";


my %handler = (
    billy       => \&cmd_billy,
    bob         => \&cmd_bob,
    brawlhalla  => \&cmd_brawlhalla,
    gras        => \&cmd_gras,
    juin        => \&cmd_juin,
    kharnoght   => \&cmd_kharnoght,
    livestreamer=> \&cmd_livestreamer,
    pants       => \&cmd_pants,
    piege       => \&cmd_piege,
    prometheus  => \&cmd_prometheus,

    #help        => \&cmd_help,
    game        => \&cmd_topic,
    programme   => \&cmd_topic,
    time        => \&cmd_time,
    topic       => \&cmd_topic,
    uptime      => \&cmd_uptime,
);

my %last;
my %topic_log;
my %topic_now;
my $user_agent = "$::PROGRAM/$::VERSION (http://twitch.tv/speaker_bot)";
my %twitch_headers;


MAIN: {
    main(@ARGV), exit unless caller();
}


#
# main()
# ----
sub main {
    # default options
    my %options;

    # parse command line options
    GetOptionsFromArray(\@_, \%options, qw{
        config|c=s  debug!
    });

    # read configuration file
    my $config = Config::IniFiles->new(-file => $options{config});

    my @channels = grep { defined && length }
        split /, */, $config->val(irc => "channels");

    # open the bot database
    my $dbh = DBI->connect("dbi:SQLite:speaker_bot.sqlite", "", "");
    my $sth = $dbh->prepare("select channel, log from topic");
    $sth->execute;

    # load the stored topic logs
    while (my ($chan, $log) = $sth->fetchrow_array) {
        $topic_log{$chan} = [ $log ];
    }

    # make sure each channel exists in the topic table
    $sth = $dbh->prepare("insert into topic (channel, log) values (?, '')");
    $sth->execute($_) for @channels;

    # install the topic logger
    my $w = AnyEvent->timer(
        after => 2,
        interval => 60,
        cb => sub { topic_logger(@channels) }
    );

    # create the IRC client
    my $cv = AnyEvent->condvar;
    my $irc = AnyEvent::IRC::Client->new;

    $irc->reg_cb(connect => sub {
        my ($self, $err) = @_;
        die $err if $err;
        say "connected to $self->{host}:$self->{port}";
        $self->{config} = $config;
    });

    $irc->reg_cb(registered => sub { say "registered as $_[0]{nick}" });
    $irc->reg_cb(disconnect => sub { say "disconnect"; $cv->broadcast });

    if ($options{debug}) {
        $irc->reg_cb(debug_send => sub { shift; say ">>> @_" });
        $irc->reg_cb(debug_recv => sub {
            shift; say "<<< $_[0]{command} @{$_[0]{params}} "
        });
    }

    $irc->reg_cb(error => sub {
        my ($self, $code, $message, $ircmsg) = @_;
        say "error $code (", rfc_code_to_name($code), ") $message";
        #$cv->broadcast;
    });

    $irc->reg_cb(publicmsg => \&handle_public_msg);
    $irc->reg_cb(privmsg => \&handle_priv_msg);

    $irc->ctcp_auto_reply(VERSION => [VERSION => "$::PROGRAM:$::VERSION:Perl"]);
    $irc->ctcp_auto_reply(PING => sub { [ PING => $_[4] ] });

    for my $chan (@channels) {
        $irc->send_srv(JOIN => "#$chan");
    }

    $irc->connect(
        $config->val(irc => "host"),
        $config->val(irc => "port", 6667),
        {
            nick => $config->val(irc => "nick", $::PROGRAM),
            real => $config->val(irc => "real", "Speaker_Bot"),
            password => $config->val(irc => "pass"),
        }
    );

    %twitch_headers = (
        "User-Agent"        => $user_agent,
        "X-Requested-With"  => "XMLHttpRequest",
        "Client-ID"         => $config->val(api => "oauth"),
        "Accept"            => "application/vnd.twitchtv.v5+json",
    );

    $cv->wait;
}


#
# handle_public_msg()
# -----------------
sub handle_public_msg {
    my ($self, $channel, $ircmsg) = @_;
    my $msg = $ircmsg->{params}[1];
    #say "public <<< [$channel] $msg";

    # parse input text
    if ($msg =~ /^\s*!([a-zA-Z]+)(?: +(.+))?\s*$/) {
        # in case of a known command, extract arguments..
        my $cmd  = lc $1;
        my @args = grep { defined && length } split /\s+/, $2 // "";
        (my $requested = lc join "", @args) =~ s/\W//g;

        # prevent users from spamming a command
        $last{"$channel:$cmd"} //= 0;
        return if $last{"$channel:$cmd"} > time - 20;

        # callback for crafting the answer
        my $cb = sub {
            return unless $_[0];
            my ($msg) = @_;
            my $bytes = encode_utf8 $msg->{text};
            say "public >>> [$channel] $bytes";
            $self->send_chan($channel, "PRIVMSG", $channel, $bytes);
        };

        # .. and execute it
        if ($handler{$cmd}) {
            eval { $handler{$cmd}->($self, $cb, $channel, @args) };
            warn "exec error: $@" if $@;
            $last{"$channel:$cmd"} = time;
        }
    }
}


#
# handle_priv_msg()
# ---------------
# Note: as far as I can tell, there are no private channels on Twitch;
#       /w is handled by another way
#
sub handle_priv_msg {
    my ($self, $nick, $ircmsg) = @_;
    my $msg = $ircmsg->{params}[1];
    say "priv <<< [$nick] $msg";

    # ...
}


#
# cmd_help()
# --------
sub cmd_help {
    my ($self, $cb, $chan, @args) = @_;
    my $help = "commandes reconnues : " . join ", ", map "!$_", keys %handler;
    $cb->({ text => $help });
}


#
# cmd_billy()
# ---------
sub cmd_billy {
    my ($self, $cb, $chan, @args) = @_;
    my $text = "« j'm'appelle pas Billy, mais Stan »";
    $cb->({ text => $text });
}


#
# cmd_bob()
# --------
sub cmd_bob {
    my ($self, $cb, $chan, @args) = @_;
    my $text = "« tu permets qu'j't'appelle Bob ? »";
    $cb->({ text => $text });
}


#
# cmd_brawlhalla()
# --------------
sub cmd_brawlhalla {
    my ($self, $cb, $chan, @args) = @_;
    my $text = "Brawlhalla, c'est un jeu qui se joue à 8 joueurs en ligne, "
        . "et à la fin, c'est Rusty_Wasp qui gagne :)";
    $cb->({ text => $text });
}


#
# cmd_gras()
# --------
sub cmd_gras {
    my ($self, $cb, $chan, @args) = @_;
    my $text = "le gras, c'est la vie.";
    $cb->({ text => $text });
}


#
# cmd_juin()
# --------
sub cmd_juin {
    my ($self, $cb, $chan, @args) = @_;
    if ($chan eq "#akwartz") {
        my $text = "Choca rentre en France en juin, et il n'aura plus le "
		 . "temps de faire des streams ni des vidéos. Aujourd'hui "
                 . "est le dernier stream.";
        $cb->({ text => $text });
    }
}


#
# cmd_kharnoght()
# --------------
sub cmd_kharnoght {
    my ($self, $cb, $chan, @args) = @_;
    my $text = "c'est la faute à Kharnoght Kappa";
    $cb->({ text => $text });
}


#
# cmd_livestreamer()
# ----------------
sub cmd_livestreamer {
    my ($self, $cb, $chan, @args) = @_;
    my $text = "Livestreamer ( docs.livestreamer.io ), pour regarder le "
             . "stream sans navigateur web";
    $cb->({ text => $text });
}


#
# cmd_pants()
# ---------
sub cmd_pants {
    my ($self, $cb, $chan, @args) = @_;
    my @texts = (
        "BUCKLE YOUR PANTS! BUCKLE YOUR PANTS!",
        "PULL UP YOUR SOCKS AND DANCE!",
        "BUCK- BUCK- BUCK- BUCK- BUCKLE YOUR PANTS!!",
        "BUCKLE YOUR PANTS OR THEY MIGHT FALL DOWN!",
        "BUCKLE YOUR PANTS OR YOUR PANTS WILL FALL TO THE GROUND!",
        "BUCKLE YOUR PANTS! BUCKLE YOUR PANTS!",
    );
    my $text = $texts[int rand scalar @texts];
    $cb->({ text => $text });
}


#
# cmd_piege()
# ---------
sub cmd_piege {
    my ($self, $cb, $chan, @args) = @_;
    my $text = "« viens par ici, c'est pas un piège… et par là, je veux "
             . "dire que c'est complètement un piège »";
    $cb->({ text => $text });
}


#
# cmd_prometheus()
# --------------
sub cmd_prometheus {
    my ($self, $cb, $chan, @args) = @_;
    my @texts = (
        "ce film si mauvais qu'il n'est même plus drôle de s'en moquer",
        "ce film dans lequel un cartographe se perd…",
        "« t'as appris à t'enfuir dans Prometheus toi ? »",
    );
    my $text = $texts[int rand scalar @texts];
    $cb->({ text => $text });
}


#
# cmd_time()
# --------
sub cmd_time {
    my ($self, $cb, $chan, @args) = @_;

    my $tz = $args[0] // "Europe/Paris";
    my $dt = DateTime->now(time_zone => $tz);
    $cb->({ text => $dt->ymd . " " . $dt->hms . " $tz" });
}


#
# cmd_topic()
# ---------
sub cmd_topic {
    my ($self, $cb, $chan, @args) = @_;

    $chan = $args[0] if $args[0];
    $chan =~ s/^#//;

    my $msg;
    $msg .= "en cours : $topic_now{$chan} " if $topic_now{$chan};
    my @games = eval { @{$topic_log{$chan}} } ;
    my $games = join ", ", @games;
    $msg .= " | " if $msg and $games;
    $msg .= "déjà passés : $games" if $games;
    $cb->({ text => $msg }) if $msg;
}


#
# cmd_uptime()
# ----------
sub cmd_uptime {
    my ($self, $cb, $chan, @args) = @_;

    $chan = $args[0] if $args[0];
    $chan =~ s/^#//;
    say "cmd uptime: chan=$chan";

    http_request
        GET => "https://api.twitch.tv/kraken/streams/$chan",
        headers => {
            %twitch_headers,
        },
        sub {
            my ($body, $headers) = @_;
            my $struct = eval { decode_json($body // "{}") } // {};
            say "cmd uptime: ", pp $struct;
            return unless $struct->{stream}{created_at};

            my ($date, $time)  = split /[TZ]/, $struct->{stream}{created_at}, 3;
            my ($dy, $dm, $dd) = split /-/, $date;
            my ($th, $tm, $ts) = split /:/, $time;
            my $started = DateTime->new(
                year => $dy, month => $dm, day => $dd,
                hour => $th, minute => $tm, second => $ts,
                time_zone => "UTC",
            );

            my $now = DateTime->now(time_zone => "UTC");
            my $dur = duration($now->epoch - $started->epoch);
            $cb->({ text => "stream en cours depuis $dur" });
        }
}


#
# topic_logger()
# ------------
sub topic_logger {
    my (@channels) = @_;

    for my $chan (@channels) {
        $chan =~ s/^#//;

        http_request
            GET => "https://api.twitch.tv/kraken/streams/$chan",
            headers => {
                %twitch_headers,
            },
            sub {
                my ($body, $headers) = @_;
                my $struct = eval { decode_json($body // "{}") } // {};

                if ($struct->{stream}) {
                    # channel is online
                    my $curr = $struct->{stream}{game} // "";
                    $topic_now{$chan} //= "";

                    if ($curr and $curr ne $topic_now{$chan}) {
                        # game has changed since last check
                        $topic_log{$chan} //= [];
                        push @{ $topic_log{$chan} }, $topic_now{$chan}
                            if $topic_now{$chan};
                        $topic_now{$chan} = $curr;
                        store_topic_log($chan, join ", ", @{$topic_log{$chan}});
                        dd \%topic_log;
                    }
                }
                else {
                    # channel is offline
                    $topic_now{$chan} = "";
                    $topic_log{$chan} = [];
                }
            }
    }
}


#
# store_topic_log()
# ---------------
sub store_topic_log {
    my ($channel, $topic_log) = @_;

    my $dbh = DBI->connect("dbi:SQLite:speaker_bot.sqlite", "", "");
    my $sth = $dbh->prepare("update topic set log = ? where channel = ?");
    $sth->execute($topic_log, $channel);
}

speakerbot.conf

[irc]
host = irc.twitch.tv
pass = oauth:<secret>
nick = speaker_bot
real = Speaker_Bot - by maddingue
channels = speaker_bot, maddingue, akwartz, ramenos

[api]
oauth     = <secret>
client_id = <secret>