#! /usr/bin/perl -CS

use warnings;
use strict;
use utf8;
use POSIX 'floor';

sub usage {
print <<\EoF;
Replace each letter with a randomly-chosen similar-looking glyph.
This is sometimes useful in social media, to make it difficult
for robots to interpret and/or translate the text.

Options include:
  -h    # print this message (and immediately exit)
  -s    # non-randomly replace every 2nd space with nbsp
  -w    # randomly use 'wacky' mapping (lots of diacritics)
  -p    # randomly use 'plain' mapping (no diacritics, looks nearly normal)
  -x    # exclude the identity transform wherever possible
        #  [otherwise it gets a percentage]

If no -s, -p, or -w, the default is -w.
-s can stand alone, or can be combined with -p or -w.

Example usage:
:; echo Es ist so weit gekommen | ransom-note -s  -p | od-unicode
====    E      ѕ      ␣      i      ѕ      t             s
       45    0455    a0     69    0455    74     20     73
====    ο      ␣      w      е      i      t             g
      03bf    a0     77    0435    69     74     20     67
====    е      k      o      m      m      e      n      ␊
      0435    6b     6f     6d     6d     65     6e     0a

See also:
  https://en.wikipedia.org/wiki/Greek_alphabet
  https://en.wikipedia.org/wiki/Armenian_alphabet
  https://en.wikipedia.org/wiki/Cyrillic_alphabets
  https://en.wikipedia.org/wiki/Latin_Extended-B
  https://en.wikipedia.org/wiki/IDN_homograph_attack
  https://www.irongeek.com/homoglyph-attack-generator.php
EoF
}

my $junk = <<EoF;
  00A0 : No-Break Space (NBSP)
  0456 : Cyrillic Small Letter Byelorussian-Ukrainian I
  0184 : Latin Capital Letter Tone Six
  057D : Armenian Small Letter Seh
EoF

my $nbsp = ' ';
my $openbox = '␣';

my $plain = {
  a => 'aа',
  b => 'bƄ',            ## Cyrillic ь ???
  c => 'cс',            ## roman numeral Ⅽ ⅽ (varies from font to font)??
  e => 'eе',
  g => 'gց',
  h => 'h',
  i => 'iі',
  j => 'j',
  k => 'k',
  l => 'l',
  m => 'mⅿ',
  n => 'n',
  o => 'oοоօ',
  p => 'pр',
  q => 'q',
  r => 'r',
  s => 'sѕ',
  t => 't',
  u => 'uս',
  v => 'v',
  w => 'wѡ',
  x => 'xх',
  y => 'yу',
  z => 'z',
};

my $wacky = {
  a => 'aàáâãäåą',
  b => 'bьβƀ',
  c => 'cçčƈ',
  d => 'dðδ',
  e => 'eèéêëęěε',
  f => 'fƒ',
  g => 'gǥǧ',
  i => 'iìíîï',
  j => 'jǰ',
  k => 'kкǩ',
  l => 'lłƚ',
  n => 'nñńǹ',
  o => 'oòóôõöø',
  p => 'pþƥ',
  r => 'rȑȓ',
  s => 'sśš',
  t => 'tƫț',
  u => 'uùúûü',
  w => 'wω',
  x => 'x×',
  y => 'yýÿýƴ',
  z => 'zżžȥ',
};

main: {
  my $xmode = 0;
  my $spmode = 0;
  my $map = 0;
  while (@ARGV) {
    my $arg = shift @ARGV;
    if ($arg eq '-h') {
      usage();
      exit;
    }
    elsif ($arg =~ '^-s') {
      $spmode++;
    }
    elsif ($arg =~ '^-x') {
      $xmode++;
    }
    elsif ($arg =~ '^-p') {
      $map = $plain;
    }
    elsif ($arg =~ '^-w') {
      $map = $wacky;
    }
    else {
      die "Unrecognized arg '$arg'\n";
    }
  }
  if (!$map && !$spmode) {
    $map = $wacky;
  }
  my $sphase = 0;
  while (my $line = <>) {
    chomp $line;
    my $rslt = '';
    for my $let (split('', $line)) {
      if ($spmode && $let eq ' ') {
        $rslt .= ($sphase++ & 1) ? $let : $nbsp;
      }
      elsif ($map) {
        my $str = $map->{$let} // $let;
        my $len = length($str);
        if ($xmode && $len > 1) {
          $str = substr($str, 1);
          $len--;
        }
        my $where = floor($len*rand());
        $rslt .= substr($str,$where,1);
      }
      else {
        $rslt .= $let;
      }
    }
    print $rslt, "\n";
  }
}