Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 199 lines (144 sloc) 5.552 kb
c4adef7 @rbuels initial commit
authored
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4
5 chdir $ARGV[0] if @ARGV;
6 use POE qw(Component::IRC);
7 use Config::General;
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
8 use Hash::Util qw/ lock_hash /;
9 #use DB_File::Lock;
10
bcd3f85 @an0maly Only give +op when one has op privileges
an0maly authored
11 my %opstate;
12 my %config = read_config();
49efaa1 @rbuels commenting, tweaked configuration
authored
13 while( my ($server_addr,$server) = each %{$config{server}} ) {
b85e2de @an0maly Add ability to configure the username/ident
an0maly authored
14 my @username;
15
16 if( exists $server->{username} && defined $server->{username} ) {
17 @username = ( username => $server->{username} );
18
19 }
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
20
21 print "setting up $server_addr...\n";
22
23 # We create a new PoCo-IRC object
24 my $irc = POE::Component::IRC->spawn(
25 nick => $server->{nick},
26 ircname => $server->{description},
b85e2de @an0maly Add ability to configure the username/ident
an0maly authored
27 @username,
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
28 server => $server_addr,
29 ) or die "Oh noooo! $!";
30
31 POE::Session->create(
32 package_states => [main => [qw[ _start _default ]]],
33 inline_states => {
49efaa1 @rbuels commenting, tweaked configuration
authored
34 # on server welcome message
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
35 irc_001 => sub {
36 my $sender = $_[SENDER];
37
38 # Since this is an irc_* event, we can get the component's object by
39 # accessing the heap of the sender. Then we register and connect to the
40 # specified server.
41 my $irc = $sender->get_heap();
42
49efaa1 @rbuels commenting, tweaked configuration
authored
43 print "$server_addr: connected to ", $irc->server_name, "\n";
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
44
bcd3f85 @an0maly Only give +op when one has op privileges
an0maly authored
45 for my $channel ( keys %{ $server->{channel} } ) {
46 # flag that we don't have op yet for this channel
47 $opstate{$server_addr}{$channel}{state} = 0;
48
49 }
50
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
51 # we join our channels
52 $irc->yield( join => "#$_" ) for keys %{ $server->{channel} };
53 },
49efaa1 @rbuels commenting, tweaked configuration
authored
54 # when someone joins a channel
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
55 irc_join => sub {
56 my ( $sender, $who, $where, $what ) = @_[ SENDER, ARG0 .. ARG2 ];
49efaa1 @rbuels commenting, tweaked configuration
authored
57 # parse out the nick and channel
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
58 my $nick = ( split /!/, $who )[0];
59 my $channel = ref $where ? $where->[0] : $where;
60 $channel =~ s/^#//;
61
9410a9f @an0maly Added inline debug print routine
an0maly authored
62 _inline_debug( 'irc_mode', @_[ ARG0 .. $#_ ] );
63
bcd3f85 @an0maly Only give +op when one has op privileges
an0maly authored
64 # See if we have op privileges before we go gallivanting about
65 # attempting to give +op and ticking off the server
66
67 if( $opstate{$server_addr}{$channel}{state} ) {
68
69 # give them op if they are in the (reread) config
70 %config = read_config();
71 if( exists $config{server}{$server_addr}{channel}{$channel}{ops}{$nick} ) {
72 print "$server_addr: Gave op to $nick in #$channel.\n";
73 $irc->yield( mode => "#$channel" => '+o' => $nick );
74 }
75
76 }
77
78 },
79
80
81 irc_mode => sub {
82 my ( $who, $where, $what, $towhom ) = @_[ ARG0 .. ARG3 ];
83 my $nick = ( split /!/, $who )[0];
84 my $channel = ref $where ? $where->[0] : $where;
85 $channel =~ s/^#//;
86
9410a9f @an0maly Added inline debug print routine
an0maly authored
87 _inline_debug( 'irc_mode', @_[ ARG0 .. $#_ ] );
88
bcd3f85 @an0maly Only give +op when one has op privileges
an0maly authored
89 if( defined $towhom && $towhom eq $server->{nick} ) {
90 if( $what eq '+o' ) {
91 # I just received op privileges
92 $opstate{$server_addr}{$channel}{state} = 1;
93
94 }
95 elsif( $what eq '-o' ) {
96 $opstate{$server_addr}{$channel}{state} = 0;
97
98 }
99
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
100 }
bcd3f85 @an0maly Only give +op when one has op privileges
an0maly authored
101
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
102 },
0f28177 @an0maly Add ability to register/identify the nick
an0maly authored
103
bcd3f85 @an0maly Only give +op when one has op privileges
an0maly authored
104
0f28177 @an0maly Add ability to register/identify the nick
an0maly authored
105 irc_notice => sub {
106 my ( $sender, $what, $message ) = @_[ ARG0 .. ARG2 ];
107 my $i = 0;
108
9410a9f @an0maly Added inline debug print routine
an0maly authored
109 _inline_debug( 'irc_mode', @_[ ARG0 .. $#_ ] );
110
0f28177 @an0maly Add ability to register/identify the nick
an0maly authored
111 if( $sender =~ /NickServ/i && $message =~ /This nickname is registered/ ) {
112
113 # do we have a password for our nick for this server?
114 if( exists $config{server}{$server_addr}{password} ) {
115 # Register our nick
116 $irc->yield( privmsg => 'NickServ', "identify " . $config{server}{$server_addr}{password} );
117 return;
118
119 }
120
121 }
122
123 },
124
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
125 },
126 heap => { irc => $irc },
127 );
128 }
c4adef7 @rbuels initial commit
authored
129
130 $poe_kernel->run();
131
132 sub _start {
133 my $heap = $_[HEAP];
134
135 # retrieve our component's object from the heap where we stashed it
136 my $irc = $heap->{irc};
137 $irc->yield( register => 'all' );
138 $irc->yield( connect => {} );
139
140 return;
141 }
142
49efaa1 @rbuels commenting, tweaked configuration
authored
143 # We registered for all events, this will produce some debug info.
144 sub _default {
145 #_print_debug(@_)
c4adef7 @rbuels initial commit
authored
146 }
147
49efaa1 @rbuels commenting, tweaked configuration
authored
148 ############## HELPER SUBS ######################
149
150 sub read_config {
6bb77f4 @rbuels oops, wrong conf name
authored
151 my %h = Config::General->new('./radicalweed.conf')->getall;
49efaa1 @rbuels commenting, tweaked configuration
authored
152 lock_hash %h;
153 return %h;
154 }
c4adef7 @rbuels initial commit
authored
155
156
49efaa1 @rbuels commenting, tweaked configuration
authored
157 sub _print_debug {
c4adef7 @rbuels initial commit
authored
158 my ( $event, $args ) = @_[ ARG0 .. $#_ ];
159 my @output = ("$event: ");
1e78396 @rbuels bot version 2, changed conf format, supports multiple servers
authored
160
c4adef7 @rbuels initial commit
authored
161 for my $arg (@$args) {
162 if ( ref $arg eq 'ARRAY' ) {
163 push( @output, '[' . join( ', ', @$arg ) . ']' );
164 }
165 else {
166 push( @output, "'$arg'" );
167 }
168 }
169 print join ' ', @output, "\n";
170 return 0;
171 }
9410a9f @an0maly Added inline debug print routine
an0maly authored
172
173 sub _inline_debug {
174 my ( $event, @args ) = @_;
175
176 return 0; # disable debugging
177
178 # skip logging events we don't care about
179 return 0 if grep /^$event$/, qw( irc_ping irc_372 );
180
181 # format the rest
182 my @output = ("$event: ");
183
184 for my $arg (@args) {
185 if ( ref $arg eq 'ARRAY' ) {
186 push( @output, '[' . join( ', ', @$arg ) . ']' );
187
188 }
189 else {
190 push( @output, "'$arg'" );
191
192 }
193
194 }
195 print join ' ', @output, "\n";
196 return 0;
197
198 }
Something went wrong with that request. Please try again.