File Coverage

blib/lib/App/FilterUtils/2base.pm
Criterion Covered Total %
statement 30 65 46.1
branch 0 22 0.0
condition 0 9 0.0
subroutine 10 15 66.6
pod 4 4 100.0
total 44 115 38.2


line stmt bran cond sub pod time code
1 1     1   46780 use strict;
  1         8  
  1         24  
2 1     1   4 use warnings;
  1         3  
  1         67  
3             package App::FilterUtils::2base;
4             # ABSTRACT: Convert bases
5             our $VERSION = '0.001'; # VERSION
6 1     1   11 use base 'App::Cmd::Simple';
  1         2  
  1         282  
7 1     1   27907 use utf8;
  1         13  
  1         4  
8 1     1   309 use charnames qw();
  1         23194  
  1         23  
9 1     1   301 use open qw( :encoding(UTF-8) :std );
  1         853  
  1         5  
10 1     1   8522 use Module::Load qw(load);
  1         846  
  1         6  
11 1     1   393 use Getopt::Long::Descriptive;
  1         17962  
  1         6  
12              
13 1     1   266 use utf8;
  1         2  
  1         5  
14 1     1   320 use Math::BaseCnv;
  1         40731  
  1         594  
15              
16             =pod
17              
18             =encoding utf8
19              
20             =head1 NAME
21              
22             2base - Convert bases
23              
24             =head1 SYNOPSIS
25              
26             $ 2base 16 16
27             10
28              
29             =head1 OPTIONS
30              
31             =head2 thousands / t
32              
33             Use SI thousands prefixes instead of binary ones
34              
35             $ 2base -t 10 1K
36             1000
37              
38             =head2 delimiters / d
39              
40             Use delimiters for bigger numbers
41              
42             $ 2base -d 2 100000
43             1_1000_0110_1010_0000
44              
45             =head2 version / v
46              
47             Shows the current version number
48              
49             $ 2base --version
50              
51             =head2 help / h
52              
53             Shows a brief help message
54              
55             $ 2base --help
56              
57             =cut
58              
59 0     0 1   sub usage_desc { "2base %o [number ...]" }
60              
61             sub opt_spec {
62             return (
63 0     0 1   [ 'thousands|t' => "Use SI thousands prefixes instead of binary ones" ],
64             [ 'delimiters|d' => "Use delimiters for bigger numbers" ],
65             [ 'version|v' => "show version number" ],
66             [ 'help|h' => "display a usage message" ],
67             );
68             }
69              
70             sub validate_args {
71 0     0 1   my ($self, $opt, $args) = @_;
72              
73 0 0 0       if ($opt->{'help'} || !@$args) {
    0          
74 0           my ($opt, $usage) = describe_options(
75             usage_desc(),
76             $self->opt_spec(),
77             );
78 0           print $usage;
79 0           print "\n";
80 0           print "For more detailed help see 'perldoc App::FilterUtils::2base'\n";
81              
82 0           print "\n";
83 0           exit;
84             }
85             elsif ($opt->{'version'}) {
86 0           print $App::FilterUtils::2base::VERSION, "\n";
87 0           exit;
88             }
89              
90 0           return;
91             }
92              
93             sub execute {
94 0     0 1   my ($self, $opt, $args) = @_;
95              
96 0           my $base = shift @$args;
97              
98 0           my %power_of = ( K => 1, M => 2, G => 3, T => 4 );
99 0 0         my $suffix_base = $opt->{thousands} ? 1000 : 1024;
100              
101 0 0   0     my $readarg = @$args ? sub { shift @$args } : sub { };
  0            
  0            
102 0           while (defined ($_ = $readarg->())) {
103 0           chomp;
104 0           s/[,_']//g;
105 0 0         unless (/%/) {
106 0 0         $_ .= s/^0b// ? '%2'
    0          
    0          
107             : s/^0x// ? '%16'
108             : s/^0o?// ? '%8'
109             : '%10'
110             }
111              
112 0           s/(.*?)([KMGT])/$1*($suffix_base**$power_of{$2})/gie;
  0            
113 0           s/(.*?)(?=%\d+)/$1/ge;
  0            
114              
115 0 0         $_ = length if s/%1$//;
116 0           my $num = reverse cnv((split /%/) => $base);
117 0 0 0       $num =~ s/(...)(?=.)/$1,/g if $opt->{delimiters} && $base == 10;
118 0 0 0       $num =~ s/(....)(?=.)/$1_/g if $opt->{delimiters} && $base =~ /^(2|8|16)$/;
119 0           print scalar reverse($num), "\n";
120             }
121              
122 0           return;
123             }
124              
125             1;
126              
127             __END__