#!/usr/local/bin/perl

eval 'exec /usr/local/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#
# $Id: fortune,v 1.1.1.1 2001/06/06 08:54:38 sdague Exp $
#
# $Log: fortune,v $
# Revision 1.1.1.1  2001/06/06 08:54:38  sdague
# initial import
#
# Revision 1.1.1.1  2001/05/13 19:56:30  sdague
# added initial import of PPT work
#
#
# Revision 1.0 1999/04/30 andy murren
# Inital Revision
#

use strict;
use FindBin qw($Bin);
use File::Basename;
use Getopt::Std;

$|++;

my ($VERSION) = ' $Revision: 1.1.1.1 $ ';

my $home = "$Bin/fortunes";

my ($t0, $t1, $main, $find, @seen_file, $found, $wait, @mrtn);
my (@dir_list, @text, $text, $dir, %hash, $f, %args, $size);
$wait = $size = $found = 0;

my (%opts);
getopts('adefhilosvwm:', \%opts); 

my $debug = $opts{'d'};

if ($opts{'v'}) {
	print "\n\n$0 $VERSION\n\n";
	exit 1;
}

if ($debug) {
	warn "opts are:\n";
	foreach (keys %opts) {
		warn "$_ == $opts{$_}\n";
	}
}

if ($opts{'h'}) { &print_help; }

if ($opts{'m'}) {
	$find = '(?i)' if $opts{'i'};
	$opts{'m'} =~ s%(\W)%\\$1%g;
	$find .= $opts{'m'};
	warn "\$find ==> $find" if $debug;
	study $find;
}
	
if (@ARGV) {

	if ($debug) {
		warn "\n\@ARGV:\n";
		foreach (@ARGV) {
			warn "$_\n";
		}
		warn "\n\n";
	}

	my ($ky, $val, $f);
	$ky = $val = $f = 0;
	foreach (@ARGV) {
		if (/^all$/) {
			$opts{a} = 1;
			undef @ARGV;
			last;
		} elsif (/\d+\%/) {
			s/(\d+)\%/$1/;
			$val = $_;
			$f++;
		} else {
			if (($val) && ($f)){
				$args{$_} = $val;
			}

			$ky = $val = $f = 0;
		}
	}
}

# this is the main routine of the program

if ($opts{f}) {
	&build_file_list;
	&print_file_list;
}else { 
	&build_file_list;
	my $pfile = &pick_file;
	my $pick = &pick_fortune($pfile);
	&print_fortune($pick);
}

exit 1;

#
#  Sub Routines
#

sub find_fortune
{
	&new_file_list;
	my $pfile = &pick_file;
	my $pick = &pick_fortune($pfile);
}

# build list the available files
#
# if -a all files including `obscene' ones are valid
# if -o only `offensive' files are valid
# if no switch is given only non `offensive' files are valid
# if -e is used then all files are considered of equal size
#   so we put all of the names in an array and randomly select one
# if files are specified on the command line only list those

sub build_file_list
{
	my $rtn;

	@dir_list = ();
	if (@ARGV) {  $rtn = &build_w_args; }  
	else { $rtn = &build_wo_args; }

	return $rtn;
}

# used if files or directories were given on the cmd line

sub build_w_args
{

if (%args) {

	    while (my ($key,$value) = each %args) {

			if ($debug) { warn "key = $key, value = $value\n"; }

			my (@temp, $t, $i);
		    if ($value =~ /^\d+\$/) {
				$t += $value;
				$i = $value;
			}
			while ($i) {
				push @temp, "$home/$key";
				$i--;
			}

			foreach (@temp) { print "$_\n"; }
			my $dir_c = @temp;
			my $rand = int (rand $dir_c);
			my $tmp = $temp[$rand];
			if ($debug) { warn "$tmp\n"; }
			return $tmp;			
		}
    }
}

# if no files were specified on the cmd line use this.
# gets the list of files and their sizes 

sub build_wo_args
{

	opendir D, "$home" or die "could not open $home: $!\n"; 

	my @allfiles = readdir D;

	foreach (@allfiles) {
		next if /^\./;
		next if /\..*$/;
		if ($opts{o})       { next unless  /-o$/ || /limerick$/; }
		elsif (! $opts{a})  { next     if  /-o$/ || /limerick$/; }
		next unless -f "$home/$_";
		push @dir_list, "$home/$_";      
	}
	if ($debug) {
		warn "\n\@dir_list in build_wo_args\n";
		foreach (@dir_list) { warn "$_\n"; }
		warn "\n";
	}
}

sub pick_file
{
	die "\nCould find no files to open!\n" unless @dir_list;
	
	if ($opts{e}) {
		my $dir_c = @dir_list;
		my $rand = int (rand $dir_c);
		my $tmp = $dir_list[$rand];
		return $tmp;
	} else {
		my (@temp, $t);
		@temp = ();
		my $sz = 0;
		%hash = ();

		foreach (@dir_list) {
			$sz = (-s "$_");
			$size += $sz;
			$hash{$_} = $sz;
		}

		for $t(keys %hash) {
			my $r = %hash->{$t};
			my $i = int (100 * (($r/$size) + .005));
			if ($i < 1) { $i = 1; }
			while ($i) {
				push @temp, "$t";
				$i--;
			}

		}

		if ($debug) {
			warn "\n\@temp in pick_file\n";
			foreach (@temp) {
				warn "$_\n";
			}
		}

		my $dir_c = @temp;
		my $rand = int (rand $dir_c);
		my $tmp = $temp[$rand];

		warn "\ntmp = $tmp\n" if $debug;
		return $tmp;
	}

}

sub new_file_list
{
	my $t;
	my %seen = ();
	my @new_dir_list = ();

	if ($debug) {
		warn "\n ++dir_list\n";
		foreach (@dir_list) {
			my $n = basename($_);
			warn " $n\n";
		}
		warn "\n";
	}

	foreach $t (@seen_file) { $seen{$t} = 1; }

	foreach $t (@dir_list) {
		unless ($seen{$t}) { push (@new_dir_list, $t); }
	 }

	exit unless @new_dir_list;

	if ($debug) {
		warn "\n ++new_dir_list\n";
		foreach (@new_dir_list) {
			my $n = basename($_);
			warn " $n\n";
		}
		warn "\n";
	}

	@dir_list = ();
	@dir_list = @new_dir_list;

	if ($debug) {
		warn "\n ++dir_list\n";
		foreach (@dir_list) {
			my $n = basename($_);
			warn " $n\n";
		}
		warn "\n";
	}

}

# put all of the fortunes into an array then pick one
# that fits the criteria.

sub pick_fortune
{
	$/ = "\%\n";
	my $file = shift;
	my $line;
	my $picked = 0;
	if ($debug) { warn "\nthe file is $file\n\n"; }
	my $regex;
		open F, "< $file" or die "could not open file $file: $!";
		while (defined ($line = <F>)) {
			$line =~ s|\%+\n||g;
			push @text, $line; 
		}
		$text = @text;

	warn "\n\nthe length of \@text is $text\n\n" if $debug; 

	my $num = int (rand $text);

	warn "\n\$num at the beginning of pick_fortune is $num\n" if $debug;

	my @rtn;
	my $not_done = 1;
	my $wrap = 0;
	my $hold_num = $num;

	while ($not_done) {

		if ($opts{'s'} || $opts{'l'}) {
			@rtn = &short_long ($num, $not_done);
			$num = $rtn[0];
			$not_done = $rtn[1];
		} else {
			$not_done = 0;
			$found = 1;
		}

		if ($find) {
			$found = 0;
			@mrtn = &match($num, $not_done, $text, $wrap, $picked, \$found);
			$num = $mrtn[0];
			$not_done = $mrtn[1];

			if ($wrap && ($num >= $text)) {
				&new_file ($file, \$picked);
				$picked = 1;
				last;
			}
		} else {
			$not_done = 0;
			$found = 1;
		}
	}
	warn "\n\$num at the end of pick_fortune to be returned is $num\n" if $debug;
	return $num;
}

sub match 
{
	my $num = shift;
	my $not_done = shift;
	my $len = shift;
	my $wrap = shift;
	my $picked = shift;
	my $found = shift;

	if ($text[$num] !~ m|$find|smo) {
		$num++;
		$not_done = 1;

		if ($num > $len) {
			$num = 0;
			$wrap++;
		}
		
	} else {
		$picked = 0;
		$not_done = 0;
		$$found = 1;
	}

	if ($debug) {
		warn "match \$find == $find\t\$found == $$found\n";
		warn "the text matched is\n\t$text[$num]\n \$num = $num" if $$found;
	}
	return $num, $not_done;
}

sub new_file
{
	warn "\n^^ran out of fortunes in that file, trying another one\n\n" if $debug;
	my $file = shift;
	my $picked = shift;
	push @seen_file, $file;
	foreach (@seen_file) { warn "seen file => $_\n" if $debug; }
	$$picked = 1;
	&find_fortune;	

}

sub short_long
{
	my $num = shift;
	my $not_done = shift;

	warn "in short_long\n" if $debug;

	while ($not_done) {

	if ($opts{'s'}) {
		if (length ($text[$num]) > 200) {
			$num++;
			next;
		} else {
			$not_done = 0;				
		}

	} elsif ($opts{'l'}) {  # that's an ell
		if ((length ($text[$num]) <= 200)) {
			$num++;
			next;
		} else {
			$not_done = 0;				
		} 
	} else {
		;       # this will let us keep looking
	}
}
	return $num, $not_done;

}

sub print_fortune
{

	if ($found) {
		my $num = shift;
		warn "\n\$num in print_fortune is $num\n" if $debug;

		if ($opts{w}) {
			my $tmp = length $text[$num];
			$wait = int ($tmp/75);
		}		

		print "\n\n$text[$num]\n\n";
		sleep $wait;
	} else {
		print "\nSorry, did not find a match\n\n";
	}
}

sub print_file_list
{
	my $file_name;
	print "\n"; 
	foreach (@dir_list) {
		$file_name = basename($_);
		print "\t$file_name\n";
	}

	print "\n";
}

sub print_help
{

	print <<EOF;
	
Usage: $0 [-adefhilosw] [-m pattern] [[N%] file/dir/all]

	See the POD for more information.

     -a Choose from all lists of maxims, both offensive and not.
     -e Consider all fortune files to be of equal size.			
     -f Print out the list of files which would be searched.
     -l Long dictums only. 
     -m Print out all fortunes which match the regular expression pattern.
     -o Choose only from potentially offensive aphorisms.
     -s Short apothegms only.  
     -i Ignore case for -m patterns.
     -w Wait before termination for a calculated amount of time.

     all Same as the -a switch.

     N% file/dir   
         You can specify a specific file or directory which contains 
         one or more files.  Any of these may be preceded by a percentage, 
         which is a number N between 0 and 100 inclusive, followed by a %. 

EOF

	exit 1;
}

1;

__END__

=pod

=head1 NAME

fortune - print a random, hopefully interesting, adage

=head1 SYNOPSIS

fortune [-adefgilosw] [-m pattern] [[N%] file/dir/all]

=head1 DESCRIPTION

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

     -a    Choose from all lists of maxims, both offensive and not.  (See the
           -o option for more information on offensive fortunes.)

     -e    Consider all fortune files to be of equal size (see discussion be-
           low on multiple files).

     -f    Print out the list of files which would be searched, but do not
           print a fortune.

     -l    Long dictums only.  Long is defined as 200 or more charaters.

     -m    Print out all fortunes which match the regular expression pattern.
           See regex(3) for a description of patterns.

     -o    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 of-
           fended.  (And that if you are, you'll just quit using -o rather
           than give us grief about it, okay?)

                 ... let us keep in mind the basic governing philosophy of The
                 Brotherhood, as handsomely summarized in these words: we be-
                 lieve in healthy, hearty laughter -- at the expense of the
                 whole human race, if needs be.  Needs be.
                             --H. Allen Smith, "Rude Jokes"

     -s    Short apothegms only.  Short is defined as less than 200 charaters.

     -i    Ignore case for -m patterns.

     -w    Wait before termination for an amount of time calculated from the
           number of characters in the message.  This is useful if it is exe-
           cuted as part of the logout procedure to guarantee that the message
           can be read before the screen is cleared.

     The user may specify alternate 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 pre-
     ceded by a percentage, which is a number N between 0 and 100 inclusive,
     followed by a %. 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 re-
     maining 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

           fortune funny not-funny

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

           fortune 90% funny 10% not-funny

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

           fortune -e

     is equivalent to

           fortune 50% funny 50% not-funny

=head1 FILES

fortune
readme
./fortunes
./fortunes/fortunes1
./fortunes/fortunes2-o
./fortunes/fortunes2
./fortunes/limerick
./fortunes/lwall
./fortunes/startrek
./fortunes/zippy

=head1 BUGS

The matching is only working 50% of the time using single quotes around strings 
with white space and not at all for double quotes.

Command line input of files does not work.

=head1 TO DO

Get the command line args of files and percentages to work.

=head1 REVISION HISTORY

	Revision 1.0.1 1999/06/07 andy murren
	Small fixes and code clean up
	FindBin now helps locate the directory of fortunes
	Will search multiple files for a match
	Dumped the -g option I tried in the original

	Revision 1.0 1999/04/01 andy murren
	Inital Revision

=head1 AUTHOR

This Perl implmentation of I<fortune> was written by Andy Murren, I<andy@murren.org>.

=head1 COPYRIGHT and LICENSE

This program is covered by the GNU Public License (GPL).
See I<http://www.gnu.org/copyleft/gpl.html> for complete detail of the license.

=cut