view release on metacpan or  search on metacpan

cowthink  view on Meta::CPAN

    $pathsep = ';';
} else {
    $pathsep = ':';
}

my %opts = (
    'e'		=>	'oo',
    'n'		=>	0,
    'T'		=>	'  ',
    'W'		=>	40,
);

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

&display_usage() if ($opts{'h'} or $opts{'v'} or $opts{'?'});
&list_cowfiles() if $opts{'l'};

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

my $cow;

my @text = &slurp_input();
if ($opts{'f'}) {
    $cow = &variant_cow($opts{'f'});
} else {
    $cow = new Acme::Cow();
}
&construct_face($cow);
if (index($0, "think") != -1) {
    $cow->think(@text);
} else {
    $cow->say(@text);
}
$cow->fill(not $opts{'n'});
$cow->wrap($opts{'W'});
$cow->print();

sub list_cowfiles {
    my $basedir;
    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$//) {
		print $file, "\n";
	    }
	}
	closedir(COWDIR);
    }
    print "Cow files installed as modules:\n";
    for my $d (@INC) {
	my @files = glob("$d/Acme/Cow/*.pm");
	for my $file (@files) {
	    next if (basename($file) eq "TextBalloon.pm");
	    print basename($file, ".pm"), "\n";
	}
    }
    exit(0);
}

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

sub construct_face 
{
    my $cow = shift;
    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 = ".."; }
    $cow->{'el'} = substr($eyes, 0, 1);
    $cow->{'er'} = substr($eyes, 1, 1);
    $cow->{'U'} = $tongue;
}

sub variant_cow 
{
    my $f = shift;
    my $full;
    my $fn;
    if ($f =~ /^\w[\d\w]+$/) {
	my $package = "Acme::Cow::$f";
	eval "require $package;";
	if (not $@) {
	    return $package->new();
	}
    }
    if ($f =~ m,/,) {
	$full = $f;
    } else {
	for my $d (split(/$pathsep/, $cowpath)) {
	    $fn = File::Spec->catfile($d, $f);
	    if (-f $fn) {
		$full = $fn;
		last;
	    } elsif (-f "$fn.cow") {
		$full = "$fn.cow";
		last;
	    }