1: #!/usr/bin/perl -w 2: 3: # Feel need to prove someone's satan's pawn? 4: # This script mutilates given name to make the 5: # sum of ASCII codes 666 (or any number for that). 6: # Currently quite limited in mutilation strength, I ran 7: # out of interest. 8: 9: $debug=0; 10: 11: @number=(666); 12: $verbose=1; 13: $quitfirst=0; 14: $viewnumber=0; 15: $factual=0; 16: $listnumber=0; 17: 18: while (@ARGV) { 19: $t = shift(@ARGV); 20: 21: if ($t eq "-help") { 22: print<<END_OF_HELP 23: Usage: satanizer.pl [parameters] <name> 24: 25: "Here is the wisdom. Let him that hath understanding count the number of 26: the beast; for it is the number of a man; and his number is 27: Six hundred threescore and six" 28: 29: This program will help you in easily identifying the people who carry 30: Shai'tan, the Prince of Lies, in their heart through the number of 666. 31: Just supply the name of person to be examined on the command line and 32: program will report his true loyalties. 33: 34: Parameters: 35: 36: -number NUM[,NUM...] Use alternative number(s) instead of 666. You 37: may also supply multiple numbers, in which 38: case all of them will be checked. 39: -silent Output only matching names, name-per-line, no 40: useless babble included. 41: -stop In case of multiple numbers, stop after first 42: matching number. 43: -list-number Under -silent, append the number that matched 44: after the name in output. 45: -view-number Report which number the person would match to 46: without mutilation. 47: -proper Speak sensibly. 48: -file FILE Get the names to be used from FILE, name per 49: line. Further names on command line will be 50: ignored. 51: 52: DISCLAIMER: If you are offended by this program, I laugh at you. Please 53: send emails condemning me to hell for blashpemy to kaatunut\@iki.fi, I 54: will enjoy them. 55: 56: Send bug reports to kaatunut\@iki.fi. 57: END_OF_HELP 58: ; 59: exit; 60: } elsif ($t eq "-version") { 61: print<<END_OF_TEXT 62: Satanize 0.1 63: 64: (c) 2000, Juhan Aslak Näkkäläjärvi 65: 66: This program is free software, and is under the GPL license. 67: END_OF_TEXT 68: } elsif ($t eq "-number") { 69: @number=split /,/,shift(@ARGV); 70: } elsif ($t eq "-silent") { 71: $verbose=0; 72: } elsif ($t eq "-stop") { 73: $quitfirst=1; 74: } elsif ($t eq "-list-number") { 75: $listnumber=1; 76: } elsif ($t eq "-view-number") { 77: $viewnumber=1; 78: } elsif ($t eq "-proper") { 79: $factual=1; 80: } elsif ($t eq "-file") { 81: $filename=shift(@ARGV); 82: open(FILE,$filename) or die "can't open $filename!"; 83: push @name,$_ while (<FILE>); 84: close(FILE); 85: chomp @name; 86: } elsif (substr($t,0,1) eq "-") { 87: print "Unknown parameter \'$t\'.\n"; 88: } elsif (!@name) { 89: $name[0]=$t; 90: while (@ARGV) { 91: $name[0].=" ".shift(@ARGV); 92: } 93: } 94: } 95: if (!defined $listnumber) { 96: if (!$verbose && !$quitfirst) { 97: $listnumber=0; 98: } else { 99: $listnumber=1; 100: } 101: } 102: 103: if (!@name) { 104: print "You need to supply a name.\n"; 105: exit; 106: } 107: 108: for $j (0 .. $#name) { 109: for $i (0 .. $#number) { 110: my $t; 111: 112: $ret=satanize($name[$j],$number[$i],\$mutilation,\$t,0); 113: 114: if ($viewnumber) { 115: print "$name[$j]\'s number is $t\n"; 116: $viewnumber=0; 117: } 118: 119: if (!$ret) { 120: if (satanize($mutilation,$number[$i],0,\$t,1),$t!=$number[$i]) { 121: die "satanization failure"; 122: } 123: if ($verbose) { 124: if ($factual) { 125: print "$mutilation matches to $number[$i].\n"; 126: } elsif ($number[$i]==666) { 127: print "$mutilation is the Satan's incarnate on earth!\n"; 128: } else { 129: print "$mutilation was born to the number $number[$i].\n"; 130: } 131: } else { 132: print "$mutilation"; 133: print " - $number[$i]" if $listnumber; 134: print "\n"; 135: } 136: last if $quitfirst; 137: } elsif ($verbose) { 138: if ($ret==1) { 139: if ($factual) { 140: print 141: "$name[$j] cannot be made to have asciisum of $number[$i] by any currently ". 142: "used mutilation methods. Try changing non-trivial spelling (ie. letters).\n"; 143: } elsif ($number[$i]==666) { 144: print 145: "$name[$j]\'s waveform seems to indicate that it is a human. It might be a ". 146: "guise though, try changing some letters in the name.\n"; 147: } else { 148: print 149: "$name[$j]\'s waveform does not match to number $number[$i].\n"; 150: } 151: } elsif ($ret==2) { 152: if ($factual) { 153: print 154: "$name[$j] has too few non-whitespaces to reach $number[$i]. Try adding some.\n"; 155: } elsif ($number[$i]==666) { 156: print 157: "$name[$j] has some satanic breed but it lacks strength.\n"; 158: } else { 159: print 160: "$name[$j] has shown potential tendencies towards number $number[$i], but it ". 161: "has no power to reach that.\n"; 162: } 163: } elsif ($ret==3) { 164: if ($factual) { 165: print 166: "$name[$j] has too many non-whitespaces to reach $number[$i]. Try removing some.\n"; 167: } elsif ($number[$i]==666) { 168: print 169: "$name[$j] has some satanic breed but it cannot contain its powers.\n"; 170: } else { 171: print 172: "$name[$j] has shown potential tendencies towards number $number[$i], but it ". 173: "cannot contain its powers.\n"; 174: } 175: } else { 176: print "ACK! $name[$j] must be Satan Himself, you shouldn't ". 177: "see this message ever :(\n"; 178: } 179: } 180: } 181: } 182: ## satanize(name,number,outname,outnumber,short) 183: sub satanize { 184: my($name,$number)=@_; 185: my $num=0; 186: my $times=0; 187: my $lcase_num=0,$ucase_num=0,$space_num=0; 188: my($c,$i,@upl,@downl,@spacel); 189: 190: for $i (0 .. (length $name)-1) { 191: $c=substr($name,$i,1); 192: $num+=ord $c; 193: if ($c eq " ") { 194: $space_num++; 195: push @spacel,$i; 196: } elsif ($c ne uc $c) { 197: $lcase_num++; 198: push @downl,$i; 199: } elsif ($c ne lc $c) { 200: $ucase_num++; 201: push @upl,$i; 202: } 203: } 204: 205: ${$_[3]}=$num if $viewnumber || $_[4]; 206: return $num if $_[4]; 207: 208: if ($num==$number) { 209: ${$_[2]}=$name; 210: return 0; 211: } 212: 213: if ((abs($number-$num) % abs(ord('a')-ord('A')))) { 214: print "nondivisible\n" if $debug; 215: return 1; # not divisible 216: } 217: $times=($number-$num)/abs(ord('a')-ord('A')); 218: if (($times<0 && (-$times)>($lcase_num+$space_num)) || 219: ($times>0 && $times>$ucase_num)) { 220: print "not enough space: $times transformations needed\n" if $debug; 221: return 2 if $times>0; 222: return 3 if $times<0; 223: } 224: # capitalizing rule: find existing capitalized points and start adding to them 225: # decapitalizing rule: drop capitalized letters randomly 226: # spacing rule: remove random spaces after everything is capitalized 227: ${$_[2]}=$name; 228: if ($times<0) { # Capitalize 229: my $p=0; 230: if (!@upl || $upl[0]!=0) { 231: splice @upl,0,0,-1; 232: } 233: print "capitalize $times times\n" if $debug; 234: while ($times && @upl) { 235: do { 236: $upl[$p]++; 237: if ($upl[$p]>=(length ${$_[2]}) 238: || (substr(${$_[2]},$upl[$p],1) 239: ne lc substr(${$_[2]},$upl[$p],1))) { 240: # kill this pointer (and move to next in row): 241: # at the end of string or at ucase character 242: print "kill pointer $p at $upl[$p]\n" if $debug; 243: splice @upl,$p,1; 244: if (@upl) { 245: $p=0 if $p > $#upl; 246: redo; 247: } else { 248: print "break\n" if $debug; 249: last; 250: } 251: } elsif (substr(${$_[2]},$upl[$p],1) 252: eq uc substr(${$_[2]},$upl[$p],1)) { 253: # ignore: uppercase or special character- 254: # but uppercase was checked above so spec char 255: redo; 256: } 257: } while (0); 258: last if not @upl; 259: substr(${$_[2]},$upl[$p],1)=uc substr(${$_[2]},$upl[$p],1); 260: print " =>${$_[2]}\n" if $debug; 261: $p++; 262: $p=0 if $p>=@upl; 263: print "p now: $p\n" if $debug; 264: $times++; 265: } 266: if ($times) { # time to remove some spaces! 267: my @kill_list; 268: while ($times) { 269: $p=int rand @spacel; 270: push @kill_list,$spacel[$p]; 271: splice @spacel,$p,1; 272: $times++; 273: } 274: @kill_list=reverse sort @kill_list; 275: print "kill ".@kill_list." spaces\n" if $debug; 276: for $i (0 .. $#kill_list) { 277: substr(${$_[2]},$kill_list[$i],1)=""; 278: } 279: } 280: return 0; 281: } else { 282: my $p; 283: print "decapitalize $times times\n" if $debug; 284: while ($times) { 285: $p=int rand @upl; 286: substr(${$_[2]},$upl[$p],1)=lc substr(${$_[2]},$upl[$p],1); 287: splice @upl,$p,1; 288: $times--; 289: } 290: return 0; 291: } 292: print "bug- shouldn't be here\n"; 293: return 100; 294: }
|
---|
Replies are listed 'Best First'. | |
---|---|
(brainpan) RE: Satanizer
by brainpan (Monk) on Nov 12, 2000 at 15:09 UTC | |
Re: Satanizer
by radagast (Sexton) on Dec 01, 2000 at 14:07 UTC | |
by t0mas (Priest) on Dec 01, 2000 at 15:57 UTC |
Back to
Craft