my @colors = qw(red green yellow blue cyan magenta);
my @tmp    = ();
for (@colors) {
    push (@tmp, "bold $_");
}
@colors = (@colors, @tmp);
[download]

my @colors = qw(red green yellow blue cyan magenta);
push @colors, map "bold $_", @colors;
[download]

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;
[download]

++ for the idea. :-) Fortunately, use Drugs (); causes the line number intoxication to be sidestepped, and I might even use it that way occasionally for fun. *grin*

Update: Pulled @colors initialization out of the lsd() routine.

Update 2002-09-08: had to s/sprintf @_/sprintf $fmt, @_/ because sprintf has prototype ($@) *grumble* See code comments for changes.

Makeshifts last the longest.

hrm, I hadn't thought of its strictness.
Thanks for the improvments!

As for it being C-like, that is very strange. Perl is my first (programming) language and I just started looking at C... I also really like map {} (and grep {}), but I thought for() was faster than map for some reason.

It can be. That very much depends on what you're trying to do. Note I didn't pick map for efficiency here, more because it pulls the code together with fewer temporary variables at least using my overall style (and fewer of those do tend to lead to more efficiency).

Selectively modifying elements of an array inplace, esp when you only need to touch few, most likely is best left to a for loop. Touching each or almost each and every element it can be a toss-up. When you are building a new array as you iterate over another, map is very likely the clear winner.

Makeshifts last the longest.

Darn. Noone called me on the sprintf @_ mistake. Lucky that I ran across this node again while looking for another; fixed now. It's still untested code though so YMMV. If you find any more errors, please let me know.

Makeshifts last the longest.

I ran it, (With sprintf problem), no problems. I hardly ever use printf so I'd have never caught the problem. Fixed above version as-par your fix.

Here's an idea: Put -MDrugs in PERL5OPT, in someone else's .bashrc file <evil grin>...