| line | stmt | bran | cond | sub | pod | time | code | 
| 1 | 1 |  |  | 1 |  | 928 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 25 |  | 
| 2 | 1 |  |  | 1 |  | 4 | use warnings; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 38 |  | 
| 3 |  |  |  |  |  |  | package App::FilterUtils::unpt; | 
| 4 |  |  |  |  |  |  | # ABSTRACT: Strip all dots on Arabic letters in input | 
| 5 |  |  |  |  |  |  | our $VERSION = '0.001'; # VERSION | 
| 6 | 1 |  |  | 1 |  | 4 | use base 'App::Cmd::Simple'; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 91 |  | 
| 7 | 1 |  |  | 1 |  | 5 | use utf8; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 4 |  | 
| 8 | 1 |  |  | 1 |  | 20 | use charnames qw(); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 14 |  | 
| 9 | 1 |  |  | 1 |  | 3 | use open qw( :encoding(UTF-8) :std ); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 4 |  | 
| 10 | 1 |  |  | 1 |  | 234 | use Module::Load qw(load); | 
|  | 1 |  |  |  |  | 5 |  | 
|  | 1 |  |  |  |  | 5 |  | 
| 11 | 1 |  |  | 1 |  | 48 | use Getopt::Long::Descriptive; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 4 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 1 |  |  | 1 |  | 252 | use utf8; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 3 |  | 
| 14 | 1 |  |  | 1 |  | 24 | use Unicode::Normalize; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 341 |  | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | =pod | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | =encoding utf8 | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | =head1 NAME | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | unpt - Strip all dots on Arabic letters in input | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | $ echo "خوخ" | unpt | 
| 27 |  |  |  |  |  |  | حوح | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | =head1 OPTIONS | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | =head2 version / v | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | Shows the current version number | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | $ unpt --version | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | =head2 help / h | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | Shows a brief help message | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | $ unpt --help | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | =cut | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | sub opt_spec { | 
| 46 |  |  |  |  |  |  | return ( | 
| 47 | 0 |  |  | 0 | 1 |  | [ 'version|v'    => "show version number"                               ], | 
| 48 |  |  |  |  |  |  | [ 'help|h'       => "display a usage message"                           ], | 
| 49 |  |  |  |  |  |  | ); | 
| 50 |  |  |  |  |  |  | } | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | sub validate_args { | 
| 53 | 0 |  |  | 0 | 1 |  | my ($self, $opt, $args) = @_; | 
| 54 |  |  |  |  |  |  |  | 
| 55 | 0 | 0 |  |  |  |  | if ($opt->{'help'}) { | 
|  |  | 0 |  |  |  |  |  | 
| 56 | 0 |  |  |  |  |  | my ($opt, $usage) = describe_options( | 
| 57 |  |  |  |  |  |  | $self->usage_desc(), | 
| 58 |  |  |  |  |  |  | $self->opt_spec(), | 
| 59 |  |  |  |  |  |  | ); | 
| 60 | 0 |  |  |  |  |  | print $usage; | 
| 61 | 0 |  |  |  |  |  | print "\n"; | 
| 62 | 0 |  |  |  |  |  | print "For more detailed help see 'perldoc App::FilterUtils::unpt'\n"; | 
| 63 |  |  |  |  |  |  |  | 
| 64 | 0 |  |  |  |  |  | print "\n"; | 
| 65 | 0 |  |  |  |  |  | exit; | 
| 66 |  |  |  |  |  |  | } | 
| 67 |  |  |  |  |  |  | elsif ($opt->{'version'}) { | 
| 68 | 0 |  |  |  |  |  | print $App::FilterUtils::unpt::VERSION, "\n"; | 
| 69 | 0 |  |  |  |  |  | exit; | 
| 70 |  |  |  |  |  |  | } | 
| 71 |  |  |  |  |  |  |  | 
| 72 | 0 |  |  |  |  |  | return; | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | sub execute { | 
| 76 | 0 |  |  | 0 | 1 |  | my ($self, $opt, $args) = @_; | 
| 77 |  |  |  |  |  |  |  | 
| 78 | 0 | 0 |  | 0 |  |  | my $readarg = @$args ? sub { shift @$args } : sub {  }; | 
|  | 0 |  |  | 0 |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 79 | 0 |  |  |  |  |  | while (defined ($_ = $readarg->())) { | 
| 80 | 0 |  |  |  |  |  | chomp; | 
| 81 | 0 |  |  |  |  |  | $_ = NFD($_) =~ s/\p{Mn}//rg; # strip tashkeel | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | # handle special cases | 
| 84 | 0 |  |  |  |  |  | s/ك\b/لـ/g; | 
| 85 | 0 |  |  |  |  |  | s/[نڹڻڼڽ](?!\b)/ٮ/g; | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | tr # strip dots in arabic | 
| 88 | 0 |  |  |  |  |  | {بتث جخ ذ ز ش ض ظ غ ف ق ن ة ي } | 
| 89 |  |  |  |  |  |  | {ٮٮٮ حح د ر س ص ط ع ڡ ٯ ں ه ى }; | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | tr # strip in other langs | 
| 92 | 0 |  |  |  |  |  | {ٹٺٻټٽپٿڀ ځڂڃڿڄڅچڇ ڈډڊڋڌڍڎڏڐ ڑڒړڔڕږڗژڙ ښڛڜ ڝڞ ڟ ڠ ڡڢڣڤڥڦ ڧڨ ػؼ ڵڶڷڸ ڹڻڼڽ ۀہۂۃ ۄۅۆۇۏۈۉۊۋ ۍؽؾؿێېۑ ۓ} | 
| 93 |  |  |  |  |  |  | {ٮٮٮٮٮٮٮٮ حححححححح ددددددددد ررررررررر سسس صص ط ع ڡڡڡڡڡڡ ٯٯ كك لللل ںںںں هههه ووووووووو ىىىىىىى ے}; | 
| 94 |  |  |  |  |  |  |  | 
| 95 | 0 |  |  |  |  |  | print $_, "\n"; | 
| 96 |  |  |  |  |  |  | } | 
| 97 |  |  |  |  |  |  |  | 
| 98 | 0 |  |  |  |  |  | return; | 
| 99 |  |  |  |  |  |  | } | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | 1; | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | __END__ |