view release on metacpan or  search on metacpan

bin/mimic  view on Meta::CPAN

#!perl

our $DATE = '2015-10-25'; # DATE
our $VERSION = '0.01'; # VERSION

# 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 {
        _explain($_[1]);
        exit 0;
    },
    'list|l' => sub {
        _list();
        exit 0;
    },
    'check|c' => sub {
        $mode = 'check';
    },
    'reverse|r' => sub {
        $mode = 'reverse';
    },
);

_mimic();

1;
# ABSTRACT: Replace some characters with their Unicode homoglyphs
# PODNAME: mimic

__END__

=pod

=encoding UTF-8

=head1 NAME

mimic - Replace some characters with their Unicode homoglyphs

=head1 VERSION

This document describes version 0.01 of mimic (from Perl distribution App-mimic), released on 2015-10-25.

=head1 SYNOPSIS

Usage:

 % mimic --list           # Show all of the homoglyphs
 % mimic --explain=o      # What crazy things can we do with this letter?
 % mimic --me-harder 100  # Type some lines in and mess with every single char
 % mimic --reverse        # Undo the mayhem. Boooring.
 % cat somefile | mimic   # Pipe some source through at 1%

 # Turn up the knob and save the results
 % cat somefile | mimic --me-harder 25 > mimicked

 # Find out exactly where we broke the source
 % cat mimicked | mimic --check | less

 # Now we know the source is broken, so fix it
 % cat mimicked | mimic --reverse > fixedfile

 # This should output nothing (i.e. the files are the same)
 % diff fixedfile somefile

=head1 DESCRIPTION