File Coverage

blib/lib/Text/Sprintf/Named.pm

Criterion	Covered	Total	%
statement	60	61	98.3
branch	12	14	85.7
condition	7	7	100.0
subroutine	15	15	100.0
pod	4	4	100.0
total	98	101	97.0

package Text::Sprintf::Named;
$Text::Sprintf::Named::VERSION = '0.0405';
use warnings;
use strict;

use 5.008;

use Carp;
use warnings::register;

use parent 'Exporter';

use vars qw(@EXPORT_OK);

@EXPORT_OK = (qw( named_sprintf ));


sub new
{
    my $class = shift;

    my $self = {};
    bless $self, $class;

    $self->_init(@_);

    return $self;
}

sub _init
{
    my ($self, $args) = @_;

    my $fmt = $args->{fmt} or
        confess "The 'fmt format was not specified for Text::Sprintf::Named.";
    $self->_fmt($fmt);

    return 0;
}

sub _fmt
{
    my $self = shift;

    if (@_)
    {
        $self->{_fmt} = shift;
    }

    return $self->{_fmt};
}


sub format
{
    my $self = shift;

    my $args = shift || {};

    if ( (scalar keys %{$args}) > 0  && not exists $args->{args} ){
        warnings::warnif( $self, 'Format parameters were specified, but none of them were \'args\', this is probably a mistake.' );
    }

    my $named_params = $args->{args} || {};

    my $format = $self->_fmt;

    $format =~ s/%(%|\(([a-zA-Z_]\w*)\)([\+\-\.\d]*)([DEFGOUXbcdefgiopsux]))/
        $self->_conversion({
            format_args => $args,
            named_params => $named_params,
            conv => $1,
            name => $2,
            conv_prefix => $3,
            conv_letter => $4,
        })
        /ge;

    return $format;
}


sub calc_param
{
    my ($self, $args) = @_;
    if ( not exists $args->{named_params}->{$args->{name}} ){
        warnings::warnif($self, "Token '$args->{name}' specified in the format '$self->{_fmt}' was not found." );
        return '';
    }
    return $args->{named_params}->{$args->{name}};
}

sub _conversion
{
    my ($self, $args) = @_;

    if ($args->{conv} eq "%")
    {
        return "%";
    }
    else
    {
        return $self->_sprintf(
            ("%" . $args->{conv_prefix} . $args->{conv_letter}),
            $self->calc_param($args),
        );
    }
}

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

    return sprintf($format, @args);
}


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

    my $params;
    if (! @args)
    {
        $params = {};
    }
    elsif (ref($args[0]) eq "HASH")
    {
        $params = shift(@args);
    }
    else
    {
        $params = {@args};
    }

    return
        Text::Sprintf::Named->new({ fmt => $format})
                            ->format({args => $params});
}


1; # End of Text::Sprintf::Named

__END__