view release on metacpan or  search on metacpan

bin/mimic  view on Meta::CPAN

# IFUNBUILT
# use strict;
# END IFUNBUILT

use Getopt::Long::EvenLess qw(GetOptions);

my $mode = 'mimic';
my $percentage = 1;

my $sh = "\x{02591}"; # shade character

sub _list {
    require Unicode::Homoglyph;

    my $all_hgs = \@Unicode::Homoglyph::Homoglyphs;

    for my $hg (@$all_hgs) {
        print $sh, (map {$_, $sh} sort keys %$hg), "\n";
    }
}

sub _explain {
    require charnames;
    require Unicode::Homoglyph;
    require Unicode::Normalize;
    require Unicode::UCD;
    no strict 'refs';

    my $wanted = $_[0];
    my $all_hgs = \@Unicode::Homoglyph::Homoglyphs;

    for my $hg (@$all_hgs) {
        if (exists $hg->{$wanted}) {
            print "Char\t Point               Normal Cat Name\n";
            for my $ch (sort keys %$hg) {
                my $ord = ord $ch;
                printf("%s\tU+%04X %20s %3s %s\n",
                       $sh . $ch . $sh,
                       $ord,
                       join(" ", map {
                           my $norm = &{"Unicode::Normalize::$_"}($ch);
                           $norm eq $ch ? $_ : $norm;
                       } (qw(NFC NFKC NFD NFKD))),
                       Unicode::UCD::charinfo($ord)->{category},
                       charnames::viacode($ord),
                   );
            }
            return;
        }
    }
    print "No homoglyphs.\n";
}

sub _mimic {
    require Unicode::Homoglyph;

    my $all_hgs = \@Unicode::Homoglyph::Homoglyphs;

    my %uni_homoglyphs; # key=ascii, val=[hg1, hg2, ...]
    my %asciis;         # key=unicode homoglyph, val=ascii
    for my $hg (@$all_hgs) {
        my @chars = sort keys %$hg;
        my $ascii = shift @chars;
        $uni_homoglyphs{$ascii} = \@chars;
        if ($mode ne 'mimic') {
            for (@chars) {
                $asciis{$_} = $ascii;
            }
        }
    }

    my $re;
    if ($mode eq 'mimic') {
        $re = "(?:" . join("|", map {quotemeta} sort keys %uni_homoglyphs) . ")";
        $re = qr/$re/o;
        while (<>) {
            s/($re)/rand()*100 < $percentage ?
                $uni_homoglyphs{$1}[rand()*@{ $uni_homoglyphs{$1} }] : $1/eg;
            print;
        }
    } else {
        $re = "(?:" . join("|", map {sprintf("\\x{%04X}", ord($_))} sort keys %asciis). ")";
        $re = qr/$re/o;
        if ($mode eq 'reverse') {
            while (<>) {
                s/($re)/$asciis{$1}/eg;
                print;
            }
        } else { # check
            while (<>) {
                s/($re)/sprintf "<%s:U+%04X>", $1, ord($1)/eg;
                print;
            }
        }
    }
}

binmode(STDIN , ":utf8");
binmode(STDOUT, ":utf8");
GetOptions(
    '--help|h' => sub {
        print <<'_';
Usage: mimic [options]

Options:
  -h, --help            show this help message and exit
  -m CHANCE, --me-harder=CHANCE
                        replacement percent
  -e CHAR, --explain=CHAR
                        show a char's homoglyphs
  -l, --list            show all homoglyphs
  -c, --check           check input for suspicious chars
  -r, --reverse         reverse operation, clean a mimicked file
_
        exit 0;
    },
    'me-harder|m=s' => sub {
        $percentage = $_[1];
    },
    'explain|e=s' => sub {