File: NickReclaim.pm

package info (click to toggle)
libpoe-component-irc-perl 6.35%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 1,520 kB
  • ctags: 1,061
  • sloc: perl: 14,612; sh: 48; makefile: 5
file content (233 lines) | stat: -rw-r--r-- 6,336 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
package POE::Component::IRC::Plugin::NickReclaim;
BEGIN {
  $POE::Component::IRC::Plugin::NickReclaim::AUTHORITY = 'cpan:HINRIK';
}
BEGIN {
  $POE::Component::IRC::Plugin::NickReclaim::VERSION = '6.35';
}

use strict;
use warnings;
use Carp;
use POE::Component::IRC::Common qw(parse_user);
use POE::Component::IRC::Plugin qw(PCI_EAT_NONE);

sub new {
    my ($package) = shift;
    croak "$package requires an even number of arguments" if @_ & 1;
    my %args = @_;
    $args{ lc $_ } = delete $args{$_} for keys %args;

    if (!defined $args{poll} || $args{poll} !~ /^\d+$/) {
        $args{poll} = 30;
    }
    
    # the $irc->nick_name() and offending nickname will be...
    #...the same on start, thus won't change
    $args{_did_start} = 0;
    $args{_claims} = {};
    
    return bless \%args, $package;
}

sub PCI_register {
    my ($self, $irc) = @_;
    $irc->plugin_register( $self, 'SERVER', qw(433 001 nick quit) );
    $irc->plugin_register( $self, 'USER', qw(nick) );
    
    # we will store the original nickname so we would know...
    #...what we need to reclaim, without sending dozens of...
    #...requests to reclaim foo_, foo__, foo___ etc.
    $self->{_nick} = $irc->nick_name();
    
    return 1;
}

##############
### sub U_nick
#######
# Basically, since we store the "real" nick in $self->{_nick}
# we need to adjust it if the PoCo::IRC user wants the bot
# to change its nick via ->yield(nick => 'foo');
# problem is that the "reclaiming" process also triggers this event
# we deal with it by using $self->{_claims} which stores all the
# nick with underscores that NickReclaim appended.
#
# if we get a new "real" nick, reset the $self->{_claims}
# and store "real" nick in $self->{_nick} so we would know
# what to reclaim in case we need to.
##############
sub U_nick {
    my $self = shift;
    my ($nick) = ${ $_[1 ] } =~ /^NICK +(.+)/i;
    
    return PCI_EAT_NONE if exists $self->{_claims}{ $nick };

    # we got a new "real" nick, reset old nicks with underscores...
    #...we don't need those anymore.
    $self->{_claims} = {};
    $self->{_nick} = $nick;
    
    return PCI_EAT_NONE;
}


sub PCI_unregister {
    return 1;
}

########
## sub S_001
########
# This is basically a tiny little bit that will differentiate
# between successful reclaims and the startup routine 
# when $irc->nick_name() returns the nick which we need to reclaim
######
sub S_001 {
    $_[0]->{_did_start} = 1; 
    return PCI_EAT_NONE;
}

# ERR_NICKNAMEINUSE
sub S_433 {
    my ($self,$irc) = splice @_, 0, 2;
    
    # this is the nickname which we failed to get...
    my $offending = ${ $_[2] }->[0];
    
    # only reclaim if we don't have a nick we can use...
    #...and it's not a startup routine where ->nick_name cannot
    #...be used (and needs to be reclaimed)
    if (!$self->{_did_start} || $irc->nick_name() eq $offending) {
        # we will store the nick with the underscore in ->{_claims}...
        #...so in sub U_nick{} we would know which ones were caused...
        #...by NickReclaim and which ones need to change the "real" nick
        $offending .= '_';
        $self->{_claims}{ $offending } = 1;
        
        # we will kindly ask the server to give us the nick with an underscore...
        $irc->yield( nick => $offending );
    }

    # cancel old alarm, we won't need it anymore, considering we are going...
    #...to post a new one.
    # BingOS, is there a ->is_still_alarm() method to check if the alarm..
    #...is pending to go off? I couldn't find it in the docs, but would be
    #...nice to have (and use right here)
    $irc->delay_remove( $self->{_alarm_id} );
    $self->{_alarm_id} = $irc->delay(
        [ nick => $self->{_nick} ],
        $self->{poll}
    ); # note that we are asking the server to give us ->{_nick} which is...
    #....our "real" nick.
    
  return PCI_EAT_NONE;
}

sub S_quit {
    my ($self, $irc) = splice @_, 0, 2;
    my $who = parse_user(${ $_[0] });

    if ($who eq $self->{_nick}) {
        $irc->delay_remove( $self->{_alarm_id} );
        $irc->yield(nick => $self->{_nick});
    }

    return PCI_EAT_NONE;
}

sub S_nick {
    my ($self, $irc) = splice @_, 0, 2;
    my $old_nick = parse_user(${ $_[0] });

    if ($old_nick eq $self->{_nick}) {
        $irc->delay_remove( $self->{_alarm_id} );
        $irc->yield(nick => $self->{_nick});
    }

    return PCI_EAT_NONE;
}

1;
__END__

=encoding utf8

=head1 NAME

POE::Component::IRC::Plugin::NickReclaim - A PoCo-IRC plugin for reclaiming
your nickname

=head1 SYNOPSIS

 use strict;
 use warnings;
 use POE qw(Component::IRC Component::IRC::Plugin::NickReclaim);

 my $nickname = 'Flibble' . $$;
 my $ircname = 'Flibble the Sailor Bot';
 my $ircserver = 'irc.blahblahblah.irc';
 my $port = 6667;

 my $irc = POE::Component::IRC->spawn( 
     nick => $nickname,
     server => $ircserver,
     port => $port,
     ircname => $ircname,
 ) or die "Oh noooo! $!";

 POE::Session->create(
     package_states => [
         main => [ qw(_start) ],
     ],
 );

  $poe_kernel->run();

 sub _start {
     $irc->yield( register => 'all' );

     # Create and load our NickReclaim plugin, before we connect 
     $irc->plugin_add( 'NickReclaim' => 
         POE::Component::IRC::Plugin::NickReclaim->new( poll => 30 ) );

     $irc->yield( connect => { } );
     return;
 }

=head1 DESCRIPTION

POE::Component::IRC::Plugin::NickReclaim - A
L<POE::Component::IRC|POE::Component::IRC> plugin automagically deals with
your bot's nickname being in use and reclaims it when it becomes available
again.

It registers and handles 'irc_433' events. On receiving a 433 event it will
reset the nickname to the 'nick' specified with C<spawn> or C<connect>,
appendedwith an underscore, and then poll to try and change it to the
original nickname. If someone in your channel who has the nickname you're
after quits or changes nickname, the plugin will try to reclaim it
immediately.

=head1 METHODS

=head2 C<new>

Takes one optional argument:

B<'poll'>, the number of seconds between nick change attempts, default is 30;

Returns a plugin object suitable for feeding to
L<POE::Component::IRC|POE::Component::IRC>'s C<plugin_add> method.

=head1 AUTHOR

Chris 'BinGOs' Williams

With amendments applied by Zoffix Znet

=head1 SEE ALSO

L<POE::Component::IRC|POE::Component::IRC>

=cut