|
| 1 | +#!/usr/bin/perl |
| 2 | + |
| 3 | +## |
| 4 | +## Cowsay 3.03 |
| 5 | +## |
| 6 | +## This file is part of cowsay. (c) 1999-2000 Tony Monroe. |
| 7 | +## |
| 8 | + |
| 9 | +use Text::Tabs qw(expand); |
| 10 | +use Text::Wrap qw(wrap fill $columns); |
| 11 | +use File::Basename; |
| 12 | +use Getopt::Std; |
| 13 | +use Cwd; |
| 14 | + |
| 15 | +$version = "3.03"; |
| 16 | +$progname = basename($0); |
| 17 | +$eyes = "oo"; |
| 18 | +$tongue = " "; |
| 19 | +$cowpath = $ENV{'COWPATH'} || '/usr/local/share/cows'; |
| 20 | +@message = (); |
| 21 | +$thoughts = ""; |
| 22 | + |
| 23 | +## Yeah, this is rude, I know. But hopefully it gets around a nasty |
| 24 | +## little version dependency. |
| 25 | + |
| 26 | +$Text::Wrap::initial_tab = 8; |
| 27 | +$Text::Wrap::subsequent_tab = 8; |
| 28 | +$Text::Wrap::tabstop = 8; |
| 29 | + |
| 30 | +## One of these days, we'll get it ported to Windows. Yeah, right. |
| 31 | + |
| 32 | +if (($^O eq "MSWin32") or ($^O eq "Windows_NT")) { ## Many perls, eek! |
| 33 | + $pathsep = ';'; |
| 34 | +} else { |
| 35 | + $pathsep = ':'; |
| 36 | +} |
| 37 | + |
| 38 | +%opts = ( |
| 39 | + 'e' => 'oo', |
| 40 | + 'f' => 'default.cow', |
| 41 | + 'n' => 0, |
| 42 | + 'T' => ' ', |
| 43 | + 'W' => 40, |
| 44 | +); |
| 45 | + |
| 46 | +getopts('bde:f:ghlLnNpstT:wW:y', \%opts); |
| 47 | + |
| 48 | +&display_usage if $opts{'h'}; |
| 49 | +&list_cowfiles if $opts{'l'}; |
| 50 | + |
| 51 | +$borg = $opts{'b'}; |
| 52 | +$dead = $opts{'d'}; |
| 53 | +$greedy = $opts{'g'}; |
| 54 | +$paranoid = $opts{'p'}; |
| 55 | +$stoned = $opts{'s'}; |
| 56 | +$tired = $opts{'t'}; |
| 57 | +$wired = $opts{'w'}; |
| 58 | +$young = $opts{'y'}; |
| 59 | +$eyes = substr($opts{'e'}, 0, 2); |
| 60 | +$tongue = substr($opts{'T'}, 0, 2); |
| 61 | +$the_cow = ""; |
| 62 | + |
| 63 | +&slurp_input; |
| 64 | +$Text::Wrap::columns = $opts{'W'}; |
| 65 | +@message = ($opts{'n'} ? expand(@message) : |
| 66 | + split("\n", fill("", "", @message))); |
| 67 | +&construct_balloon; |
| 68 | +&construct_face; |
| 69 | +&get_cow; |
| 70 | +print @balloon_lines; |
| 71 | +print $the_cow; |
| 72 | + |
| 73 | +sub list_cowfiles { |
| 74 | + my $basedir; |
| 75 | + my @dirfiles; |
| 76 | + chop($basedir = cwd); |
| 77 | + for my $d (split(/$pathsep/, $cowpath)) { |
| 78 | + print "Cow files in $d:\n"; |
| 79 | + opendir(COWDIR, $d) || die "$0: Cannot open $d\n"; |
| 80 | + for my $file (readdir COWDIR) { |
| 81 | + if ($file =~ s/\.cow$//) { |
| 82 | + push(@dirfiles, $file); |
| 83 | + } |
| 84 | + } |
| 85 | + closedir(COWDIR); |
| 86 | + print wrap("", "", sort @dirfiles), "\n"; |
| 87 | + @dirfiles = (); |
| 88 | + chdir($basedir); |
| 89 | + } |
| 90 | + exit(0); |
| 91 | +} |
| 92 | + |
| 93 | +sub slurp_input { |
| 94 | + unless ($ARGV[0]) { |
| 95 | + chomp(@message = <STDIN>); |
| 96 | + } else { |
| 97 | + &display_usage if $opts{'n'}; |
| 98 | + @message = join(' ', @ARGV); |
| 99 | + } |
| 100 | +} |
| 101 | + |
| 102 | +sub maxlength { |
| 103 | + my ($l, $m); |
| 104 | + $m = -1; |
| 105 | + for my $i (@_) { |
| 106 | + $l = length $i; |
| 107 | + $m = $l if ($l > $m); |
| 108 | + } |
| 109 | + return $m; |
| 110 | +} |
| 111 | + |
| 112 | +sub construct_balloon { |
| 113 | + my $max = &maxlength(@message); |
| 114 | + my $max2 = $max + 2; ## border space fudge. |
| 115 | + my $format = "%s %-${max}s %s\n"; |
| 116 | + my @border; ## up-left, up-right, down-left, down-right, left, right |
| 117 | + if ($0 =~ /think/i) { |
| 118 | + $thoughts = 'o'; |
| 119 | + @border = qw[ ( ) ( ) ( ) ]; |
| 120 | + } elsif (@message < 2) { |
| 121 | + $thoughts = '\\'; |
| 122 | + @border = qw[ < > ]; |
| 123 | + } else { |
| 124 | + $thoughts = '\\'; |
| 125 | + if ($V and $V gt v5.6.0) { # Thanks, perldelta. |
| 126 | + @border = qw[ / \\ \\ / | | ]; |
| 127 | + } else { |
| 128 | + @border = qw[ / \ \ / | | ]; |
| 129 | + } |
| 130 | + } |
| 131 | + push(@balloon_lines, |
| 132 | + " " . ("_" x $max2) . " \n" , |
| 133 | + sprintf($format, $border[0], $message[0], $border[1]), |
| 134 | + (@message < 2 ? "" : |
| 135 | + map { sprintf($format, $border[4], $_, $border[5]) } |
| 136 | + @message[1 .. $#message - 1]), |
| 137 | + (@message < 2 ? "" : |
| 138 | + sprintf($format, $border[2], $message[$#message], $border[3])), |
| 139 | + " " . ("-" x $max2) . " \n" |
| 140 | + ); |
| 141 | +} |
| 142 | + |
| 143 | +sub construct_face { |
| 144 | + if ($borg) { $eyes = "=="; } |
| 145 | + if ($dead) { $eyes = "xx"; $tongue = "U "; } |
| 146 | + if ($greedy) { $eyes = "\$\$"; } |
| 147 | + if ($paranoid) { $eyes = "@@"; } |
| 148 | + if ($stoned) { $eyes = "**"; $tongue = "U "; } |
| 149 | + if ($tired) { $eyes = "--"; } |
| 150 | + if ($wired) { $eyes = "OO"; } |
| 151 | + if ($young) { $eyes = ".."; } |
| 152 | +} |
| 153 | + |
| 154 | +sub get_cow { |
| 155 | +## |
| 156 | +## Get a cow from the specified cowfile; otherwise use the default cow |
| 157 | +## which was defined above in $the_cow. |
| 158 | +## |
| 159 | + my $f = $opts{'f'}; |
| 160 | + my $full = ""; |
| 161 | + if ($opts{'f'} =~ m,/,) { |
| 162 | + $full = $opts{'f'}; |
| 163 | + } else { |
| 164 | + for my $d (split(/:/, $cowpath)) { |
| 165 | + if (-f "$d/$f") { |
| 166 | + $full = "$d/$f"; |
| 167 | + last; |
| 168 | + } elsif (-f "$d/$f.cow") { |
| 169 | + $full = "$d/$f.cow"; |
| 170 | + last; |
| 171 | + } |
| 172 | + } |
| 173 | + if ($full eq "") { |
| 174 | + die "$progname: Could not find $f cowfile!\n"; |
| 175 | + } |
| 176 | + } |
| 177 | + do $full; |
| 178 | + die "$progname: $@\n" if $@; |
| 179 | +} |
| 180 | + |
| 181 | +sub display_usage { |
| 182 | + die <<EOF; |
| 183 | +cow{say,think} version $version, (c) 1999 Tony Monroe |
| 184 | +Usage: $progname [-bdgpstwy] [-h] [-e eyes] [-f cowfile] |
| 185 | + [-l] [-n] [-T tongue] [-W wrapcolumn] [message] |
| 186 | +EOF |
| 187 | +} |
0 commit comments