root/lang/perl/tiarra/trunk/module/Auto/Im.pm @ 11354

Revision 11354, 3.1 kB (checked in by topia, 7 years ago)

* support password.
* support mask.
* explain default value of format.

  • Property svn:mime-type set to text/x-perl; charset=EUC-JP
  • Property svn:eol-style set to LF
  • Property svn:keywords set to Id URL Date Rev Author
Line 
1# -----------------------------------------------------------------------------
2# $Id$
3# -----------------------------------------------------------------------------
4package Auto::Im;
5use strict;
6use warnings;
7use base qw(Module);
8use Module::Use qw(Auto::AliasDB Tools::HTTPClient);
9use Auto::AliasDB;
10use Tools::HTTPClient; # >= r11345
11use HTTP::Request::Common;
12
13sub new {
14  my ($class) = shift;
15  my $this = $class->SUPER::new(@_);
16
17  if ($this->config->secret) {
18      # signature required
19      require Digest::SHA;
20  }
21
22  my $regex = join '|', (
23      (map { "(?:$_)" } $this->config->regex_keyword('all')),
24      (map { "(?i:\Q$_\E)" } map { split /,/ } $this->config->keyword('all')),
25     );
26  eval {
27      $this->{regex} = qr/$regex/;
28  }; if ($@) {
29      $this->_runloop->notify_error($@);
30  }
31
32  return $this;
33}
34
35sub message_arrived {
36  my ($this,$msg,$sender) = @_;
37  my @result = ($msg);
38
39  # サーバーからのメッセージか?
40  if ($sender->isa('IrcIO::Server')) {
41      # PRIVMSGか?
42      if ($msg->command eq 'PRIVMSG') {
43          my $text = $msg->param(1);
44          my $full_ch_name = $msg->param(0);
45
46          if ($text =~ $this->{regex} && Mask::match_deep_chan(
47              [$this->config->mask('all')],$msg->prefix,$full_ch_name)) {
48
49              my $url = "http://im.kayac.com/api/post/" . $this->config->user;
50              my $text = Auto::AliasDB->stdreplace(
51                  $msg->prefix,
52                  $this->config->format || '[tiarra][#(channel):#(nick.now)] #(text)',
53                  $msg, $sender,
54                  channel => $full_ch_name,
55                  text => $text,
56                 );
57              my @data = (message => $text);
58              if ($this->config->secret) {
59                  push(@data, sig => Digest::SHA->new(1)
60                           ->add($text . $this->config->secret)->hexdigest);
61              } elsif ($this->config->password) {
62                  push(@data, password => $this->config->password);
63              }
64              my $runloop = $this->_runloop;
65              Tools::HTTPClient->new(
66                  Request => POST($url, \@data),
67                 )->start(
68                     Callback => sub {
69                         my $stat = shift;
70                         $runloop->notify_warn(__PACKAGE__." post failed: $stat")
71                             unless ref($stat);
72                         ## FIXME: check response (should check 'error')
73                     },
74                    );
75          }
76      }
77  }
78
79  return @result;
80}
81
821;
83
84=pod
85info: 名前が呼ばれると、その発言をim.kayac.comに送信する
86default: off
87
88# 反応する人のマスクを指定します。
89# 省略すると全員に反応します。
90mask: * *!*@*
91
92# 反応するキーワードを正規表現で指定します。
93# 複数指定したい時は複数行指定してください。
94-regex-keyword: (?i:fugahoge)
95
96# 反応するキーワードを指定します。
97# 複数指定したい時は,(コンマ)で区切るか、複数行指定してください。
98keyword: hoge
99
100# im.kayac.com に送るメッセージのフォーマットを指定します。
101# デフォルト値: [tiarra][#(channel):#(nick.now)] #(text)
102format: [tiarra][#(channel):#(nick.now)] #(text)
103
104# im.kayac.comで登録したユーザ名を入力します。
105# im.kayac.comについては http://im.kayac.com/#docs を参考にしてください。
106user: username
107
108# im.kayac.comで秘密鍵認証を選択した場合は設定してください。
109# 省略すると認証なしになります。
110-secret: some secret
111
112# im.kayac.comでパスワード認証を選択した場合は設定してください。
113# 省略すると認証なしになります。
114# secret と両方指定した場合は secret が優先されています。
115-password: some password
116
117=cut
Note: See TracBrowser for help on using the browser.