view release on metacpan or  search on metacpan

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

  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.

  return "No -f for you!  NEXT!" if $regex =~ /^\s*-t?f/i;

# Sanity check on $regex.  We don't want people searching for 'I', etc.
# It was most tempting to add 'HTML' and 'CGI' to the first regex, but
# I overcame the temptation...for now.  ;)

  $regex =~ s/(?:^|\b|\s)(?:\-t?qt?|I|do|how|my|what|which|who|can)\b/ /gi;

# I'm not proud of using the fearsome '.*?' here, but that leading and
# trailing whitespace MUST GO!  IT ALL MUST GO!  WE'LL MAKE ANY DEAL!
# IT'S CRAAAAAAAAAAAAAAAAAAZY MASQUE'S USED REGEX EMPORIUM!  COME ON
# DOWN!  WE'LL CLUB A SEAL TO MAKE A BETTER DEAL!  (Weird Al, UHF)++ 

  $regex =~ s/^\s*(.*?)\s*$/$1/;

# We're pretty picky about the regex.  Currently there are no helpful 
# two-letter strings in perlfaq (with the possible exception of 'do', 
# which is being filtered for other reasons) so we require the length
# to be above that, and also we only want letters of the alphabet, 
# thanks.  

  return "\'$original_regex\' isn't a good purldoc search string." 
      unless $regex =~ /^[A-Za-z ]+$/ and length $regex > 2;

  open PURLDOC, "<$target_filename"
  		or return "Sorry, guys.  I can't open perlfaq right now: $!";

# ACHTUNG!  THE FOLLOWING CODE IS WILDLY INEFFICIENT!  HAVE A CAPS LOCKY DAY.

	my $chapter;
	my $versecount;

	while (<PURLDOC>) {
		if (/^=head1 Credits/) {
			last;
		}
		if (/^=item L<(\w+\d)/) {
			$chapter = $1 and $versecount = 0
			}
		elsif (s/=item \* //) { 
			chomp;
			$versecount++;
			push(@$results, "$chapter, question $versecount: $_")
							if /$regex/i;
		}
	}

  return "No matches for keyphrase '$regex' found." unless scalar @$results;
}
1;

__END__

=head1 NAME

purldoc.pl - Interface to the Perl FAQ.

=head1 SYNOPSIS

Returns the names of questions matching the search words.

purldoc string
purldoc array

=head1 PREREQUISITES

Nothing.

=head1 PARAMETERS
    
=over 4
   
=item purldoc
    
Turns the facility on and off
    
=item purldoc_triggers
    
Regexp used to match a call to the FAQ. Should be something like
`purldoc' or `perldoc'.

=head1 PUBLIC INTERFACE

(Depends on your triggers, but generally:)
	purldoc <topic>


=head1 DESCRIPTION

This looks up the given words as parts of a question in the Perl FAQ,
and returns the top three matching questions.

=head1 AUTHORS