Changeset 2362 for lang/perl/OtohaChan

Timestamp:

12/03/07 22:24:33 (5 years ago)

Author:

yusukebe

Message:

add regexp

Files:

• lang/perl/OtohaChan/trunk/otohachan.pl (modified) (3 diffs)

lang/perl/OtohaChan/trunk/otohachan.pl

@@ -5 +5 @@
 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},
-    server   => $config->{ircserver},
-    port     => $config->{port},
-    password => $config->{password},
+    nick     => $config->{nickname} || "OtohaChan",
+    server   => $config->{ircserver} || "irc.freenode.net",
+    port     => $config->{port} || "6667",
+    password => $config->{password} || "",
 ) or die "Oh noooo! $!";
 
@@ -44 +47 @@
     my ( $kernel, $sender, $who, $where, $what ) =
       @_[ KERNEL, SENDER, ARG0, ARG1, ARG2 ];
-    $kernel->post( $sender => privmsg => $_ => "\x0314$what\x03" )
+    $kernel->post( $sender => privmsg => $_ => "\x0313$what\x03" )
       for @channels;
     undef;
@@ -53 +56 @@
       @_[ 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 => "\x0314ホットホット\x03" );
+            $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);
 }