#! /usr/bin/perl -w
# -*- perl -*-

# Todo list that will never be done:
# - implement .dat files

eval 'case $# in 0) exec /usr/bin/perl -S "$0";; *) exec /usr/bin/perl -S "$0" "$@";; esac'
    if 0;

use strict;

# The manual says that this ain't necessary anymore, but it makes the
# RNG's quality sensibly better (for example with "fortune -e DB1 DB2")
srand (time ^ ($$ + ($$ << 15)));

# $HELP
# -----
#
# Generate man page with:
#   help2man -Nn 'Yet another implementation of fortune' EXECUTABLE

my $help = << "EOF";
Usage: $0 OPTIONS... [[N%] FILE/DIRECTORY/ALL]...

Print a random, hopefully interesting, adage.

When fortune is run with no arguments it prints out a random epigram.
Epigrams are divided into several categories, where each category is sub
subdivided into those which are potentially offensive and those which are
not. 

Options:
     -a, --all
		Choose from all lists of maxims, both offensive and not.
     -e, --equal-probabilities
		Distribute probabilities equally among databases, not
		among fortunes.
     -f, --list-files
		Print out the list of files which would be searched, but
		don't print a fortune.
     -i, --ignore-case
		Ignore case for -m patterns.
     -l, --dictums
		Long dictums only.
     -m, --regexp=REGEXP
		Print out all fortunes which match the regular expression
		pattern.
     -o, --offensive
		Choose only from potentially offensive aphorisms.
		Please, please, please request a potentially offensive
		fortune if and only if you believe, deep down in your
		heart, that you are willing to be offended.  (And that
		if you are, you'll just quit using -o rather than give
		us grief about it, okay?)
     -s, --apothegms
		Short apothegms only.
     -v, --invert-match
		Print out all fortunes which don't match the -m regular
		expression pattern.
     -w, --wait
		Wait before termination for an amount of time calculated
		from the number of characters in the message.  This is 
		useful if it is executed as part of the logout procedure
		to guarantee that the message can be read before the screen
		is cleared.

You may specify alternative sayings.  You can specify a specific file, a
directory which contains one or more files, or the special word all which
says to use all the standard databases.  Any of these may be preceded by a
percentage, which is a number N between 0 and 100 inclusive, followed by a
`%' sign.  If it is, there will be a N percent probability that an adage
will be picked from that file or directory.  If the percentages do not
sum to 100, and there are specifications without percentages, the remaining
percent will apply to those files and/or directories, in which case the
probability of selecting from one of them will be based on their relative
sizes.

As an example, given two databases funny and not-funny, with funny twice as
big, saying

     $0 funny not-funny

will get you fortunes out of funny two-thirds of the time.  The command

     $0 90% funny 10% not-funny

will pick out 90% of its fortunes from funny (the ``10%'' is unnecessary,
since 10% is all that's left).  The -e option says to consider all files
equal; thus

     $0 -e

is equivalent to

     $0 50% funny 50% not-funny

EOF

# $VERSION
# --------
my $version =  <<"EOF";
my-fortune 1.0
Written by Paolo Bonzini.

This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
EOF

## --------- ##
## Routines. ##
## --------- ##

sub bad_cmdline {
  my ($msg) = @_;
  print STDERR "$0: $msg\n";
  print STDERR "Try `$0 --help' for more information.\n";
  exit (1);
}

sub getopt {
  my (%option) = @_;
  use Getopt::Long;

  %option = ("h|help"     => sub { print $help; exit 0 },
             "V|version"  => sub { print $version; exit 0 },

             # User options last, so that they have precedence.
             %option);

  Getopt::Long::Configure ("bundling", "pass_through");
  GetOptions (%option)
    or exit 1;

  bad_cmdline ("unrecognized option `$_'")
    foreach (grep { /^-./ } @ARGV);
}

## -------- ##
## Options. ##
## -------- ##

my $datadir = ($ENV{'FORTUNEDIR'} || '/usr/games/lib/fortunes');

my $fifty_fifty = 0;
my $all_files = 0;
my $list_files = 0;
my $offensive = 0;
my $short = 0;
my $long = 0;
my $regexp = undef;
my $invert = 0;
my $ignore_case = 0;
my $wait = 0;

# These variables hold the result of parsing the database names
# on the command line.
my $undef_pcts = 0;
my $sum_pcts = 0;
my @pcts = ();
my @files = ();

# Process the arguments for real this time.
getopt (
  "e|equal-probabilities"   => \$fifty_fifty,
  "a|all"	            => \$all_files,
  "f|list_files"            => \$list_files,
  "o|offensive"             => \$offensive,
  "s|apothegms"             => \$short,
  "l|dictums"               => \$long,
  "m|regexp=s"              => \$regexp,
  "v|invert-match"          => \$invert,
  "i|ignore-case"           => \$ignore_case,
  "w|wait"                  => \$wait,
);

@ARGV = ("all")
  if (!@ARGV);

bad_cmdline ("guy, you're asking for too strict a selection")
  if $short && $long;

bad_cmdline ("please supply a regexp pattern to be matched")
  if (($invert || $ignore_case) && !defined $regexp);

# Modify the regexp based on -i and -v.
$regexp = "(?i:$regexp)"    if ($ignore_case);
$regexp = "^(?!.*?$regexp)" if ($invert);

## --------------------- ##
## More cmdline parsing. ##
## --------------------- ##

my $expect_file = 0;
my $next_pct = undef;
foreach (@ARGV)
  {
    # If we get a percentage, save it and expect a file
    if (!$expect_file && /^(\d+)%$/)
      {
        $next_pct = $1;
        $sum_pcts += $1;
        $expect_file = 1;
	next;
      }

    # Special-case local directory names and `all'.
    my $arg = $datadir . "/" . $_;
    reset;
    ?/?     && ($arg = $_);
    ?^all$? && ($arg = $datadir);

    if (!$expect_file && -d $arg)
      {
        # If we get a directory without a percentage, expand it
        opendir DIR, $arg;
        bad_cmdline ("Cannot find $arg")
	  if !defined *DIR;

        while ($_ = readdir DIR)
	  {
            next if (/\.dat$/);
            next if (/\/\.{1,2}$/);
            next unless $all_files || ($offensive == /-o$/);
  
	    $undef_pcts++;
	    push @pcts, undef;
	    push @files, $arg . "/" . $_;
          }
	closedir DIR;
      }
    else
      {
        # If we get a file, or a directory with a percentage, push it
        bad_cmdline ("Cannot find $arg")
	  unless -f $arg || -d $arg;

        $undef_pcts++ unless $expect_file;
	push @pcts, $next_pct;
	push @files, $arg if -f $arg || -d $arg;
	$expect_file = 0;
        $next_pct = undef;
      }
  }

bad_cmdline ("lone percentage")
  if ($expect_file);

# If we have a sum < 100%, databases without a percentage get the
# remaining probability.  Assign it now if the probabilities must
# be spread evenly, else leave it for later.

if ($fifty_fifty && $sum_pcts < 100 && $undef_pcts > 0)
  {
    for (my $i = 0; $i < @pcts; $i++)
      {
        $pcts[$i] = (100 - $sum_pcts) / $undef_pcts
	  if !defined $pcts[$i];
      }

    # No file has anymore a probability that depends on the
    # actual number of fortunes in it.
    $undef_pcts = 0;
    $sum_pcts = 100;
  }

## ----------- ##
## Process -f. ##
## ----------- ##

if ($list_files)
  {
    my $factor = ($sum_pcts > 100 || $undef_pcts == 0) ? 100.0 / $sum_pcts : 1.0;
    my %table = ();
    my %output = ();

    for (my $i = 0; $i < @pcts; $i++)
      {
	my $file = $files[$i];
	my $pct = $pcts[$i];

	# Directory references might produce duplicate entries,
	# so build the output in two tables and then walk 'em.
	$output{$file} = 1
	  if ($sum_pcts < 100 && !defined $pct);

	$table{$files[$i]} += $pcts[$i] / $factor
	  if defined $pcts[$i];
      }

    my $val = 0;
    foreach my $key (sort keys %table)
      {
	# -e and factor might produce decimal percentages, so
	# keep a running error so that at least they sum up to 100.
	$val += $table{$key};
	printf "%3d%% %s\n", $val, $key;
	$val -= int $val;
      }

    foreach my $key (sort keys %output)
      {
	printf "___%% %s\n", $key;
      }

    exit 0;
  }

## ---------------- ##
## Pick a database. ##
## ---------------- ##

# Now extract a random number and find the database that corresponds
# to it.

$sum_pcts = 100
  if ($sum_pcts < 100 && $undef_pcts > 0);

my $random = rand $sum_pcts;
my $i;
for ($i = 0; $i < @pcts; $i++)
  {
    next if !defined $pcts[$i];
    last if $random <= $pcts[$i];
    $random -= $pcts[$i];
  }

# Extract into FILES only the files which are to be searched for.

if ($i < @pcts)
  {
    if (-d $files[$i])
      {
        # We got a directory with a percentage specified.  Look for a
        # fortune in its databases.

        opendir DIR, $files[$i];
	@files = grep
	  {
            !(/\.dat$/)
            && !(/\/\.{1,2}$/)
            && ($all_files || ($offensive == /-o$/))
	  } map { $files[$i] . "/" . $_ } readdir DIR;

	closedir DIR;

        # ... and, possibly, find the file if the probabilities are
        # spread evenly.

        @files = ($files[POSIX::floor(rand @files)])
	  if ($fifty_fifty);
      }
    else
      {
        # We got a file with a percentage specified.  Look for a
        # fortune in it.

	@files = ($files[$i]);
      }
  }
else
  {
    # We got the files without a percentage.  Look for a
    # fortune in them.

    $i = 0;
    @files = grep { !defined $pcts[$i++] } @files;
  }

## ---------------------- ##
## Pick a random fortune. ##
## ---------------------- ##

my $num_fortune = 0;
my $fortune = "";
my $separator = "";
my $cur_file;
my @lines;

BIGLOOP: while (1)
  {
    # Use a while loop to skip empty files
    while (!defined *FILE || eof FILE)
      {
        # Open the next file.
        $cur_file = shift @files;
        last BIGLOOP if !$cur_file;
        open FILE, $cur_file;

	# Prepare the string to be output in -m mode.
	$cur_file =~ m{(?:.*/)?(.*)};
	$separator = "%% ($1)";
      }

    # Read a line from the file up to the fortune delimiter.
    @lines = ();
    push @lines, $_
      while (defined ($_ = readline *FILE) && $_ ne "%\n");

    # Check if the fortune satisfies our criteria.
    next if ($short && @lines > 2);
    next if ($long && @lines < 3);

    # The fortune is picked with a probability of 1/number-of-fortunes
    next unless defined $regexp || ++$num_fortune == 1 || rand $num_fortune < 1;

    # Ok, we're interested in this fortune.  Join the lines it is made of...
    $_ = join "", @lines;

    # ...rot13 offensive fortunes...
    tr/A-Ma-mN-Zn-z/N-Zn-zA-Ma-m/ if ($cur_file =~ m/-o$/);

    # ...and print/save it.
    if (defined $regexp)
      {
        if (m/$regexp/os)
	  {
            print "$separator\n$_";
	    $separator = "%%";
            ++$num_fortune;
	  }
      }
    else
      {
        $fortune = $_;
      }
  }

if (!defined $regexp) 
  {
    print $fortune;
    sleep 0.05 * length $fortune
      if $wait;
  }

exit (0);