my @colors = qw(red green yellow blue cyan magenta);
my @tmp = ();
for (@colors) {
push (@tmp, "bold $_");
}
@colors = (@colors, @tmp);
Ugh. How about
my @colors = qw(red green yellow blue cyan magenta);
push @colors, map "bold $_", @colors;
In fact the code is very C-ish and can be cleaned up quite significantly, and the current form both violates
strict and produces warnings. A bit of rearranging also makes it much easier to grok. Here's a cleaned up version:
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;
++ 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.
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.