view release on metacpan or  search on metacpan

Amethyst/Brain/Infobot/Module/Purldoc.pm  view on Meta::CPAN

# purldoc.pl - Part of the kinder, gentler #Perl.

# Though he hates to admit it, this was written by the gent
# on EFNet #Perl known most often as Masque.  Comments to 
# masque@pound.perl.org.  This code is covered under the same
# license as the rest of infobot.

# Eternal thanks to oznoid for writing the other bits, and 
# for being a good friend to all Perldom.  We're fortunate
# to have him.

# Please note that in this version, purldoc only searches the
# question _titles_.  This is MUCH faster, and reduces the 
# amount of work that the host machine has to do.  This is
# the same way that perldoc -q does it, so don't complain
# _too_ loudly. 

# KNOWN BUGS: Still sucks in many ways.

# removed all throttling code and replaced with returning
# \n-delimited clumps rather than direct msg or say.

# 1999-Dec-12 <lenzo@cs.cmu.edu> coerced to new module format

package Amethyst::Brain::Infobot::Module::Purldoc;

use strict;
use vars qw(@ISA);
use Amethyst::Message;
use Amethyst::Brain::Infobot;

@ISA = qw(Amethyst::Brain::Infobot::Module);

my $any_bad;

sub new {
	my $class = shift ;
	return undef if $any_bad;

	my $self  = $class->SUPER::new(
					Name	=> 'Purldoc',
					Regex	=> qr/^p[ue]rldoc (.*)$/i,
					Usage	=> 'purldoc (.*)',
					Description	=> "Get related FAQ questions",
					@_
						);

	return bless $self, $class;
}

sub action {
	my ($self, $message, $what) = @_;

	my @results;

	my $output = $self->purldoc_lookup($what, \@results);

	if (@results) {
		my $reply = $self->reply_to($message, join(", ", @results));
		$reply->send;
	}
	else {
		my $reply = $self->reply_to($message, $output);
		$reply->send;
	}

	return 1;
}



# I probably don't need to pass the array to the subroutine, but
# it looks more impressive when the subroutine is all pr0totyped,
# etc., and perhaps I can distract you, the noble reader, from
# noticing the other less impressive bits of this code by putting
# in overly complicated code.  We pass the array because we're only
# using return values if the sub blows up.  Lame?  Yes.  Stupid?
# Perhaps.  Intentional?  Sure!  This is perl, it's supposed to 
# be fun.  ;)

sub purldoc_lookup ($\$\@) {
  my $self = shift ;

  my $regex            =  shift;
  my $original_regex   =  $regex;
  my $target_filename  =  'pod/perlfaq.pod';
  my $results          =  shift;

# There is most likely a much more elegant way to do this search, however
# this works, and it's 2am, so you're welcome to comment all you like either
# to /dev/null or to masque@pound.perl.com.  Patches welcome.  :]

	foreach (@INC) { 
		if (-e "$_/$target_filename") {
			$target_filename = "$_/$target_filename";
			last;
		}
	}

# We don't do -f.  -f would be crazy-long to return.  It'd be easy 
# enough to do, but it should only reply via /msg if implemented.
# Hmm...perhaps it should also be usable as 
# 'tell $who about purldoc -f $function', though that has the 
# potential for abuse.  Perhaps purl should respond '$who wants
# you to ask me about purldoc -f $function,' but that is really
# pretty lame (and likely to be ignored.)  Ah well.  Reserved for
# future use.