yanchaのircなアレの実験に使ったコード

yancha_ircd.pl

use strict;
use warnings;
use feature 'say';
use AE;
use AnyEvent::IRC::Server;
use AnyEvent::IRC::Util;
use Getopt::Long;
use Yancha::Client;
use LWP::UserAgent;
use AnyEvent::IRC::Client;
use HTTP::Request::Common qw(POST);

$|++; # do not buffering stdout

my $irc_host    = '127.0.0.1';
my $irc_port    = 6667;
my $yancha_host = 'localhost';
my $yancha_port = 3000;

GetOptions(
    'host=i' => \$irc_host,
    'port=i' => \$irc_port,
    'yancha-port=i'  => \$yancha_port,
    'yancha-host=s'  => \$yancha_host,
);

my $ircd = AnyEvent::IRC::Server->new(
    host         => $irc_host,
    port         => $irc_port,
    'servername' => 'localhost'
);


our %user;

my $ua = LWP::UserAgent->new;

$ircd->reg_cb(
    daemon_user => sub {
        say "user:", @_;
    },
    daemon_join => sub {
        my ($irc, $nick, $chan) = @_;

        unless ( exists $user{ $nick } ) {
            my $client = Yancha::Client->new;
            $client->login(
                "http://$yancha_host:$yancha_port/" => 'login', {nick => $nick }
            );
            $client->connect;
            $client->run(sub {
                my ( $self, $socket ) = @_;
                $socket->on( 'message', sub {
                    say "message: ", $_[1];
                } );
             });

            $user{ $nick } = $client;
        }

        say "join: $nick, $chan";
    },
    daemon_part => sub {
        my ($irc, $nick, $chan) = @_;
        say "part: $nick, $chan";
    },
    daemon_topic => sub {
        my ($irc, $nick, $chan, $topic) = @_;
        say "topic: $nick, $chan, $topic";
    },
    daemon_privmsg => sub {
        my ($irc, $nick, $chan, $text) = @_;
        my $client = $user{ $nick };

        unless ( $client ) {
            say "$nick is not login.";
            return;
        }

        my $req = POST "http://$yancha_host:$yancha_port/api/post" => {
            token => $user{ $nick }->token, text => $text . " $chan"
        };
        $ua->request($req)->code;

        say "privmsg: $nick, $chan, $text";
    },
    daemon_notice => sub {
        my ($irc, $nick, $chan, $text) = @_;
        say "notice: $nick, $chan, $text";
    },
    daemon_who => sub {
        my ($irc, $nick, $chan, $text) = @_;
        say "who: ", @_;
    },
);
$ircd->run();

print "irc server is ready in irc://0:$irc_port/\n";

AE::cv->recv();