Okay, so it's not the best code ever, and I wouldn't have started it were it not for Acme::Bleach, but it made me chuckle, and it is Friday :)
NOTE 1: like Bleach, this overwrites your source code on first run.
NOTE 2: The correct pronunciation is 'shin'-'ing', (do you want us to be sued?) :)
#!/usr/bin/perl
use Acme::The_Shining;
all wOrK anD NO play mAKEs jAck A DuLl bOy
ALl WORk aND No Play mAkes jack A dulL boY.
alL work ANd nO pLaY MAkeS jaCK a dUlL boY.
alL WOrK ANd nO PlaY makes jAck A dUll BOy.
ALL WoRK aNd no pLAy MAKes JAcK A DulL BOY.
alL woRk and No PlAY MakeS JaCK A dulL boy.
All wORK aND
I'm sure that this can be done a lot more efficiently, but I only did it for giggles, so all you golfers out there
please feel free to knock this down to 6 characters.
Very simply, it encodes the original program in to a binary represention using uppercase for 1's and lowercase for 0's.
here's the source...
package Acme::The_Shining;
$VERSION = '0.01';
my $template = "\nall work and no play makes jack a dull boy.";
my $buff = reverse $template;
sub encode { while ($_[0] =~ m/(.)/sg) { foreach my $bit (split //, sp
+rintf
"%08b", ord($1)) { while(1){($char = get_char()) !~ /[a-z]/ or last;
+ $rts
.= $char;} $rts .= $bit ? uc($char) : $char; } }$rts }
sub decode { while ($_[0] =~ m/(.)/sg) { my $char = $1; next if $char
+!~
m/[a-z]/i; $bin .= $char eq uc $char ? 1 : 0;if (length($bin) == 8 )
+ {
$rts .= chr(to_dec($bin)); $bin = ""; } }$rts }
sub get_char {$buff=length($buff)<2 ? $buff. reverse$template:$buff;ch
+op $buff}
sub to_dec { return unpack("N", pack("B32", substr("0" x 32 . shift, -
+32))) }
sub is_shiny { $_[0] =~ m/^[abcdejklmnoprsuwy. \n]*$/si };
open 0 or print "Can't repolish '$0'\n" and exit;
my $pgm = join "", <0>;
my ($head,$code) = ($pgm =~ m/(.*^\s*use\s+Acme::The_Shining\s*;\n)(.*
+)/sm);
exit eval($head . "\n" . decode($code)) if is_shiny($code);
open 0, ">$0" or print "Can't polish '$0'\n" and exit;
print {0} $head, encode($code) and exit;
---
my name's not Keith, and I'm not reasonable.
