File Coverage

blib/lib/String/Template.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	28	28	100.0
condition	8	8	100.0
subroutine	11	11	100.0
pod	4	4	100.0
total	106	106	100.0

package String::Template;

use strict;
use warnings;
use 5.008001;
use base 'Exporter';
use POSIX ();
use Date::Parse;

# ABSTRACT: Fills in string templates from hash of fields
our $VERSION = '0.23'; # VERSION


our @EXPORT = qw(expand_string missing_values expand_stringi);
our @EXPORT_OK = qw(expand_hash);
our %EXPORT_TAGS = ( all => [@EXPORT, @EXPORT_OK] );

my %special =
(
    '%' => sub { sprintf("%$_[0]", $_[1]) },

    ':' => sub { POSIX::strftime($_[0], localtime(str2time($_[1]))) },

    '!' => sub { POSIX::strftime($_[0], gmtime(str2time($_[1]))) },

    '#' => sub { my @args = split(/\s*,\s*/, $_[0]);
                 defined $args[1]
                 ? substr($_[1], $args[0], $args[1])
                 : substr($_[1], $args[0]) }
);

my $specials = join('', keys %special);
my $specialre = qr/^([^{$specials]+)([{$specials])(.+)$/;
my $bracketre = qr/^([^$specials]*?)([{$specials])(.*?)(?

$special{'{'} = sub {
    my ($field, $replace) = @_;
    $field =~ s/\\\}/}/g;
    my ($pre, $key, $spec, $post) = $field =~ /$bracketre/;
    $pre . $special{$key}($spec, $replace) . $post;
};

#
# _replace($field, \%fields, $undef_flag)
#
# replace a single " or ""
# or ""
#
sub _replace
{
    my ($field, $f, $undef_flag, $i_flag) = @_;

    if ($field =~ $specialre)
    {
        return ($undef_flag ? "<$field>" : '') unless defined $f->{($i_flag ? lc($1) : $1)};
        return $special{$2}($3,$f->{($i_flag ? lc($1) : $1)});
    }

    my $ifield = $i_flag ? lc $field : $field;
    return defined $f->{$ifield} ? $f->{$ifield}
                                : ($undef_flag ? "<$field>" : '');
}


#
# expand_string($string, \%fields, $undef_flag)
# find ""
#
sub expand_string
{
    my ($string, $fields, $undef_flag) = @_;

    $string =~ s/<([^>]+)>/_replace($1, $fields, $undef_flag)/ge;

    return $string;
}


sub expand_stringi
{
    my ($string, $fields, $undef_flag) = @_;
    my %ifields = map { lc $_ => $fields->{$_} } keys %$fields;

    $string =~ s/<([^>]+)>/_replace($1, \%ifields, $undef_flag, 1)/gie;

    return $string;
}


sub missing_values
{
    my ($string, $fields, $dont_allow_undefs) = @_;
    my @missing;

    while ($string =~ /<([^>$specials]+)(?:[$specials][^>]+)?>/g) {
        next if exists($fields->{$1}) && (!$dont_allow_undefs || defined($fields->{$1}));
        push @missing, $1;
    }
    return unless @missing;
    return @missing;
}


sub expand_hash
{
    my ($hash, $maxdepth) = @_;

    $maxdepth ||= 10;

    my $changeflag = 1;
    my $missing = 1;

    while ($changeflag)
    {
        $changeflag = 0;
        $missing = 0;
        foreach my $key (sort keys %$hash)
        {
            my $newstr = expand_string($hash->{$key}, $hash, 1);

            if ($newstr ne $hash->{$key})
            {
                $hash->{$key} = $newstr;
                $changeflag = 1;
            }
            $missing++ if $newstr =~ /<[^>]+>/;
        }
        last unless --$maxdepth;
    }
    return $missing ? undef : 1;
}

1;

__END__