idezawaman.pl

#!/usr/bin/env perl

=head1 NAME

idezawaman.pl - 

=head1 WHY THIS NAME?

  16:24 < Yappo> ちょっとしたツールかきたいのに良い名前が思い浮かばなくてかけてない
  16:28 < teranishi> まかせなさい
  16:29 < teranishi> idezawaman.pl

=head1 SYNOPSIS

  idezawaman.pl -s chat.freenode.net -n nickname \#channel1 \#channel2

=head1 OPTIONS

=over 4

=item -s, --server

irc server address.

=item -p, --port (default: 6667)

irc server port.

=item -k, --keyword

irc server login keyword

=item -n, --nickname

irc nickname

=back

=cut

use strict;
use warnings;

use AnyEvent::HTTP;
use AnySan;
use AnySan::Provider::IRC;
use Getopt::Long ();

my $parser = Getopt::Long::Parser->new(
    config => [ "no_ignore_case", "pass_through" ],
);

my %options;
my($irc_server, $irc_port, $irc_keyword, $irc_nickname) =
    (undef, 6667, undef, 'twitterbot');
$parser->getoptions(
    's|server=s'   => \$irc_server,
    'p|port=i'     => \$irc_port,
    'k|keyword=s'  => \$irc_keyword,
    'n|nickname=s' => \$irc_nickname,
    'h|help'       => \$options{help},
    'v|version'    => \$options{version},
);

warn 'connecting to ' . join ' ', ($irc_server, $irc_port, ($irc_keyword || ''), $irc_nickname);

my $irc = irc $irc_server,
    key      => $irc_server,
    port     => $irc_port,
    password => $irc_keyword,
    nickname => $irc_nickname,
    channels => {
        map { $_ => +{} } @ARGV,
    };

AnySan->register_listener(
    twitter => {
        cb => sub {
            my $receive = shift;
            my $message = $receive->message;
            my($user, $id) = $message =~ m{https?://twitter.com(?:/#!)?/([^/]+)/status/(\d+)} or return;

            http_get "http://twitter.com/$user/status/$id", sub {
                my($body, $headers) = @_;
                my($text) = $body =~ m{<meta content="([^"]+)" name="description" />};
                return unless $text;
                $receive->send_reply(sprintf '@%s: %s', $user, $text);
            };
        },
    },
);


AnySan->run;

__END__

=head1 AUTHOR

Kazuhiro Osawa E<lt>yappo {at} shibuya {dot} plE<gt>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut