ikusan.pl

#!/usr/bin/env perl

use Ikusan
  'server url',
	port       => <port>,
	enable_ssl => 1,
	password   => <password>,
	nickname   => <nickname>,
	channels   => { '#channel_name' => {} };

# undef_message "およよ…";

register qr/regexp?/ => sub {
	my (%opts) = @_;
	return $opts{error} ? (1, "エラー") : (0, "オッケー");
} => qw/
	error
/;

register simple => sub {
	my (%opts) = @_;
	return $opts{error} ? 1 : 0;
} => qw/
	error
/;

register "die" => sub { die "ぱっつんぱっつん" };

use LWP::UserAgent;

register pixiv => sub {
	my $ua  = LWP::UserAgent->new;
	my $res = $ua->get("http://www.pixiv.net/");
	my @url = ($res->content =~ /"(member_illust\.php.+?)"/g);
	my $ret = "http://www.pixiv.net/" . $url[int(rand(scalar(@url)))];
	return 0, $ret;
};

register qr/サタデーナイト/ => sub {
	return 0, "フィーバー!!";
};

fever;

Ikusan.pm

package Ikusan;

use strict;
use warnings;
use utf8;

use AnySan;
use AnySan::Provider::IRC;
use Getopt::Long;
use URI::Escape;
use Encode;

sub import {
  my $cls = shift;
	my $irc = irc @_;
	my $pkg = caller(0);
	my $p = Getopt::Long::Parser->new(
		config => [qw(posix_default no_ignore_case auto_help)],
	);
	my $arg_parser = sub {
		my $arg = shift;
		$arg =~ s/"(.+?)"/uri_escape($1)/eg;
		$arg =~ s/'(.+?)'/uri_escape($1)/eg;
		my @args = map { uri_unescape($_) } grep { $_ } split(/\s+/, $arg);
		return \@args;
	};
	my $nick = $irc->{config}->{nickname};
	my @pattern = ();
	my $matcher = sub {
		my $arg = shift;
		for my $p (@pattern) {
			return $p if ($arg =~ /$p->{regexp}/);
		}
	};
	my $undef_message = "およよ…";
	no strict 'refs';
	*{"${pkg}::undef_message"} = sub { $undef_message = shift };
	*{"${pkg}::register"} = sub {
		die 'register "command_str" | qr/regexp/ => sub { ...code... } [=> qw/getopt long options/]' if (@_ < 2);
		my $regexp = shift;
		my $code   = shift;
		push @pattern, {
			regexp  => ref($regexp) eq 'Regexp' ? $regexp : qr/^$regexp$/,
			code    => $code,
			options => [@_],
		};
	};
	*{"${pkg}::fever"} = sub {
		AnySan->register_listener(
			ikusan => {
				cb => sub {
					my $receive = shift;
					if ($receive->message =~ /^$nick:\s+(.+?)(\s+.+?$|$)/) {
						my $c = decode_utf8($1);
						if (my $pattern = $matcher->($c)) {
							my $code    = $pattern->{code};
							my $options = $pattern->{options};
							my $args    = $arg_parser->($2);
							$p->getoptionsfromarray($args, \my %opts, @$options);
							my @ret; eval {
								@ret = $code->(%opts);
							};
							@ret = (1, "$@") if ($@);
							@ret = (0, "")   unless (@ret);
							my $message =
								  ($ret[0] ? "[ERR]" : "[OK]")
								. ($ret[1] ? " ".$ret[1] : "" );
							$receive->send_replay($message);
						} else {
							$receive->send_replay($undef_message);
						}
					}
				},
			},
		);
		AnySan->run;
	};
	strict->import;
	warnings->import;
	utf8->import;
}

1;