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   402 use 5.010;
  1         5  
4 1     1   341 use locale;
  1         481  
  1         5  
5 1     1   32 use strict;
  1         2  
  1         17  
6 1     1   332 use syntax 'each_on_array'; # to support perl < 5.12
  1         19145  
  1         4  
7 1     1   2830 use warnings;
  1         2  
  1         23  
8             #use Log::Any '$log';
9              
10 1     1   380 use Data::Unixish::Util qw(%common_args);
  1         3  
  1         118  
11 1     1   6 use POSIX qw(locale_h);
  1         2  
  1         8  
12 1     1   580 use Scalar::Util 'looks_like_number';
  1         2  
  1         34  
13 1     1   388 use Text::sprintfn ();
  1         752  
  1         300  
14              
15             our $VERSION = '1.570'; # 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         2 my ($in, $out) = ($args{in}, $args{out});
50              
51 1         10 my $orig_locale = _sprintfn_begin(\%args);
52 1         5 while (my ($index, $item) = each @$in) {
53 4         16 push @$out, _sprintfn_item($item, \%args);
54             }
55 1         6 _sprintfn_end(\%args, $orig_locale);
56              
57 1         4 [200, "OK"];
58             }
59              
60             sub _sprintfn_begin {
61 2     2   4 my $args = shift;
62              
63 2         9 my $orig_locale = setlocale(LC_ALL);
64 2 50       9 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         5 return $orig_locale;
72             }
73              
74             sub _sprintfn_item {
75 8     8   17 my ($item, $args) = @_;
76              
77             {
78 8 100       9 last unless defined($item);
  8         14  
79 6         8 my $r = ref($item);
80 6 50 33     15 if ($r eq 'ARRAY' && !$args->{skip_array}) {
81 1     1   7 no warnings;
  1         1  
  1         77  
82 0         0 $item = Text::sprintfn::sprintfn($args->{format}, @$item);
83 0         0 last;
84             }
85 6 100 66     42 if ($r eq 'HASH' && !$args->{skip_hash}) {
86 1     1   6 no warnings;
  1         2  
  1         67  
87 4         9 $item = Text::sprintfn::sprintfn($args->{format}, $item);
88 4         222 last;
89             }
90 2 50       3 last if $r;
91 2 50       5 last if $item eq '';
92 0 0 0     0 last if !looks_like_number($item) && $args->{skip_non_number};
93             {
94 1     1   6 no warnings;
  1         1  
  1         110  
  0         0  
95 0         0 $item = Text::sprintfn::sprintfn($args->{format}, $item);
96             }
97             }
98 8         40 return $item;
99             }
100              
101             sub _sprintfn_end {
102 2     2   5 my ($args, $orig_locale) = @_;
103 2         20 setlocale(LC_ALL, $orig_locale);
104             }
105              
106             1;
107             # ABSTRACT: Like sprintf, but use sprintfn() from Text::sprintfn
108              
109             __END__