You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
243 lines
8.0 KiB
Perl
243 lines
8.0 KiB
Perl
# 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.
|
|
|
|
sub purldoc {
|
|
my @results;
|
|
my $msg_params;
|
|
my $msg_limit = 6;
|
|
|
|
# changed this to just return the answers, mainly -- kl
|
|
($message, $msg_params) = split /;/, $message, 2;
|
|
|
|
print "got: $message\n";
|
|
|
|
my $pd_return = &purldoc_lookup($message, \@results);
|
|
return $pd_return unless @results;
|
|
|
|
my $res = '';
|
|
|
|
# removed the public/private distinction to be handled in
|
|
# the calling code -- kl
|
|
|
|
# This is one of those ideas that sounds great until you actually
|
|
# implement it. I now think the following concept sucks. Hard.
|
|
# On the off chance you disagree with me, leave it in. :]
|
|
|
|
# Complain if the user wants a specific number of all messages.
|
|
|
|
if ($msg_params =~ /\d+/ && $msg_params =~ /all/i) {
|
|
&msg($who, "Oh come now. Don't give me a number AND 'all'.");
|
|
return 'NOREPLY';
|
|
}
|
|
|
|
# Many thanks to crimson for the following join incantation.
|
|
# This is basically join() with a limit of $msg_limit items. Neat.
|
|
# I've uglified it by putting spaces in it and thus making it human
|
|
# readable. ;) The solution used lower to truncate the array to
|
|
# the message limit is somewhat more elegant, but I'm leaving this
|
|
# in comments because it's neat.
|
|
|
|
# &msg($who, join("; ",(@results[0..(@results < $msg_limit ? @results - $msg_limit : $msg_limit - 1)]))) and return unless $msg_params;
|
|
|
|
$msg_limit = $1 if $msg_params =~ /(\d+)/;
|
|
my $max_lines = getparam('purldoc_max_lines');
|
|
|
|
if ($msgType =~ /public/) {
|
|
my $max_public = getparam('purldoc_max_public');
|
|
$msg_limit = $max_public if $max_public < $max_lines;
|
|
}
|
|
|
|
# moved this down -- kl
|
|
|
|
if (getparam('purldoc') eq 'verbose') {
|
|
&msg($who, "There are " . (scalar @results - $msg_limit) . " more matches for your query. /msg me with the query to see more.");
|
|
}
|
|
|
|
# Okay, so it turns out that 'all' is a bit of a lie. It's
|
|
# more like 'all, unless X'. 30 will tie the bot up long enough,
|
|
# and people need to learn to limit their matches to some degree
|
|
# anyway. PATCHES ARE WELCOME. Yes, I'm aware the clumping code
|
|
# is total baby-talk. See earlier 'patches' comment.
|
|
|
|
# clump limit is hardcoded.
|
|
|
|
# Look what happens when you try to crossbreed style rules!
|
|
# ;] Hey, for that matter, check out the low-quality "let's pass
|
|
# the -w test" kludge! Did I mention that this whole subroutine
|
|
# was written over four days, spending no more than 10 minutes at
|
|
# a time per sitting? I'll rewrite this, but for now I just want
|
|
# to get the output working. Besides, I've got a couple of hours
|
|
# before the next code release....
|
|
|
|
# Come to think of it, we're not using -w at all. I am
|
|
# DEFINITELY going to rewrite this, so please stop laughing
|
|
# at this code now. The other subroutine is reasonably well
|
|
# written, go read that one instead.
|
|
|
|
# Thanks, lucs! $#results = $msg_limit -1 is neato. :]
|
|
$#results = $msg_limit - 1 if @results > $msg_limit;
|
|
|
|
if (defined $msg_params && $msg_params =~ /clump/i) {
|
|
my $clump;
|
|
for (0..$#results) {
|
|
$clump .= "$results[$_]; ";
|
|
if ($_ == $#results) {
|
|
$clump =~ s/; $//;
|
|
return $clump;
|
|
}
|
|
unless (($_ + 1) % 4) {
|
|
$clump =~ s/; $/.../;
|
|
$clump .= " \n";
|
|
}
|
|
}
|
|
} else {
|
|
my $res = '';
|
|
for (0..$#results) {
|
|
$res .= " \n" if $res;
|
|
$res .= $results[$_];
|
|
}
|
|
return $res;
|
|
}
|
|
}
|
|
|
|
# End sub purldoc()
|
|
|
|
# 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 $regex = shift;
|
|
my $original_regex = $regex;
|
|
my $target_filename = getparam('purldoc_override') || 'pod/perlfaq.pod';
|
|
my @search_dirs = @INC;
|
|
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. :]
|
|
|
|
unless (getparam('purldoc_override')) {
|
|
for (@search_dirs) {
|
|
$target_filename = "$_/$target_filename" and last if -e "$_/$target_filename";
|
|
}
|
|
}
|
|
|
|
# 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>) {
|
|
last if /^=head1 Credits/;
|
|
$chapter = $1 and $versecount = 0 if /^=item L<(\w+\d)/;
|
|
if (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 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'.
|
|
|
|
=back
|
|
|
|
=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
|
|
|
|
Masque <masque@pound.perl.org>
|