#!/usr/bin/perl -w
use strict;
use warnings;
my$WRITE_FILE=0;
my$SELF=ReadFile(__FILE__);
my$SHRUNK=CompactPerl($SELF);
my$ORIGINAL_SIZE=length($SELF);
my$SHRUNK_SIZE=length($SHRUNK);
my$DIFF=$ORIGINAL_SIZE-$SHRUNK_SIZE;
print '>' x 78;
print"\n",$SHRUNK;
print '^' x 78;
print"\n\nFILE NAME   : ",__FILE__;
print"\nFILE SIZE   : $ORIGINAL_SIZE bytes";
print"\nSHRUNK SIZE : $SHRUNK_SIZE bytes";
WriteOutput($SHRUNK)if($WRITE_FILE);
if($SHRUNK_SIZE<$ORIGINAL_SIZE){print"\n\nYou could eliminate $DIFF by
+tes by compressing this script.\n";}print <<'END_OF_MESSAGE';

Wow, this script is amazing!
 * * * * * * * * * * * * * * * *
   Yes, it really is!  :D

END_OF_MESSAGE
exit;
sub CreateFile{defined$_[0]or return 0;
my$F=$_[0];
$F=~tr#\"\0*?|<>##d;
length($F)or return 0;
local*FH;
open(FH,">$F")or return 0;
binmode FH;
if(defined$_[1]?length($_[1]):0){print FH$_[1];}close FH or return 0;
print"\n$F was saved.\n";
return 1;}sub ReadFile{my$NAME=defined$_[0]?$_[0]:'';
$NAME=~tr/\"\0*?|<>//d;
-e$NAME or return '';
-f$NAME or return '';
my$SIZE=-s$NAME;
$SIZE or return '';
my$LEN=defined$_[2]?$_[2]:$SIZE;
$LEN>0 or return '';
local*FH;
sysopen(FH,$NAME,0)or return '';
binmode FH;
my$POS=defined$_[1]?$_[1]:0;
$POS<$SIZE or return '';
$POS<1 or sysseek(FH,0,$POS);
my$DATA='';
sysread(FH,$DATA,$LEN);
close FH;
return$DATA;}sub Trim{defined$_[0]or return '';
my$L=length($_[0]);
$L or return '';
my$P=0;
while($P<=$L&&vec($_[0],$P++,8)<33){}for($P--;$P<=$L&&vec($_[0],$L--,8
+)<33;){}substr($_[0],$P,$L-$P+2)}sub WriteOutput{defined$_[0]or retur
+n;
length($_[0])or return;
my$OUTPUT_FILENAME;
for(my$i=1;$i<100;$i++){$OUTPUT_FILENAME="compact$i.pl";
-e$OUTPUT_FILENAME or return CreateFile($OUTPUT_FILENAME,$_[0]);}}sub 
+EndsWithChar{(@_==2&&defined$_[0]&&defined$_[1]&&length($_[1])&&lengt
+h($_[0]))?(index($_[1],substr($_[0],length($_[0])-1))<0?0:1):0;}sub C
+ompactLine{defined$_[0]or return '';
length($_[0])or return '';
my$OUTPUT=Trim($_[0]);
$OUTPUT.="\n";
return$OUTPUT;}sub TrimOperators{defined$_[0]or return;
length($_[0])or return;
my$c;
my$OP='+-,.|&*/<>?:;!%^()[]{}=';
for(my$i=0;$i<length($OP);$i++){$c=substr($OP,$i,1);
$_[0]=~s/\s*\Q$c\E\s*/$c/g;}}sub CompactPerl{defined$_[0]or return '';
my$CODE=$_[0];
$CODE=~tr|\r||d;
my@A=split(/\n/,$CODE);
my$OP='+-,.|&*/<>?:;!%^()[]{}=';
my$STRIP;
my$P;
my$LINE;
my$TRIMMED;
my$END_MARKER='';
my$MULTILINE_STRING=0;
my$STOP=0;
$A[0].="\n";
for(my$i=1;$i<@A;$i++){$LINE=$A[$i];
$P=index($LINE,'#');
$STRIP=Trim(($P<0)?$LINE:substr($LINE,0,$P));
if($MULTILINE_STRING==0&&$STRIP=~m/\s*<<['"]+([_A-Za-z0-9]*)['"]+/){$E
+ND_MARKER=$1;$MULTILINE_STRING=2;$A[$i].="\n";next;}if($MULTILINE_STR
+ING==2){index($LINE,$END_MARKER)<0 or$MULTILINE_STRING=0;$A[$i].="\n"
+;next;}if($MULTILINE_STRING==0&&index($STRIP,'qq{')>=0){$MULTILINE_ST
+RING=1;}if($MULTILINE_STRING==1){if(index($LINE,'}')<0){$A[$i].="\n";
+}else{$MULTILINE_STRING=0;}next;}if($STRIP eq '__END__'){$STOP=1;$MUL
+TILINE_STRING=-1;}if($STOP==1){$A[$i]='';next;}if($MULTILINE_STRING==
+0&&$STRIP eq '__DATA__'){$A[$i]="\n__DATA__";$MULTILINE_STRING=3;}if(
+$MULTILINE_STRING==3){$A[$i].="\n";next;}if(length($STRIP)==0){$A[$i]
+='';next;}if($LINE=~m/[~\"\']+/){$A[$i]=CompactLine($LINE);
next;}$TRIMMED=Trim($STRIP);
$TRIMMED=~s/([a-z])\s+\(/$1\(/g;
$TRIMMED=~s/([a-z])\s+\%/$1\%/g;
$TRIMMED=~s/([a-z])\s+\$/$1\$/g;
$TRIMMED=~s/([a-z])\s+\@/$1\@/g;
TrimOperators($TRIMMED);
EndsWithChar($TRIMMED,$OP)or$TRIMMED.=' ';
$LINE or$LINE;
$A[$i]=$TRIMMED;}return join('',@A);} # sub CompactPerl
__DATA__
Everything after this point will not get compacted.
It gets written
   ....

 AS
  IS.    No change.

__END__  # This is the end of file and whatever
comes after this point gets discarded forever.....
............
[download]