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   422 use 5.010;
  1         6  
4 1     1   362 use locale;
  1         518  
  1         5  
5 1     1   33 use strict;
  1         2  
  1         17  
6 1     1   344 use syntax 'each_on_array'; # to support perl < 5.12
  1         19380  
  1         3  
7 1     1   2845 use warnings;
  1         2  
  1         23  
8             #use Log::Any '$log';
9              
10 1     1   353 use Data::Unixish::Util qw(%common_args);
  1         2  
  1         101  
11 1     1   6 use POSIX qw(locale_h);
  1         2  
  1         7  
12 1     1   467 use Scalar::Util 'looks_like_number';
  1         2  
  1         32  
13 1     1   409 use Text::sprintfn ();
  1         749  
  1         330  
14              
15             our $VERSION = '1.572'; # 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         2 my $orig_locale = _sprintfn_begin(\%args);
52 1         5 while (my ($index, $item) = each @$in) {
53 4         9 push @$out, _sprintfn_item($item, \%args);
54             }
55 1         16 _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         15 my $orig_locale = setlocale(LC_ALL);
64 2 50       10 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   15 my ($item, $args) = @_;
76              
77             {
78 8 100       8 last unless defined($item);
  8         13  
79 6         9 my $r = ref($item);
80 6 50 33     12 if ($r eq 'ARRAY' && !$args->{skip_array}) {
81 1     1   7 no warnings;
  1         2  
  1         74  
82 0         0 $item = Text::sprintfn::sprintfn($args->{format}, @$item);
83 0         0 last;
84             }
85 6 100 66     43 if ($r eq 'HASH' && !$args->{skip_hash}) {
86 1     1   6 no warnings;
  1         2  
  1         70  
87 4         11 $item = Text::sprintfn::sprintfn($args->{format}, $item);
88 4         226 last;
89             }
90 2 50       5 last if $r;
91 2 50       3 last if $item eq '';
92 0 0 0     0 last if !looks_like_number($item) && $args->{skip_non_number};
93             {
94 1     1   5 no warnings;
  1         1  
  1         111  
  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         23 setlocale(LC_ALL, $orig_locale);
104             }
105              
106             1;
107             # ABSTRACT: Like sprintf, but use sprintfn() from Text::sprintfn
108              
109             __END__