File Coverage

blib/lib/String/Interpolate/RE.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	32	32	100.0
condition	17	18	94.4
subroutine	8	8	100.0
pod			n/a
total	105	106	99.0

package String::Interpolate::RE;

# ABSTRACT: interpolate variables into strings using regular expressions

use strict;
use warnings;

use Exporter::Shiny qw[ strinterp ];

our $VERSION = '0.11';

## no critic (ProhibitAccessOfPrivateData)

my %Opt = (
        variable_re        => qr/\w+/,
        raiseundef         => 0,
        emptyundef         => 0,
        useenv             => 1,
        format             => 0,
        recurse            => 0,
        recurse_limit      => 0,
        recurse_fail_limit => 100,
);

*strinterp =  _mk_strinterp( \%Opt );

sub _croak {
    require Carp;
    goto &Carp::croak;
}

sub _generate_strinterp {

    my ( $me, $name, $args ) = @_;

    return \&strinterp
      if ! defined $args || ! defined $args->{opts};

    my %opt = %Opt;
    $opt{lc $_} = $args->{opts}{$_} foreach keys %{$args->{opts}};
    return _mk_strinterp( \%opt );
}

sub _mk_strinterp {

    my $default_opt = shift;

    return sub {

        my ( $text, $var, $opts ) = @_;

        $var = {} unless defined $var;

        my %opt = %$default_opt;

        if ( defined $opts ) {
            $opt{ lc $_ } = $opts->{$_} foreach keys %$opts;
        }
        ## use critic

        my $fmt = $opt{format} ? ':([^}]+)' : '()';

        $opt{track} = {};
        $opt{loop}  = 0;
        $opt{fmt}   = $fmt;

        _strinterp( $text, $var, \%opt );

        return $text;
    }
}

sub _strinterp {

    my $var = $_[1];
    my $opt = $_[2];
    my $fmt = $opt->{fmt};
    my $re  = $opt->{variable_re};

    $_[0] =~ s{
               \$                    # find a literal dollar sign
              (                      # followed by either
               \{ ($re)(?:$fmt)? \}  #  a variable name in curly brackets ($2)
                                     #  and an optional sprintf format
               |                     # or
                (\w+)                #   a bareword ($3)
              )
            }{
              my $t = defined $4 ? $4 : $2;

              my $user_value = 'CODE' eq ref $var ? $var->($t) : $var->{$t};

              my $v =
              # user provided?
                defined $user_value               ? $user_value

              # maybe in the environment
              : $opt->{useenv} && exists $ENV{$t}   ? $ENV{$t}

              # undefined: throw an error?
              : $opt->{raiseundef}                  ? _croak( "undefined variable: $t\n" )

              # undefined
              :                                     undef

              ;

              if ( $opt->{recurse} && defined $v ) {


                RECURSE:
                  {

                      _croak(
                          "circular interpolation loop detected with repeated interpolation of <\$$t>\n"
                      ) if $opt->{track}{$t}++;

                      ++$opt->{loop};

                      last RECURSE if $opt->{recurse_limit} && $opt->{loop} > $opt->{recurse_limit};

                      _croak(
                          "recursion fail-safe limit ($opt->{recurse_fail_limit}) reached at interpolation of <\$$t>\n"
                      ) if $opt->{recurse_fail_limit} && $opt->{loop} > $opt->{recurse_fail_limit};

                      _strinterp( $v, $_[1], $_[2] );

                  }

                  delete $opt->{track}{$t};
                  --$opt->{loop};
              }

              # if not defined:
              #   if emptyundef, replace with an empty string
              #   otherwise,     just put it back into the string
                 ! defined $v ? ( $opt->{emptyundef}  ? '' : '$' . $1 )

              # no format? return as is
              :  ! defined $3 || $3 eq ''         ? $v

              # format it
              :                                     sprintf( $3, $v)

              ;

        }egx;
}

1;

#
# This file is part of String-Interpolate-RE
#
# This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__