#!/usr/bin/perl -w

# version 3

# thanks to mrw for requesting and implementing
# command-line-changeable tag and sig files, and complete/random
# results on searches.  thanks to drc for suggestions and backtick
# code.

# contributors:
# rfb ( http://www.rfbooth.com/ )
# mrw (  http://www.altrion.org/ )
# drc ( http://www.cantrell.org.uk/david/ )

use strict ;
use Getopt::Long;
use Pod::Usage;

my $workingdir = "$ENV{HOME}/.sigmonster" ;
my $tags = "${workingdir}/tags";
my $sigs = "${workingdir}/sigs";
my $rc = "${workingdir}/rc";
my $rand = 2;
my $list = 0;
my $help = "";
my $quotesep = "" ;
my $quote = "" ;
my $backticks = 0 ;

GetOptions( 'help' => \$help,
            'workdir' => \$workingdir,
	    'tags=s' => \$tags,
	    'sigs=s' => \$sigs,
	    'rc=s' => \$rc,
            'random!' => \$rand,
            'list' => \$list,
            'backticks' => $backticks
	  );

pod2usage(1) if $help;

if ($rand == 2) {
    $rand = (@ARGV) ? 0 : 1;
}

if ( open(RCFILE, "$rc") ) {
    while (<RCFILE>) {
	next if /^\#/ ;
	next if /^\s*$/ ;
	if ( /^\s*quotesep\s+("?)(.*)\1$/ ) {
	  ($quotesep = $2) =~ s/\\n/\n/g ;
	  next ;
	} elsif ( /^\s*backticks$/ ) {
	  $backticks = 1 ;
	  next ;
	}
	die "Bad line in rcfile:\n   $_\n" ;
    }
}

$/ = "%\n" ;
open (SIGFILE, "$sigs")
    or die "Can't open sigs file" ;

open (TAGFILE, "$tags")
    or die "Can't open tags file" ;

sub list_lines ;
sub get_line ;
sub match_line ;
sub spew_it ;

if ($list) {
    list_lines (\*SIGFILE, @ARGV);
    exit;
}

$quote = get_line(\*SIGFILE, @ARGV) ;
spew_it ;

#---------------------------------------------------------------------

sub list_lines 
{
    my $file = shift ;
    my @lines = ();
    while (<$file>) {
        if (match_line($_, @_)) {
            chomp;
            push @lines, $_;
        }
    }
    print join("%\n", @lines);
}

sub match_line
{
    my $line = shift;
    if (@_) {
        foreach my $match (@_) {
    	    return 0 unless $line =~ m/$match/s ;
        }
    }
    return 1;
}

sub spew_it 
{
    print get_line(\*TAGFILE).$quotesep
	unless $quote =~ s/^(NO ALTERATIONS\n|$)//s ;

    if ( $backticks ) {
      $quote=~s/`([^`]+)`/local $a=`$1`; substr($a,0,index($a, "\n"))/eg ;
    }
    print $quote ;
}

sub get_line
{
    # Lifted not a little from the Perl Cookbook, section 8.6.
    # This algorithm frankly _rocks._  Elegance.
    my $file = shift ;
    my @matches = @_ ;
    my $ln = 1; 
    my $quote = "" ;
    srand ;
    while (<$file>) {
    	if (match_line ($_, @matches)) {
            rand($ln++) < 1  && (  $quote = $_  ) ;
	    last unless $rand;
        }
    }
    chomp $quote ;
    return $quote ;
}

__END__
=head1 NAME

sigmonster (version 3)

=head1 SYNOPSIS

sigmonster [--tags file] [--sigs file] [--workdir dir] [--rc file]
      [--[no]rand] [--backticks] [--list] [word word2 ...]

finds suitable quotes (matching words)

=head1 OPTIONS

=over 8

=item B<--workdir>

Overrides default working directory - the --tags, --sigs and --rc options still
override this.

=item B<--tags>
 
Overrides default tag file (~/.sigmonster/tags)

=item B<--sigs>

Overrides default sig file (~/.sigmonster/sigs)

=item B<--rc>

Overrides default rc file (~/.sigmonster/rc)

=item B<--backticks>

Same as the backticks option in the rc file (allows you to turn it on for
one off testing).

=item B<--list>

Instead of picking a random sig, lists all quotes (matching the pattern
if one is given).

=item B<--[no]random>

Chooses whether a random signature, or the first candidate signature, is
chosen. Default (for backward compatibility with previous versions) is 
--random when there is no pattern, --norandom when there is.

=back

=head1 DESCRIPTION

Outputs a tag from the tags file, then the quotesep if you set it,
and finally a quote from the quotes file.  If the quote begins with
a line which simply reads "NO ALTERATIONS" (without the quotes),
then the tag and quotesep will be omitted.  This is in order to help
you stay McQ.

files:
  tags
  sigs
     These contain the tags and sigs files in BSD
     fortune format, which is to say separated by lines
     containing only a % character.
  rc
     Need not exist.  Contains configuration settings, of
     which the only ones are currently
       quotesep  \n
     (to give a popular value), and
       backticks
     to enable shell processing of commands in
     `backticks`.

The files should live in $workingdir, which is ~/.sigmonster unless
you change it in the source here.

Being another fine example of sloppy, half-assed Perl from rfb's house of
goodness at rfbooth.com.  (c) 2001, 2002, 2003.