| line | stmt | bran | cond | sub | pod | time | code | 
| 1 | 1 |  |  | 1 |  | 1577 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 25 |  | 
| 2 | 1 |  |  | 1 |  | 4 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 39 |  | 
| 3 |  |  |  |  |  |  | package App::FilterUtils::2u; | 
| 4 |  |  |  |  |  |  | # ABSTRACT: Show Unicode charnames | 
| 5 |  |  |  |  |  |  | our $VERSION = '0.001'; # VERSION | 
| 6 | 1 |  |  | 1 |  | 4 | use base 'App::Cmd::Simple'; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 102 |  | 
| 7 | 1 |  |  | 1 |  | 5 | use utf8; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 5 |  | 
| 8 | 1 |  |  | 1 |  | 19 | use charnames qw(); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 16 |  | 
| 9 | 1 |  |  | 1 |  | 4 | use open qw( :encoding(UTF-8) :std ); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 6 |  | 
| 10 | 1 |  |  | 1 |  | 257 | use Module::Load qw(load); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 11 | 1 |  |  | 1 |  | 85 | use Getopt::Long::Descriptive; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 1 |  |  | 1 |  | 304 | use utf8; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 3 |  | 
| 14 | 1 |  |  | 1 |  | 30 | use charnames qw(); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 359 |  | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | =pod | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | =encoding utf8 | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | =head1 NAME | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | 2u - Show Unicode charnames | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | $ echo 👨🎓 | 2u | 
| 27 |  |  |  |  |  |  | MAN <👨>  128104, Hex 1f468, Octal 372150 | 
| 28 |  |  |  |  |  |  | ZERO WIDTH JOINER <>  8205, Hex 200d, Octal 20015 | 
| 29 |  |  |  |  |  |  | GRADUATION CAP <🎓>  127891, Hex 1f393, Octal 371623 | 
| 30 |  |  |  |  |  |  | $ 2u U+200e | 
| 31 |  |  |  |  |  |  | LEFT-TO-RIGHT MARK <>  8206, Hex 200e, Octal 20016 | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | =head1 OPTIONS | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | =head2 version / v | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | Shows the current version number | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | $ 2u --version | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | =head2 help / h | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | Shows a brief help message | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | $ 2u --help | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | =cut | 
| 48 |  |  |  |  |  |  |  | 
| 49 | 0 |  |  | 0 | 1 |  | sub usage_desc { "2u [character ... | codepoint]" } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | sub opt_spec { | 
| 52 |  |  |  |  |  |  | return ( | 
| 53 | 0 |  |  | 0 | 1 |  | [ 'version|v'    => "show version number"                               ], | 
| 54 |  |  |  |  |  |  | [ 'help|h'       => "display a usage message"                           ], | 
| 55 |  |  |  |  |  |  | ); | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | sub validate_args { | 
| 59 | 0 |  |  | 0 | 1 |  | my ($self, $opt, $args) = @_; | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 0 | 0 |  |  |  |  | if ($opt->{'help'}) { | 
|  |  | 0 |  |  |  |  |  | 
| 62 | 0 |  |  |  |  |  | my ($opt, $usage) = describe_options( | 
| 63 |  |  |  |  |  |  | usage_desc(), | 
| 64 |  |  |  |  |  |  | $self->opt_spec(), | 
| 65 |  |  |  |  |  |  | ); | 
| 66 | 0 |  |  |  |  |  | print $usage; | 
| 67 | 0 |  |  |  |  |  | print "\n"; | 
| 68 | 0 |  |  |  |  |  | print "For more detailed help see 'perldoc App::FilterUtils::2u'\n"; | 
| 69 |  |  |  |  |  |  |  | 
| 70 | 0 |  |  |  |  |  | print "\n"; | 
| 71 | 0 |  |  |  |  |  | exit; | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  | elsif ($opt->{'version'}) { | 
| 74 | 0 |  |  |  |  |  | print $App::FilterUtils::2u::VERSION, "\n"; | 
| 75 | 0 |  |  |  |  |  | exit; | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  |  | 
| 78 | 0 |  |  |  |  |  | return; | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | sub execute { | 
| 82 | 0 |  |  | 0 | 1 |  | my ($self, $opt, $args) = @_; | 
| 83 |  |  |  |  |  |  |  | 
| 84 | 0 | 0 |  | 0 |  |  | my $readarg = @$args ? sub { shift @$args } : sub {  }; | 
|  | 0 |  |  | 0 |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 85 | 0 |  |  |  |  |  | while (defined ($_ = $readarg->())) { | 
| 86 | 0 |  |  |  |  |  | chomp; | 
| 87 | 0 | 0 |  |  |  |  | $_ = chr hex $1 if /^U\+([[:xdigit:]]+)$/; | 
| 88 | 0 |  |  |  |  |  | for (split '') { | 
| 89 | 0 |  |  |  |  |  | $_ = ord; | 
| 90 | 0 |  |  |  |  |  | printf "%s <%c>  %d, Hex %x, Octal %o\n", charnames::viacode($_), ($_)x4; | 
| 91 |  |  |  |  |  |  | } | 
| 92 | 0 |  |  |  |  |  | print "\n"; | 
| 93 |  |  |  |  |  |  | } | 
| 94 |  |  |  |  |  |  |  | 
| 95 | 0 |  |  |  |  |  | return; | 
| 96 |  |  |  |  |  |  | } | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | 1; | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | __END__ |