File Coverage

blib/lib/Data/Unixish/sprintfn.pm
Criterion Covered Total %
statement 59 67 88.0
branch 10 18 55.5
condition 3 9 33.3
subroutine 16 16 100.0
pod 1 1 100.0
total 89 111 80.1


line stmt bran cond sub pod time code
1             package Data::Unixish::sprintfn;
2              
3 1     1   527 use 5.010;
  1         7  
4 1     1   446 use locale;
  1         600  
  1         5  
5 1     1   41 use strict;
  1         2  
  1         21  
6 1     1   413 use syntax 'each_on_array'; # to support perl < 5.12
  1         26157  
  1         7  
7 1     1   4123 use warnings;
  1         3  
  1         31  
8             #use Log::Any '$log';
9              
10 1     1   485 use Data::Unixish::Util qw(%common_args);
  1         3  
  1         125  
11 1     1   7 use POSIX qw(locale_h);
  1         3  
  1         8  
12 1     1   610 use Scalar::Util 'looks_like_number';
  1         3  
  1         42  
13 1     1   484 use Text::sprintfn ();
  1         985  
  1         369  
14              
15             our $VERSION = '1.571'; # VERSION
16              
17             our %SPEC;
18              
19             $SPEC{sprintfn} = {
20             v => 1.1,
21             summary => 'Like sprintf, but use sprintfn() from Text::sprintfn',
22             description => <<'_',
23              
24             Unlike in *sprintf*, with this function, hash will also be processed.
25              
26             _
27             args => {
28             %common_args,
29             format => {
30             schema=>['str*'],
31             cmdline_aliases => { f=>{} },
32             req => 1,
33             pos => 0,
34             },
35             skip_non_number => {
36             schema=>[bool => default=>0],
37             },
38             skip_array => {
39             schema=>[bool => default=>0],
40             },
41             skip_hash => {
42             schema=>[bool => default=>0],
43             },
44             },
45             tags => [qw/formatting itemfunc text/],
46             };
47             sub sprintfn {
48 1     1 1 4 my %args = @_;
49 1         3 my ($in, $out) = ($args{in}, $args{out});
50              
51 1         12 my $orig_locale = _sprintfn_begin(\%args);
52 1         6 while (my ($index, $item) = each @$in) {
53 4         13 push @$out, _sprintfn_item($item, \%args);
54             }
55 1         19 _sprintfn_end(\%args, $orig_locale);
56              
57 1         5 [200, "OK"];
58             }
59              
60             sub _sprintfn_begin {
61 2     2   4 my $args = shift;
62              
63 2         18 my $orig_locale = setlocale(LC_ALL);
64 2 50       12 if ($ENV{LC_NUMERIC}) {
    50          
    50          
65 0         0 setlocale(LC_NUMERIC, $ENV{LC_NUMERIC});
66             } elsif ($ENV{LC_ALL}) {
67 0         0 setlocale(LC_ALL, $ENV{LC_ALL});
68             } elsif ($ENV{LANG}) {
69 0         0 setlocale(LC_ALL, $ENV{LANG});
70             }
71 2         6 return $orig_locale;
72             }
73              
74             sub _sprintfn_item {
75 8     8   14 my ($item, $args) = @_;
76              
77             {
78 8 100       14 last unless defined($item);
  8         17  
79 6         12 my $r = ref($item);
80 6 50 33     17 if ($r eq 'ARRAY' && !$args->{skip_array}) {
81 1     1   8 no warnings;
  1         2  
  1         108  
82 0         0 $item = Text::sprintfn::sprintfn($args->{format}, @$item);
83 0         0 last;
84             }
85 6 100 66     56 if ($r eq 'HASH' && !$args->{skip_hash}) {
86 1     1   8 no warnings;
  1         2  
  1         86  
87 4         11 $item = Text::sprintfn::sprintfn($args->{format}, $item);
88 4         275 last;
89             }
90 2 50       5 last if $r;
91 2 50       6 last if $item eq '';
92 0 0 0     0 last if !looks_like_number($item) && $args->{skip_non_number};
93             {
94 1     1   8 no warnings;
  1         2  
  1         160  
  0         0  
95 0         0 $item = Text::sprintfn::sprintfn($args->{format}, $item);
96             }
97             }
98 8         47 return $item;
99             }
100              
101             sub _sprintfn_end {
102 2     2   6 my ($args, $orig_locale) = @_;
103 2         27 setlocale(LC_ALL, $orig_locale);
104             }
105              
106             1;
107             # ABSTRACT: Like sprintf, but use sprintfn() from Text::sprintfn
108              
109             __END__