File Coverage

blib/lib/Mojo/SlackRTM.pm

Criterion	Covered	Total	%
statement	24	145	16.5
branch	0	32	0.0
condition	0	15	0.0
subroutine	8	27	29.6
pod	13	13	100.0
total	45	232	19.4

package Mojo::SlackRTM;
use Mojo::Base 'Mojo::EventEmitter';

use IO::Socket::SSL;
use Mojo::IOLoop;
use Mojo::JSON ();
use Mojo::Log;
use Mojo::UserAgent;
use Scalar::Util ();

use constant DEBUG => $ENV{MOJO_SLACKRTM_DEBUG};

our $VERSION = '0.03';

has ioloop => sub { Mojo::IOLoop->singleton };
has ua => sub { Mojo::UserAgent->new };
has log => sub { Mojo::Log->new };
has "token";
has "pinger";
has 'ws';
has 'auto_reconnect' => 1;

our $SLACK_URL = "https://slack.com/api";

sub _dump {
    shift;
    require Data::Dumper;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Indent = 1;
    local $Data::Dumper::Terse = 1;
    my $dump = Data::Dumper::Dumper(@_);
    if (-t STDOUT) {
        warn "  \e[33m$_\e[m\n" for split /\n/, $dump;
    } else {
        warn "  $_\n" for split /\n/, $dump;
    }
}

my $TX_ERROR = sub {
    my $tx = shift;
    return if $tx->success and $tx->res->json("/ok");
    if ($tx->success) {
        my $error = $tx->res->json("/error") || "Unknown error";
        return $error;
    } else {
        my $error = $tx->error;
        return $error->{code} ? "$error->{code} $error->{message}" : $error->{message};
    }
};

sub metadata {
    my $self = shift;
    return $self->{_metadata} unless @_;
    my $metadata = shift;
    $self->{_metadata} = $metadata;
    unless ($metadata) {
        $self->{$_} = undef for qw(_users _channels);
        return;
    }
    $self->{_users}    = [
        +{ map { ($_->{id}, $_->{name}) } @{$metadata->{users}} },
        +{ map { ($_->{name}, $_->{id}) } @{$metadata->{users}} },
    ];
    $self->{_channels} = [
        +{ map { ($_->{id}, $_->{name}) } @{$metadata->{channels}} },
        +{ map { ($_->{name}, $_->{id}) } @{$metadata->{channels}} },
    ];
    $metadata;
}
sub next_id {
    my $self = shift;
    $self->{_id} //= 0;
    ++$self->{_id};
}

sub start {
    my $self = shift;
    $self->connect;
    $self->ioloop->start unless $self->ioloop->is_running;
}

sub connect {
    my $self = shift;
    my $token = $self->token or die "Missing token";
    my $tx = $self->ua->get("$SLACK_URL/rtm.start?token=$token");
    if (my $error = $TX_ERROR->($tx)) {
        $self->log->fatal("failed to get $SLACK_URL/rtm.start?token=XXX: $error");
        return;
    }
    my $metadata = $tx->res->json;
    $self->metadata($metadata);
    my $url = $metadata->{url};
    $self->ua->websocket($url => sub {
        my ($ua, $ws) = @_;
        unless ($ws->is_websocket) {
            $self->log->fatal("$url does not return websocket connection");
            return;
        }
        $self->ws($ws);
        $self->pinger( $self->ioloop->recurring(10 => sub { $self->ping }) );
        $self->ws->on(json => sub {
            my ($ws, $event) = @_;
            $self->_handle_event($event);
        });
        $self->ws->on(finish => sub {
            my ($ws) = @_;
            $self->log->warn("detect 'finish' event");
            $self->finish;
            $self->connect if $self->auto_reconnect;
        });
    });
}

sub finish {
    my $self = shift;
    $self->ws->finish if $self->ws;
    $self->_clear;
}

sub reconnect {
    my $self = shift;
    $self->finish;
    $self->connect;
}

sub _clear {
    my $self = shift;
    if (my $pinger = $self->pinger) {
        $self->ioloop->remove($pinger);
        $self->pinger(undef);
    }
    $self->ws(undef);
    $self->metadata(undef);
    $self->{_id} = 0;
}

sub _handle_event {
    my ($self, $event) = @_;
    if (my $type = $event->{type}) {
        if ($type eq "message" and defined(my $reply_to = $event->{reply_to})) {
            DEBUG and $self->log->debug("===> skip 'message' event with reply_to $reply_to");
            DEBUG and $self->_dump($event);
            return;
        }
        DEBUG and $self->log->debug("===> emit '$type' event");
        DEBUG and $self->_dump($event);
        $self->emit($type, $event);
    } else {
        DEBUG and $self->log->debug("===> got event without 'type'");
        DEBUG and $self->_dump($event);
    }
}

sub ping {
    my $self = shift;
    my $hash = {id => $self->next_id, type => "ping"};
    DEBUG and $self->log->debug("===> emit 'ping' event");
    DEBUG and $self->_dump($hash);
    $self->ws->send({json => $hash});
}

sub find_channel_id {
    my ($self, $name) = @_;
    $self->{_channels}[1]{$name};
}
sub find_channel_name {
    my ($self, $id) = @_;
    $self->{_channels}[0]{$id};
}
sub find_user_id {
    my ($self, $name) = @_;
    $self->{_users}[1]{$name};
}
sub find_user_name {
    my ($self, $id) = @_;
    $self->{_users}[0]{$id};
}

sub send_message {
    my ($self, $channel, $text, %option) = @_;
    my $hash = {
        id => $self->next_id,
        type => "message",
        channel => $channel,
        text => $text,
        %option,
    };
    DEBUG and $self->log->debug("===> send message");
    DEBUG and $self->_dump($hash);
    $self->ws->send({json => $hash});
}

sub call_api {
    my ($self, $method) = (shift, shift);
    my ($param, $cb);
    if (@_ and ref $_[-1] eq "CODE") {
        $cb    = pop;
        $param = shift;
    } else {
        $param = shift;
    }
    $param ||= +{};
    $cb ||= sub {
        my ($slack, $tx) = @_;
        if (my $error = $TX_ERROR->($tx)) {
            $slack->log->warn("$method: $error");
        }
    };

    # Data structures like "attachments" need to be serialized to JSON
    for my $key (keys %$param) {
        if (ref $param->{$key} && !Scalar::Util::blessed($param->{$key})) {
            $param->{$key} = Mojo::JSON::to_json($param->{$key});
        }
    }

    $param->{token} = $self->token unless exists $param->{token};

    DEBUG and $self->log->debug("===> call api '$method'");
    DEBUG and $self->_dump( $param );
    my $url = "$SLACK_URL/$method";
    $self->ua->post($url => form => $param => sub {
        (undef, my $tx) = @_;
        $cb->($self, $tx);
    });
}

1;
__END__