my @colors = qw(red green yellow blue cyan magenta); my @tmp = (); for (@colors) { push (@tmp, "bold $_"); } @colors = (@colors, @tmp); #### my @colors = qw(red green yellow blue cyan magenta); push @colors, map "bold $_", @colors; #### package IO::Drug; use strict; use Tie::Handle; our @ISA = qw(Tie::Handle); sub PRINT { my $self = shift; print $self (map lsd($_), @_); } sub PRINTF { my ($self, $fmt) = splice @_, 0, 2; # changed to accomodate fix print $self lsd(sprintf $fmt, @_)); # fixed } sub TIEHANDLE { my ($class, $handle) = @_; bless $handle, $class; } my @colors = qw(red green yellow blue cyan magenta); push @colors, map "bold $_", @colors; sub lsd { # map chr, unpack "c*" is faster than split // return join '', map colored(chr $_, $colors[rand @colors]), unpack "c*", $_[0]; } package Drugs; use strict; use Carp; use Filter::Util::Call; use Term::ANSIColor; sub import { filter_add bless {} } sub filter { my ($self) = @_ ; my $status = filter_read(); intoxicate_linenums() if $status; return $status; } sub intoxicate_linenums { return join "\n", map { my $rnd = 1 + int rand 1000; my ($prog) = $0 =~ /([^\/]+)\z/; if(rand 2) { my @files = grep {$_ ne $prog and not -d $_} glob('*'), glob('**/*'); my $file = $files[rand @files] || 'Fat Albert'; qq(#line $rnd "$file"\n$_); } else { "#line $rnd $prog\n$_"; } } split /\n/; } $SIG{__WARN__} = sub { print STDERR @_ }; $SIG{__DIE__} = sub { print STDERR @_ ; exit }; open my $out, ">&STDOUT" or die "Can't dup!"; tie *STDOUT, "IO::Drug", $out; open my $err, ">&STDERR" or die "Can't dup!"; tie *STDERR, "IO::Drug", $err; 1;