package POE::Component::IRC::Plugin::CoreList; use strict; use warnings; use Module::CoreList; use POE::Component::IRC::Plugin qw(:ALL); use vars qw($VERSION); $VERSION = '1.00'; my $cmds = qr/find|search|release|date/; sub new { my $package = shift; my %args = @_; $args{lc $_} = delete $args{$_} for keys %args; bless \%args, $package; } sub PCI_register { my ($self,$irc) = @_; $irc->plugin_register( $self, 'SERVER', qw(public msg) ); return 1; } sub PCI_unregister { return 1; } sub S_public { my ($self,$irc) = splice @_, 0 , 2; my ($nick,$userhost) = ( split /!/, ${ $_[0] } )[0..1]; my $channel = ${ $_[1] }->[0]; my $what = ${ $_[2] }; my $mynick = $irc->nick_name(); my $cmdstr = $self->{command} || ''; my ($string) = $what =~ m/^\s*\Q$mynick\E[\:\,\;\.]?\s*(.*)$/i; return PCI_EAT_NONE unless ( $string and $string =~ /^\Q$cmdstr\E\s*(?:($cmds))?\s*(.*)/io ); my ( $command, $module, @args ) = ( $1 || 'release', split /\s+/, $2 ); my $reply = _corelist( $command, $module, @args ); $irc->yield( 'privmsg', $channel, $reply ); return PCI_EAT_NONE; } sub S_msg { my ($self,$irc) = splice @_, 0 , 2; my ($nick,$userhost) = ( split /!/, ${ $_[0] } )[0..1]; my $string = ${ $_[2] }; my $cmdstr = $self->{command} || ''; return PCI_EAT_NONE unless ( $string and $string =~ /^\Q$cmdstr\E\s*(?:($cmds))?\s*(.*)/io ); my ( $command, $module, @args ) = ( $1 || 'release', split /\s+/, $2 ); my $reply = _corelist( $command, $module, @args ); $irc->yield( ( $self->{privmsg} ? 'privmsg' : 'notice' ), $nick, $reply ); return PCI_EAT_NONE; } sub _corelist { my ($command,$module,@args) = @_; # compute the reply my $reply; if ( $command =~ /^(?:find|search)$/i ) { my @modules = Module::CoreList->find_modules( qr/$module/, @args ); # shorten large response lists @modules = (@modules[0..8], '...') if @modules > 9; local $" = ', '; my $where = ( @args ? " in perl @args" : '' ); $reply = ( @modules ? "Found @modules" : "Found no module matching /$module/" ) . $where; } else { my ( $release, $patchlevel, $date ) = ( Module::CoreList->first_release($module), '', '' ); if ($release) { $patchlevel = $Module::CoreList::patchlevel{$release} ? join( "/", @{ $Module::CoreList::patchlevel{$release} } ) : ''; $date = $Module::CoreList::released{$release}; } $reply = $release ? "$module was first released with perl $release (" . ( $patchlevel ? "patchlevel $patchlevel, " : '' ) . "released on $date)" : "$module is not in the core"; } return $reply; } 1; __END__ =head1 NAME POE::Component::IRC::Plugin::CoreList - A POE::Component::IRC plugin that provides Module::CoreList goodness. =head1 SYNOPSIS use strict; use warnings; use POE qw(Component::IRC Component::IRC::Plugin::CoreList); my $nickname = 'Core' . $$; my $ircname = 'CoreList Bot'; my $ircserver = 'irc.bleh.net'; my $port = 6667; my $channel = '#IRC.pm'; my $irc = POE::Component::IRC->spawn( nick => $nickname, server => $ircserver, port => $port, ircname => $ircname, debug => 0, plugin_debug => 1, options => { trace => 0 }, ) or die "Oh noooo! $!"; POE::Session->create( package_states => [ 'main' => [ qw(_start irc_001) ], ], ); $poe_kernel->run(); exit 0; sub _start { # Create and load our CoreList plugin $irc->plugin_add( 'CoreList' => POE::Component::IRC::Plugin::CoreList->new( command => 'core' ) ); $irc->yield( register => 'all' ); $irc->yield( connect => { } ); undef; } sub irc_001 { $irc->yield( join => $channel ); undef; } =head1 DESCRIPTION POE::Component::IRC::Plugin::CoreList is a port of L to the L plugin framework. It is a frontend to the excellent L module which will let you know what modules shipped with which versions of perl, over IRC. =head1 CONSTRUCTOR =over =item C Creates a new plugin object. Takes some optional parameter: 'command', define a command that will proceed subcommands; 'privmsg', set to a true value to specify that the bot should reply with PRIVMSG instead of NOTICE to privmsgs that it receives. =back =head1 IRC USAGE The bot replies to requests in the following form: [args] =head2 Commands The bot understand the following subcommands: =over 4 =item * C =item * C < you> bot: release Test::More < bot> you: Test::More was first released with perl 5.7.3 (patchlevel perl/15039, released on 2002-03-05) If no command is given, C is the default. < you> bot: Test::More < bot> you: Test::More was first released with perl 5.7.3 (patchlevel perl/15039, released on 2002-03-05) =item * C =item * C < you> bot search Data < bot> Found Data::Dumper, Module::Build::ConfigData Perl version numbers can be passed as optional parameters to restrict the search: < you> bot: search Data 5.006 < bot> Found Data::Dumper in perl 5.006 The search never returns more than 9 replies, to avoid flooding the channel: < you> bot: find e < bot> Found AnyDBM_File, AutoLoader, B::Assembler, B::Bytecode, B::Debug, B::Deparse, B::Disassembler, B::Showlex, B::Terse, ... =back =head1 AUTHORS Chris C Williams Philippe "BooK" Bruhat, C<< >> =head1 LICENSE Copyright E Chris Williams and Philippe Bruhat. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L L