Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

comment on

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

In reply to Satanizer by kaatunut

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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 or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2022-01-21 12:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:












    Results (57 votes). Check out past polls.

    Notices?