root/lang/perl/OtohaChan/trunk/otohachan.pl @ 2362

#/usr/bin/perl

use strict;
use warnings;
use POE qw(Component::IRC);
use YAML;
use IO::File;

my $config = YAML::LoadFile("config.yaml");
my @channels = @{$config->{channels}};
my $regexp_filename = "regexp.yaml";
my $regexp_patterns = YAML::LoadFile($regexp_filename);

my $irc = POE::Component::IRC->spawn(
    nick     => $config->{nickname} || "OtohaChan",
    server   => $config->{ircserver} || "irc.freenode.net",
    port     => $config->{port} || "6667",
    password => $config->{password} || "",
) or die "Oh noooo! $!";

POE::Session->create(
    package_states =>
      [ 'main' => [qw(_default _start irc_001 irc_msg irc_public)], ],
    heap => { irc => $irc },
);

$poe_kernel->run();
exit 0;

sub _start {
    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    my $irc_session = $heap->{irc}->session_id();
    $kernel->post( $irc_session => register => 'all' );
    $kernel->post( $irc_session => connect => {} );
    undef;
}

sub irc_001 {
    my ( $kernel, $sender ) = @_[ KERNEL, SENDER ];
    my $poco_object = $sender->get_heap();
    print "Connected to ", $poco_object->server_name(), "\n";
    $kernel->post( $sender => join => $_ ) for @channels;
    undef;
}

sub irc_msg {
    my ( $kernel, $sender, $who, $where, $what ) =
      @_[ KERNEL, SENDER, ARG0, ARG1, ARG2 ];
    $kernel->post( $sender => privmsg => $_ => "\x0313$what\x03" )
      for @channels;
    undef;
}

sub irc_public {
    my ( $kernel, $sender, $who, $where, $what ) =
      @_[ KERNEL, SENDER, ARG0, ARG1, ARG2 ];
    my $nick = ( split /!/, $who )[0];

    my $channel = $where->[0];
    if ( $what =~ /^oregexp (.*) (.*)/ ) {
        _regexp_regist($2,$1);
    }
    if ( $what =~ /OtohaChan/i ) {
        $kernel->post(
            $sender => privmsg => $channel => "\x0313ホットホット\x03" );
    }
    my $str = _regexp_conv($what);
    $kernel->post(
                  $sender => privmsg => $channel => "\x0313$str\x03") if $str;

    undef;
}

sub _regexp_conv {
    my ($str) = @_;
    foreach my $pattern (@$regexp_patterns) {
        if ( $str =~ /$pattern->{match}/ ) {
            $str =~ s/$pattern->{match}/$pattern->{after}/;
            return $str;
        }
    }
    return 0;
}

sub _regexp_regist {
    my ($match, $after) = @_;
    return if grep { $_->{match} eq $match } @$regexp_patterns;
    my $io = IO::File->new($regexp_filename, "a");
    print $io Dump([{ match=> $match, after=> $after}]);
    $io->close;
    $regexp_patterns = YAML::LoadFile($regexp_filename);
}

sub _regexp_unregist {
    my ($match) = @_;
    my @new_patterns;
    foreach (grep { $_->{match} ne $match } @$regexp_patterns){
        push(@new_patterns, $_);
    }
    my $io = IO::File->new($regexp_filename, "w");
    print $io Dump( @new_patterns );
    $io->close;
    $regexp_patterns = YAML::LoadFile($regexp_filename);
}

sub _default {
    my ( $event, $args ) = @_[ ARG0 .. $#_ ];
    my @output = ("$event: ");
    foreach my $arg (@$args) {
        if ( ref($arg) eq 'ARRAY' ) {
            push( @output, "[" . join( " ,", @$arg ) . "]" );
        }
        else {
            push( @output, "'$arg'" );
        }
    }
    print STDOUT join ' ', @output, "\n";
    return 0;
}