1package POE::Component::IRC::Plugin::CTCP; 2our $AUTHORITY = 'cpan:HINRIK'; 3$POE::Component::IRC::Plugin::CTCP::VERSION = '6.93'; 4use strict; 5use warnings FATAL => 'all'; 6use Carp; 7use POE::Component::IRC; 8use POE::Component::IRC::Plugin qw( :ALL ); 9use POSIX qw(strftime); 10 11sub new { 12 my ($package) = shift; 13 croak "$package requires an even number of arguments" if @_ & 1; 14 my %args = @_; 15 16 $args{ lc $_ } = delete $args{ $_ } for keys %args; 17 $args{eat} = 1 if !defined ( $args{eat} ) || $args{eat} eq '0'; 18 return bless \%args, $package; 19} 20 21sub PCI_register { 22 my ($self,$irc) = splice @_, 0, 2; 23 24 $self->{irc} = $irc; 25 $irc->plugin_register( $self, 'SERVER', qw(ctcp_version ctcp_clientinfo ctcp_userinfo ctcp_time ctcp_ping ctcp_source) ); 26 27 return 1; 28} 29 30sub PCI_unregister { 31 delete $_[0]->{irc}; 32 return 1; 33} 34 35## no critic (TestingAndDebugging::ProhibitNoStrict) 36sub S_ctcp_version { 37 my ($self, $irc) = splice @_, 0, 2; 38 my $nick = ( split /!/, ${ $_[0] } )[0]; 39 40 my $our_version; 41 { 42 no strict 'vars'; 43 if (defined $POE::Component::IRC::VERSION 44 && $POE::Component::IRC::VERSION ne '1, set by base.pm') { 45 $our_version = 'dev-git'; 46 } 47 else { 48 $our_version = $POE::Component::IRC::VERSION; 49 } 50 } 51 52 $irc->yield( ctcpreply => $nick => 'VERSION ' . ( defined $self->{version} 53 ? $self->{version} 54 : "POE::Component::IRC-$our_version" 55 )); 56 return PCI_EAT_CLIENT if $self->eat(); 57 return PCI_EAT_NONE; 58} 59 60sub S_ctcp_time { 61 my ($self, $irc) = splice @_, 0, 2; 62 my $nick = ( split /!/, ${ $_[0] } )[0]; 63 64 $irc->yield(ctcpreply => $nick => strftime('TIME %a, %d %b %Y %H:%M:%S %z', localtime)); 65 66 return PCI_EAT_CLIENT if $self->eat(); 67 return PCI_EAT_NONE; 68} 69 70sub S_ctcp_ping { 71 my ($self,$irc) = splice @_, 0, 2; 72 my $nick = ( split /!/, ${ $_[0] } )[0]; 73 my $timestamp = ${ $_[2] }; 74 75 $irc->yield( ctcpreply => $nick => 'PING ' . $timestamp ); 76 77 return PCI_EAT_CLIENT if $self->eat(); 78 return PCI_EAT_NONE; 79} 80 81sub S_ctcp_clientinfo { 82 my ($self, $irc) = splice @_, 0, 2; 83 my $nick = ( split /!/, ${ $_[0] } )[0]; 84 85 $irc->yield(ctcpreply => $nick => 'CLIENTINFO ' . ($self->{clientinfo} 86 ? $self->{clientinfo} 87 : 'http://search.cpan.org/perldoc?POE::Component::IRC::Plugin::CTCP' 88 )); 89 90 return PCI_EAT_CLIENT if $self->eat(); 91 return PCI_EAT_NONE; 92} 93 94sub S_ctcp_userinfo { 95 my ($self, $irc) = splice @_, 0, 2; 96 my $nick = ( split /!/, ${ $_[0] } )[0]; 97 98 $irc->yield( ctcpreply => $nick => 'USERINFO ' . ( $self->{userinfo} ? $self->{userinfo} : 'm33p' ) ); 99 100 return PCI_EAT_CLIENT if $self->eat(); 101 return PCI_EAT_NONE; 102} 103 104sub S_ctcp_source { 105 my ($self, $irc) = splice @_, 0, 2; 106 my $nick = ( split /!/, ${ $_[0] } )[0]; 107 108 $irc->yield( ctcpreply => $nick => 'SOURCE ' . ($self->{source} 109 ? $self->{source} 110 : 'http://search.cpan.org/dist/POE-Component-IRC' 111 )); 112 113 return PCI_EAT_CLIENT if $self->eat(); 114 return PCI_EAT_NONE; 115} 116 117sub eat { 118 my $self = shift; 119 my $value = shift; 120 121 return $self->{eat} if !defined $value; 122 return $self->{eat} = $value; 123} 124 1251; 126 127=encoding utf8 128 129=head1 NAME 130 131POE::Component::IRC::Plugin::CTCP - A PoCo-IRC plugin that auto-responds to CTCP requests 132 133=head1 SYNOPSIS 134 135 use strict; 136 use warnings; 137 use POE qw(Component::IRC Component::IRC::Plugin::CTCP); 138 139 my $nickname = 'Flibble' . $$; 140 my $ircname = 'Flibble the Sailor Bot'; 141 my $ircserver = 'irc.blahblahblah.irc'; 142 my $port = 6667; 143 144 my $irc = POE::Component::IRC->spawn( 145 nick => $nickname, 146 server => $ircserver, 147 port => $port, 148 ircname => $ircname, 149 ) or die "Oh noooo! $!"; 150 151 POE::Session->create( 152 package_states => [ 153 main => [ qw(_start) ], 154 ], 155 ); 156 157 $poe_kernel->run(); 158 159 sub _start { 160 # Create and load our CTCP plugin 161 $irc->plugin_add( 'CTCP' => POE::Component::IRC::Plugin::CTCP->new( 162 version => $ircname, 163 userinfo => $ircname, 164 )); 165 166 $irc->yield( register => 'all' ); 167 $irc->yield( connect => { } ); 168 return: 169 } 170 171=head1 DESCRIPTION 172 173POE::Component::IRC::Plugin::CTCP is a L<POE::Component::IRC|POE::Component::IRC> 174plugin. It watches for C<irc_ctcp_version>, C<irc_ctcp_userinfo>, 175C<irc_ctcp_ping>, C<irc_ctcp_time> and C<irc_ctcp_source> events and 176autoresponds on your behalf. 177 178=head1 METHODS 179 180=head2 C<new> 181 182Takes a number of optional arguments: 183 184B<'version'>, a string to send in response to C<irc_ctcp_version>. Default is 185PoCo-IRC and version; 186 187B<'clientinfo'>, a string to send in response to C<irc_ctcp_clientinfo>. 188Default is L<http://search.cpan.org/perldoc?POE::Component::IRC::Plugin::CTCP>. 189 190B<'userinfo'>, a string to send in response to C<irc_ctcp_userinfo>. Default 191is 'm33p'; 192 193B<'source'>, a string to send in response to C<irc_ctcp_source>. Default is 194L<http://search.cpan.org/dist/POE-Component-IRC>. 195 196B<'eat'>, by default the plugin uses PCI_EAT_CLIENT, set this to 0 to disable 197this behaviour; 198 199Returns a plugin object suitable for feeding to 200L<POE::Component::IRC|POE::Component::IRC>'s C<plugin_add> method. 201 202=head2 C<eat> 203 204With no arguments, returns true or false on whether the plugin is "eating" CTCP 205events that it has dealt with. An argument will set "eating" to on or off 206appropriately, depending on whether the value is true or false. 207 208=head1 AUTHOR 209 210Chris 'BinGOs' Williams 211 212=head1 SEE ALSO 213 214CTCP Specification L<http://www.irchelp.org/irchelp/rfc/ctcpspec.html>. 215 216=cut 217