#!/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..... ............
In reply to Re: Perl script compressor
by clueless newbie
in thread Perl script compressor
by harangzsolt33
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |