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

Revision 2362, 3.1 kB (checked in by yusukebe, 7 years ago)

add regexp

Line 
1#/usr/bin/perl
2
3use strict;
4use warnings;
5use POE qw(Component::IRC);
6use YAML;
7use IO::File;
8
9my $config = YAML::LoadFile("config.yaml");
10my @channels = @{$config->{channels}};
11my $regexp_filename = "regexp.yaml";
12my $regexp_patterns = YAML::LoadFile($regexp_filename);
13
14my $irc = POE::Component::IRC->spawn(
15    nick     => $config->{nickname} || "OtohaChan",
16    server   => $config->{ircserver} || "irc.freenode.net",
17    port     => $config->{port} || "6667",
18    password => $config->{password} || "",
19) or die "Oh noooo! $!";
20
21POE::Session->create(
22    package_states =>
23      [ 'main' => [qw(_default _start irc_001 irc_msg irc_public)], ],
24    heap => { irc => $irc },
25);
26
27$poe_kernel->run();
28exit 0;
29
30sub _start {
31    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
32    my $irc_session = $heap->{irc}->session_id();
33    $kernel->post( $irc_session => register => 'all' );
34    $kernel->post( $irc_session => connect => {} );
35    undef;
36}
37
38sub irc_001 {
39    my ( $kernel, $sender ) = @_[ KERNEL, SENDER ];
40    my $poco_object = $sender->get_heap();
41    print "Connected to ", $poco_object->server_name(), "\n";
42    $kernel->post( $sender => join => $_ ) for @channels;
43    undef;
44}
45
46sub irc_msg {
47    my ( $kernel, $sender, $who, $where, $what ) =
48      @_[ KERNEL, SENDER, ARG0, ARG1, ARG2 ];
49    $kernel->post( $sender => privmsg => $_ => "\x0313$what\x03" )
50      for @channels;
51    undef;
52}
53
54sub irc_public {
55    my ( $kernel, $sender, $who, $where, $what ) =
56      @_[ KERNEL, SENDER, ARG0, ARG1, ARG2 ];
57    my $nick = ( split /!/, $who )[0];
58
59    my $channel = $where->[0];
60    if ( $what =~ /^oregexp (.*) (.*)/ ) {
61        _regexp_regist($2,$1);
62    }
63    if ( $what =~ /OtohaChan/i ) {
64        $kernel->post(
65            $sender => privmsg => $channel => "\x0313ホットホット\x03" );
66    }
67    my $str = _regexp_conv($what);
68    $kernel->post(
69                  $sender => privmsg => $channel => "\x0313$str\x03") if $str;
70
71    undef;
72}
73
74sub _regexp_conv {
75    my ($str) = @_;
76    foreach my $pattern (@$regexp_patterns) {
77        if ( $str =~ /$pattern->{match}/ ) {
78            $str =~ s/$pattern->{match}/$pattern->{after}/;
79            return $str;
80        }
81    }
82    return 0;
83}
84
85sub _regexp_regist {
86    my ($match, $after) = @_;
87    return if grep { $_->{match} eq $match } @$regexp_patterns;
88    my $io = IO::File->new($regexp_filename, "a");
89    print $io Dump([{ match=> $match, after=> $after}]);
90    $io->close;
91    $regexp_patterns = YAML::LoadFile($regexp_filename);
92}
93
94sub _regexp_unregist {
95    my ($match) = @_;
96    my @new_patterns;
97    foreach (grep { $_->{match} ne $match } @$regexp_patterns){
98        push(@new_patterns, $_);
99    }
100    my $io = IO::File->new($regexp_filename, "w");
101    print $io Dump( @new_patterns );
102    $io->close;
103    $regexp_patterns = YAML::LoadFile($regexp_filename);
104}
105
106sub _default {
107    my ( $event, $args ) = @_[ ARG0 .. $#_ ];
108    my @output = ("$event: ");
109    foreach my $arg (@$args) {
110        if ( ref($arg) eq 'ARRAY' ) {
111            push( @output, "[" . join( " ,", @$arg ) . "]" );
112        }
113        else {
114            push( @output, "'$arg'" );
115        }
116    }
117    print STDOUT join ' ', @output, "\n";
118    return 0;
119}
Note: See TracBrowser for help on using the browser.