#!/usr/bin/env perl

##
## Cowsay
##

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

$Getopt::Std::STANDARD_HELP_VERSION = 1;

$VERSION = "3.7.0";
$progname = basename($0);
$eyes = "oo";
$tongue = "  ";
$pathsep = detect_pathsep();
@cowpath = pick_cowpath();
@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;

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

getopts('bCde:f:ghlLnNprstT:wW:y', \%opts);

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

$random = $opts{'r'};
$enable_full_color = $opts{'C'};
$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);
$specified_cow = $opts{'f'};
$cow_file_path = "";
$the_cow = "";

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

sub detect_pathsep {
    ## 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!
        return ';';
    } else {
        return ':';
    }
}

sub pick_cowpath {
    my $parent_dir = dirname(__FILE__);
    my $parent_dir_base = basename($parent_dir);
    my ($prefix_dir, $share_cowsay, $real_prefix_dir, $etc_dir);
    if ($parent_dir_base eq "bin") {
        # We're running from an installation prefix
        $prefix_dir = dirname($parent_dir);
        $share_cowsay = "$prefix_dir/share/cowsay";
        $real_prefix_dir = $prefix_dir;
    } else {
        # We're running from the source repo
        $prefix_dir = $parent_dir;
        $share_cowsay = "$prefix_dir/share";
        # Default to default installation location, so in-repo cowsay can still see the
        # system cowpath.d directory.
        $real_prefix_dir = "/usr/local";
    }
    $prefix_dir = abs_path($prefix_dir);
    $real_prefix_dir = abs_path($real_prefix_dir);
    if ($real_prefix_dir eq "/usr") {
        $etc_dir = "/etc";
    } else {
        $etc_dir = "$real_prefix_dir/etc";
    }

    my @cowpath;
    my @default_cowpath = ("$share_cowsay/site-cows", "$share_cowsay/cows");

    my $cowpath_d_dir = "$etc_dir/cowsay/cowpath.d";
    if (-d $cowpath_d_dir) {
        my $dh;
        opendir($dh, $cowpath_d_dir);
        my @files = readdir($dh);
        closedir($dh);
        foreach (@files) {
            my $file = "$cowpath_d_dir/$_";
            if (-f $file && $file =~ /\.path$/) {
                open my $fh, '<', $file
                    or die "Could not read file $file: $!\n";
                while (my $entry = <$fh>) {
                    chomp $entry;
                    push @default_cowpath, $entry;
                }
                close($fh);
            }
        }
    }

    if ($ENV{'COWPATH'}) {
        my @user_cowpath = split(/$pathsep/, $ENV{'COWPATH'});
        if ($ENV{'COWSAY_ONLY_COWPATH'} == 1) {
            @cowpath = @user_cowpath;
        } else {
            @cowpath = (@default_cowpath, @user_cowpath);
        }
    } else {
        @cowpath = @default_cowpath;
    }

    @cowpath = uniquify_list(@cowpath);

    return @cowpath;
}

sub uniquify_list {
    my %seen;
    my @unique = grep { !$seen{$_}++ } @_;
    return @unique;
}

sub list_cowfiles {
    if (-t STDOUT) {
        print "Listing cowfiles in pretty format\n";
        list_cowfiles_pretty();
    } else {
        list_cowfiles_parseable();
    }
    exit(0);
}

my @found_cows;
my $search_start_dir;

sub find_cowfile_callback() {
    if (-f && /\.(cow|pm)$/) {
        my $rel_file = substr($File::Find::name, length($search_start_dir) + 1);
        my $cow_name = $rel_file;
        $cow_name =~ s/\.(cow|pm)$//;
        push @found_cows, $cow_name;
    }
}

sub list_cows_in_cowdir {
    my ($cowdir) = @_;
    @found_cows = ();
    $search_start_dir = $cowdir;
    find(\&find_cowfile_callback, $cowdir);
    return \@found_cows;
}

sub list_cowfiles_parseable {
    my $cows = defined_cows();
    print join("\n", @$cows), "\n";
}

sub defined_cows {
    my $basedir;
    my %cowfiles;
    for my $d (@cowpath) {
        next unless -d $d;
        my $cows = list_cows_in_cowdir($d);
        for my $cow (@$cows) {
            $cowfiles{$cow} = $cow;
        }
    }
    my @cowfiles = sort keys %cowfiles;
    return \@cowfiles;
}

sub defined_cows_structured {
    my $cows = defined_cows();
    my %cows;
    my @truecolor = ();
    my @basic = ();
    for (@$cows) {
        if (m|^truecolor/|) {
            push @truecolor, $_;
        } else {
            push @basic, $_;
        }
    }
    my @all = (@basic, @truecolor);
    return {
        basic => \@basic,
        truecolor => \@truecolor,
        all => \@all
    };
}

sub list_cowfiles_pretty {
    my $basedir;
    my @dirfiles;
    my $first = 1;
    for my $d (@cowpath) {
        next unless -d $d;
        print "\n" unless $first;
        $first = 0;
        print "Cow files in $d:\n";
        my $cows = list_cows_in_cowdir($d);
        print wrap("", "", sort @$cows), "\n";
    }
}

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 resolve_cow {
    my ($name) = @_;
    my $full = "";
    for my $d (@cowpath) {
        if (-f "$d/$name") {
            $full = "$d/$name";
            last;
        } elsif (-f "$d/$name.cow") {
            $full = "$d/$name.cow";
            last;
        } elsif (-f "$d/$name.pm") {
            $full = "$d/$name.pm";
        }
    }
    if ($full eq "") {
        die "$progname: Could not find cowfile for '$name'!\n";
    }
    return $full;
}

sub pick_cow {
    my $found_path = "";
    if ($random) {
        my $defined_cows = defined_cows_structured();
        my @usable_cows;
        if ($enable_full_color) {
            @usable_cows = @{$$defined_cows{all}};
        } else {
            @usable_cows = @{$$defined_cows{basic}};
        }
        my $n_cows = scalar @usable_cows;
        my $index = int(rand($n_cows));
        my $selected_cow = $usable_cows[$index];
        $found_path = resolve_cow($selected_cow);
    } elsif (-f $specified_cow) {
        $found_path = $specified_cow;
    } else {
        $found_path = resolve_cow($specified_cow);
    }
    $cow_file_path = $found_path;
}

sub read_cow {
    if ($cow_file_path =~ /\.pm$/) {
        die "$progname: Cannot load cow from $cow_file_path: .pm format cows are not implemented yet. Sorry.\n";
    } else {
        do $cow_file_path;
    }
    die "$progname: Error reading cow definition from $cow_file_path: $@\n" if $@;
}

sub HELP_MESSAGE {
        print <<EOF;
$progname version $VERSION

Usage:

    $progname [-bdgpstwy] [-e <eyes>] [-f <cowfile> | -r [-C] ] 
        [-n] [-T <tongue>] [-W <wrapcolumn>]
        <message>
    $progname -l    # List defined cows
    $progname -h    # Displays this help screen

EOF
}
