File Coverage

blib/lib/App/FilterUtils/unpt.pm
Criterion Covered Total %
statement 27 52 51.9
branch 0 6 0.0
condition n/a
subroutine 9 14 64.2
pod 3 3 100.0
total 39 75 52.0


line stmt bran cond sub pod time code
1 1     1   979 use strict;
  1         1  
  1         37  
2 1     1   4 use warnings;
  1         1  
  1         39  
3             package App::FilterUtils::unpt;
4             # ABSTRACT: Strip all dots on Arabic letters in input
5             our $VERSION = '0.002'; # VERSION
6 1     1   4 use base 'App::Cmd::Simple';
  1         2  
  1         106  
7 1     1   5 use utf8;
  1         2  
  1         4  
8 1     1   19 use charnames qw();
  1         2  
  1         26  
9 1     1   5 use open qw( :encoding(UTF-8) :std );
  1         2  
  1         4  
10              
11 1     1   234 use Getopt::Long::Descriptive;
  1         2  
  1         5  
12              
13 1     1   260 use utf8;
  1         2  
  1         3  
14 1     1   29 use Unicode::Normalize;
  1         2  
  1         303  
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__