File Coverage

blib/lib/Text/sprintfn.pm

Criterion	Covered	Total	%
statement	37	38	97.3
branch	14	14	100.0
condition			n/a
subroutine	4	5	80.0
pod	2	2	100.0
total	57	59	96.6

## no critic: Modules::ProhibitAutomaticExportation

package Text::sprintfn;

use 5.010001;
use strict;
use warnings;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT    = qw(sprintfn printfn);

our $VERSION = '0.090'; # VERSION

our $distance  = 10;

my  $re1   = qr/[^)]+/s;
my  $re2   = qr{(?
                    %
                       (? \d+\$ | \((?$re1)\)\$?)?
                       (? [ +0#-]+)?
                       (? \*?[v])?
                       (? -?\d+ |
                           \*\d+\$? |
                           \((?$re1)\))?
                       (?\.?)
                       (?
                           (?: \d+ | \* |
                           \((?$re1)\) ) ) ?
                       (? [%csduoxefgXEGbBpniDUOF])
                   )}x;
our $regex = qr{($re2|%|[^%]+)}s;

# faster version, without using named capture
if (1) {
    $regex = qr{( #all=1
                    ( #fmt=2
                        %
                        (#pi=3
                            \d+\$ | \(
                            (#npi=4
                                [^)]+)\)\$?)?
                        (#flags=5
                            [ +0#-]+)?
                        (#vflag=6
                            \*?[v])?
                        (#width=7
                            -?\d+ |
                            \*\d+\$? |
                            \((#nwidth=8
                                [^)]+)\))?
                        (#dot=9
                            \.?)
                        (#prec=10
                            (?: \d+ | \* |
                                \((#nprec=11
                                    [^)]+)\) ) ) ?
                        (#conv=12
                            [%csduoxefgXEGbBpniDUOF])
                    ) | % | [^%]+
                )}xs;
}

sub sprintfn {
    my ($format, @args) = @_;

    my $hash;
    if (ref($args[0]) eq 'HASH') {
        $hash = shift(@args);
    }
    return sprintf($format, @args) if !$hash;

    my %indexes; # key = $hash key, value = index for @args
    push @args, (undef) x $distance;

    $format =~ s{$regex}{
        my ($all, $fmt, $pi, $npi, $flags,
            $vflag, $width, $nwidth, $dot, $prec,
            $nprec, $conv) =
            ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);

        my $res;
        if ($fmt) {

            if (defined $npi) {
                my $i = $indexes{$npi};
                if (!$i) {
                    $i = @args + 1;
                    push @args, $hash->{$npi};
                    $indexes{$npi} = $i;
                }
                $pi = "${i}\$";
            }

            if (defined $nwidth) {
                $width = $hash->{$nwidth};
            }

            if (defined $nprec) {
                $prec = $hash->{$nprec};
            }

            $res = join("",
                grep {defined} (
                    "%",
                    $pi, $flags, $vflag,
                    $width, $dot, $prec, $conv)
                );
        } else {
            my $i = @args + 1;
            push @args, $all;
            $res = "\%${i}\$s";
        }
        $res;
    }xego;

    # DEBUG
    #use Data::Dump; dd [$format, @args];

    sprintf $format, @args;
}

sub printfn {
    print sprintfn @_;
}

1;
# ABSTRACT: Drop-in replacement for sprintf(), with named parameter support

__END__