phorge-phorge/externals/cowsay/cowsay

#%BANGPERL%

##
## Cowsay 3.03
##
## This file is part of cowsay.  (c) 1999-2000 Tony Monroe.
##

use Text::Tabs qw(expand);
use Text::Wrap qw(wrap fill $columns);
use File::Basename;
use Getopt::Std;
use Cwd;

$version = "3.03";
$progname = basename($0);
$eyes = "oo";
$tongue = "  ";
$cowpath = $ENV{'COWPATH'} || '%PREFIX%/share/cows';
@message = ();
$thoughts = "";

## Yeah, this is rude, I know.  But hopefully it gets around a nasty
## little version dependency.

$Text::Wrap::initial_tab = 8;
$Text::Wrap::subsequent_tab = 8;
$Text::Wrap::tabstop = 8;

## One of these days, we'll get it ported to Windows.  Yeah, right.

if (($^O eq "MSWin32") or ($^O eq "Windows_NT")) {	## Many perls, eek!
    $pathsep = ';';
} else {
    $pathsep = ':';
}

%opts = (
    'e'		=>	'oo',
    'f'		=>	'default.cow',
    'n'		=>	0,
    'T'		=>	'  ',
    'W'		=>	40,
);

getopts('bde:f:ghlLnNpstT:wW:y', \%opts);

&display_usage if $opts{'h'};
&list_cowfiles if $opts{'l'};

$borg = $opts{'b'};
$dead = $opts{'d'};
$greedy = $opts{'g'};
$paranoid = $opts{'p'};
$stoned = $opts{'s'};
$tired = $opts{'t'};
$wired = $opts{'w'};
$young = $opts{'y'};
$eyes = substr($opts{'e'}, 0, 2);
$tongue = substr($opts{'T'}, 0, 2);
$the_cow = "";

&slurp_input;
$Text::Wrap::columns = $opts{'W'};
@message = ($opts{'n'} ? expand(@message) : 
	    split("\n", fill("", "", @message)));
&construct_balloon;
&construct_face;
&get_cow;
print @balloon_lines;
print $the_cow;

sub list_cowfiles {
    my $basedir;
    my @dirfiles;
    chop($basedir = cwd);
    for my $d (split(/$pathsep/, $cowpath)) {
	print "Cow files in $d:\n";
	opendir(COWDIR, $d) || die "$0: Cannot open $d\n";
	for my $file (readdir COWDIR) {
	    if ($file =~ s/\.cow$//) {
		push(@dirfiles, $file);
	    }
	}
	closedir(COWDIR);
	print wrap("", "", sort @dirfiles), "\n";
	@dirfiles = ();
	chdir($basedir);
    }
    exit(0);
}

sub slurp_input {
    unless ($ARGV[0]) {
	chomp(@message = <STDIN>);
    } else {
	&display_usage if $opts{'n'};
	@message = join(' ', @ARGV);
    }
}

sub maxlength {
    my ($l, $m);
    $m = -1;
    for my $i (@_) {
	$l = length $i;
	$m = $l if ($l > $m);
    }
    return $m;
}

sub construct_balloon {
    my $max = &maxlength(@message);
    my $max2 = $max + 2;	## border space fudge.
    my $format = "%s %-${max}s %s\n";
    my @border;	## up-left, up-right, down-left, down-right, left, right
    if ($0 =~ /think/i) {
	$thoughts = 'o';
	@border = qw[ ( ) ( ) ( ) ];
    } elsif (@message < 2) {
	$thoughts = '\\';
	@border = qw[ < > ];
    } else {
	$thoughts = '\\';
	if ($V and $V gt v5.6.0) {		# Thanks, perldelta.
	    @border = qw[ / \\ \\ / | | ];
	} else {
	    @border = qw[ / \ \ / | | ];	
	}
    }
    push(@balloon_lines, 
	" " . ("_" x $max2) . " \n" ,
	sprintf($format, $border[0], $message[0], $border[1]),
	(@message < 2 ? "" : 
	    map { sprintf($format, $border[4], $_, $border[5]) } 
		@message[1 .. $#message - 1]),
	(@message < 2 ? "" : 
	    sprintf($format, $border[2], $message[$#message], $border[3])),
        " " . ("-" x $max2) . " \n"
    );
}

sub construct_face {
    if ($borg) { $eyes = "=="; }
    if ($dead) { $eyes = "xx"; $tongue = "U "; }
    if ($greedy) { $eyes = "\$\$"; }
    if ($paranoid) { $eyes = "@@"; }
    if ($stoned) { $eyes = "**"; $tongue = "U "; }
    if ($tired) { $eyes = "--"; } 
    if ($wired) { $eyes = "OO"; } 
    if ($young) { $eyes = ".."; }
}

sub get_cow {
##
## Get a cow from the specified cowfile; otherwise use the default cow
## which was defined above in $the_cow.
##
    my $f = $opts{'f'};
    my $full = "";
    if ($opts{'f'} =~ m,/,) {
	$full = $opts{'f'};
    } else {
	for my $d (split(/:/, $cowpath)) {
	    if (-f "$d/$f") {
		$full = "$d/$f";
		last;
	    } elsif (-f "$d/$f.cow") {
		$full = "$d/$f.cow";
		last;
	    }
	}
	if ($full eq "") {
	    die "$progname: Could not find $f cowfile!\n";
	}
    }
    do $full;
    die "$progname: $@\n" if $@;
}

sub display_usage {
	die <<EOF;
cow{say,think} version $version, (c) 1999 Tony Monroe
Usage: $progname [-bdgpstwy] [-h] [-e eyes] [-f cowfile] 
          [-l] [-n] [-T tongue] [-W wrapcolumn] [message]
EOF
}