perlrocks.pl

#!/usr/bin/env perl

use strict;
use warnings;

# Use bundled libraries
use FindBin;
use lib "$FindBin::Bin/../lib";

# Mamma Mia! The cruel meatball of war has rolled onto our laps and ruined
# our white pants of peace!
use Mojo::ByteStream 'b';
use Mojo::Client;
use Mojo::JSON;
use Mojo::URL;

# Twitter (OAuth consumer key, secret, name and URLs)
my $CONSUMER_KEY    = 'bwAfJENlleO6s9TFx6LGA';
my $CONSUMER_SECRET = 'KWKm9M2G4gvAsmWcjamnyD1aTaRS03rXV7lvR4614';
my $NAME            = 'perlrocks';
my $STREAM =
  'stream.twitter.com/1/statuses/filter.json?track=mojolicious,mojo+perl';
my $TWEET = 'http://api.twitter.com/statuses/update.json';

# Google translate URL
my $TRANSLATE = 'http://ajax.googleapis.com/ajax/services/language/translate';

# IRC (server, port, channel and nick)
my $SERVER  = 'irc.perl.org';
my $PORT    = 6667;
my $CHANNEL = '#mojo';
my $NICK    = 'perlrocks';

# Access token and secret
my ($TOKEN, $SECRET) = @ARGV;
die <<"EOF" unless $TOKEN && $SECRET;
usage: $0 ACCESS_TOKEN TOKEN_SECRET
EOF

# Client
my $CLIENT = Mojo::Client->new(keep_alive_timeout => 300)->async;

# Twitter
stream();

# Loop
my $LOOP = $CLIENT->ioloop;

# IRC
my $ID;
my $IN  = b;
my $OUT = b;
irc();

# Start
$LOOP->start;

# Messages from the channel
sub dispatch {
    my ($name, $message) = @_;
    if ($message =~ /^\!tweet\s+(.*)$/) { tweet($name, $1) }
}

# Prepare IRC connection
sub irc {
    $ID = undef;
    $LOOP->connect(
        address    => $SERVER,
        port       => $PORT,
        connect_cb => sub {
            my ($self, $id) = @_;
            print "Connected to IRC server.\n";
            $ID = $id;
            $self->connection_timeout($id => 3000);
            $self->writing($id);
            $OUT->add_chunk(qq/USER $NICK "mojolicio.us" "$NICK" :$NICK\r\n/);
            $OUT->add_chunk("NICK $NICK\r\n");
            $OUT->add_chunk("JOIN $CHANNEL\r\n");
        },
        read_cb => sub {
            my ($self, $id, $chunk) = @_;
            $IN->add_chunk($chunk);
            while (my $line = $IN->get_line) {
                if ($line =~ /^\:([^\!]+).*PRIVMSG $CHANNEL \:(.*)$/) {
                    my $name    = b($1)->decode('UTF-8')->to_string;
                    my $message = b($2)->decode('UTF-8')->to_string;
                    dispatch($name, $message);
                }
                elsif ($line =~ /^PING\s+\:(\S+)/) {
                    $OUT->add_chunk("PONG $1\r\n");
                    $self->writing($id);
                }
            }
        },
        write_cb => sub {
            my ($self, $id) = @_;
            $self->not_writing($id);
            return $OUT->empty;
        },
        error_cb => sub { irc() },
        hup_cb   => sub { irc() }
    );
}

# OAuth sign transaction
sub sign {
    my $tx = shift;

    # Request
    my $req = $tx->req;

    # Parameters
    my $params = {
        oauth_consumer_key     => $CONSUMER_KEY,
        oauth_nonce            => b(time, rand 9)->sha1_sum->to_string,
        oauth_signature_method => 'HMAC-SHA1',
        oauth_timestamp        => time,
        oauth_token            => $TOKEN,
        oauth_version          => '1.0'
    };

    # Base string
    my @values = (
        $req->method,
        b($req->url->clone->query([])->to_string)->url_escape->to_string
    );
    my $p = {%{$req->params->to_hash}, %$params};
    my @pairs;
    foreach my $key (keys %$p) {
        my $values = $p->{$key};
        $values = [$values] unless ref $values eq 'ARRAY';

        foreach my $v (@$values) {
            $key = b($key)->url_escape->to_string;
            $v   = b($v)->url_escape->to_string;
            push @pairs, [$key, $v];
        }
    }
    @pairs = sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @pairs;
    my $pairs = join '&' => map { join '=' => @$_ } @pairs;
    push @values, b($pairs)->url_escape;
    my $base = join '&' => @values;

    # Signing key
    my $key = "$CONSUMER_SECRET&$SECRET";

    # Signature
    my $signature = b($base)->hmac_sha1_sum($key)->to_string;
    $signature = b(pack('H*', $signature))->b64_encode('')->to_string;
    $params->{oauth_signature} = $signature;

    # Authorization
    my $auth =
      join ',' => map { $_ . '="' . b($params->{$_})->url_escape . '"' }
      sort keys %$params;
    $req->headers->authorization("OAuth $auth");
}

# Prepare Twitter stream
sub stream {
    print "Starting Twitter stream.\n";
    my $tx = $CLIENT->build_tx(GET => $STREAM);
    $tx->res->body(
        sub {
            return unless my $json = Mojo::JSON->new->decode(pop);
            translate($json);
        }
    );
    sign($tx);
    $CLIENT->process($tx => sub { stream() });
}

# Send messages to the channel
sub talk {
    my $message = shift;
    $message = b($message)->encode('UTF-8')->to_string;
    $OUT->add_chunk("PRIVMSG $CHANNEL :$message\r\n");
    $LOOP->writing($ID) if $ID;
}

# Translate
sub translate {
    my $json = shift;
    my $name = $json->{user}->{screen_name};
    my $id   = $json->{id};
    my $url  = "http://twitter.com/$name/status/$id";
    my $lang = $json->{user}->{lang};
    print qq/New tweet from "$name" ($lang).\n/;
    my $text = $json->{text};
    $lang = '' if $lang eq 'en';
    $CLIENT->get(
        Mojo::URL->new($TRANSLATE)
          ->query([v => '1.0', q => $text, langpair => "$lang|en"]) => sub {
            my ($self, $tx) = @_;
            return unless my $json = $tx->res->json;
            my $translated = $json->{responseData}->{translatedText};
            $text = $translated if $translated;
            my $detected = $json->{responseData}->{detectedSourceLanguage};
            $lang = $detected if $detected;
            $lang = $lang ? $lang ne 'en' ? " ($lang)" : '' : '';
            talk(qq/\x{0002}Twitter:\x{000F} "$text"$lang --$name $url/);
        }
    )->process;
}

# Send a tweet
sub tweet {
    my ($name, $message) = @_;
    print qq/"$name" is sending a tweet.\n/;
    my $author = " --$name";
    my $i      = length $message;
    my $j      = 140 - ($i + length $author);
    substr $message, $j - 3, $i + 3, '...' if $j < 0;
    my $tx = $CLIENT->build_form_tx($TWEET, {status => "$message$author"});
    sign($tx);
    $CLIENT->process(
        $tx => sub {
            my ($self, $tx) = @_;
            return unless my $json = $tx->res->json;
            return unless my $id   = $json->{id};
            talk("$name: http://twitter.com/$NAME/status/$id");
        }
    );
}

1;