1
0
Fork 0
mirror of https://we.phorge.it/source/phorge.git synced 2024-12-25 15:00:58 +01:00
phorge-phorge/externals/cowsay/cowsay
epriestley c705c8011e Use PHP implementation of Cowsay for cowsay rule
Summary:
Ref T7785. Convert the Cowsay Remarkup rule to use a PHP implementation so we don't have to execute an external `cowsay` binary.

I removed some of the default ".cow" files that come with Cowsay because they:

  - include Perl code which we can not interpret; or
  - are primarily in-jokes or standalone visual puns or artwork rather than usable actors on the grand stage of cowsay; or
  - offended my delicate sensibilities.

Users can add new cows to `resources/cows/custom/` if they want to make new cows available.

I have included a majestic original artwork depicting the "Companion Cube" character from //Portal//.

Test Plan: {F802535}

Reviewers: chad

Reviewed By: chad

Maniphest Tasks: T9408, T7785

Differential Revision: https://secure.phabricator.com/D14100
2015-09-13 12:27:30 -07:00

187 lines
4 KiB
Text
Executable file

#%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
}