package String::Interpolate::RE;
# ABSTRACT: interpolate variables into strings using regular expressions
use strict;
use warnings;
use Carp;
use Exporter qw[ import ];
our @EXPORT_OK = qw( strinterp );
our $VERSION = '0.06';
## no critic (ProhibitAccessOfPrivateData)
sub strinterp {
my ( $text, $var, $opts ) = @_;
$var = {} unless defined $var;
my %opt = (
raiseundef => 0,
emptyundef => 0,
useenv => 1,
format => 0,
recurse => 0,
recurse_limit => 0,
recurse_fail_limit => 100,
defined $opts
? ( map { ( lc $_ => $opts->{$_} ) } 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};
$_[0] =~ s{
\$ # find a literal dollar sign
( # followed by either
{(\w+)(?:$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: replace with ''?
: $opt->{emptyundef} ? ''
# 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, just put it back into the string
! defined $v ? '$' . $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
#
=pod
=head1 NAME
String::Interpolate::RE - interpolate variables into strings using regular expressions
=head1 VERSION
version 0.06
=head1 SYNOPSIS
use String::Interpolate::RE qw( strinterp );
$str = strinterp( "${Var1} $Var2", $vars, \%opts );
=head1 DESCRIPTION
This module interpolates variables into strings using regular
expression matching rather than Perl's built-in interpolation
mechanism and thus hopefully does not suffer from the security
problems inherent in using B<eval> to interpolate into strings of
suspect ancestry.
=head1 INTERFACE
=over
=item strinterp
$str = strinterp( $template );
$str = strinterp( $template, $vars );
$str = strinterp( $template, $vars, \%opts );
Interpolate variables into a template string, returning the
resultant string. The template string is scanned for tokens of the
form
$VAR
${VAR}
where C<VAR> is composed of one or more word characters (as defined by
the C<\w> Perl regular expression pattern). C<VAR> is resolved using
the optional C<$vars> argument, which may either by a hashref (in
which case C<VAR> must be a key), or a function reference (which is
passed C<VAR> as its only argument and must return the value).
If the value returned for C<VAR> is defined, it will be interpolated
into the string at that point. By default, variables which are not
defined are by default left as is in the string.
The C<%opts> parameter may be used to modify the behavior of this
function. The following (case insensitive) keys are recognized:
=over
=item format I<boolean>
If this flag is true, the template string may provide a C<sprintf>
compatible format which will be used to generate the interpolated
value. The format should be appended to the variable name with
an intervening C<:> character, e.g.
${VAR:fmt}
For example,
%var = ( foo => 3 );
print strinterp( '${foo:%03d}', \%var, { format => 1 } );
would result in
003
=item raiseundef I<boolean>
If true, a variable which has not been defined will result in an
exception being raised. This defaults to false.
=item emptyundef I<boolean>
If true, a variable which has not been defined will be replaced with
the empty string. This defaults to false.
=item useENV I<boolean>
If true, the C<%ENV> hash will be searched for variables which are not
defined in the passed C<%var> hash. This defaults to true.
=item recurse I<boolean>
If true, derived values are themselves scanned for variables to
interpolate. To specify a limit to the number of levels of recursions
to attempt, set the C<recurse_limit> option. Circular dependencies
are caught, but just to be safe there's a limit of recursion levels
specified by C<recurse_fail_limit>, beyond which an exception is
thrown.
For example,
my %var = ( a => '$b', b => '$c', c => 'd' );
strinterp( '$a', \%var ) => '$b'
strinterp( '$a', \%var, { recurse => 1 } ) => 'd'
strinterp( '$a', \%var, { recurse => 1, recurse_limit => 1 } ) => '$c'
strinterp( '$a', { a => '$b', b => '$a' } , { recurse => 1 }
recursive interpolation loop detected with repeated
interpolation of $a
=item recurse_limit I<integer>
The number of recursion levels to descend when recursing into a
variable's value before stopping. The default is C<0>, which means no
limit.
=item recurse_fail_limit I<integer>
The number of recursion levels to descend when recursing into a
variable's value before giving up and croaking. The default is C<100>.
Setting this to C<0> means no limit.
=back
=back
=head1 DIAGNOSTICS
=over
=item C<< undefined variable: %s >>
This string is thrown if the C<RaiseUndef> option is set and the
variable C<%s> is not defined.
=item C<< recursive interpolation loop detected with repeated interpolation of <%s> >>
When resolving nested interpolated values (with the C<recurse> option
true ) a circular loop was found.
=item C<< recursion fail-safe limit (%d) reached at interpolation of <%s> >>
The recursion fail safe limit (C<recurse_fail_limit>) was reached while
interpolating nested variable values (with the C<recurse> option true ).
=back
=head1 BUGS AND LIMITATIONS
You can make new bug reports, and view existing ones, through the
web interface at L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-Interpolate-RE>.
=head1 AUTHOR
Diab Jerius <djerius@cpan.org>
=head1 COPYRIGHT AND LICENSE
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
=cut
__END__
#pod =head1 SYNOPSIS
#pod
#pod use String::Interpolate::RE qw( strinterp );
#pod
#pod $str = strinterp( "${Var1} $Var2", $vars, \%opts );
#pod
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module interpolates variables into strings using regular
#pod expression matching rather than Perl's built-in interpolation
#pod mechanism and thus hopefully does not suffer from the security
#pod problems inherent in using B<eval> to interpolate into strings of
#pod suspect ancestry.
#pod
#pod
#pod =head1 INTERFACE
#pod
#pod =over
#pod
#pod =item strinterp
#pod
#pod $str = strinterp( $template );
#pod $str = strinterp( $template, $vars );
#pod $str = strinterp( $template, $vars, \%opts );
#pod
#pod Interpolate variables into a template string, returning the
#pod resultant string. The template string is scanned for tokens of the
#pod form
#pod
#pod $VAR
#pod ${VAR}
#pod
#pod where C<VAR> is composed of one or more word characters (as defined by
#pod the C<\w> Perl regular expression pattern). C<VAR> is resolved using
#pod the optional C<$vars> argument, which may either by a hashref (in
#pod which case C<VAR> must be a key), or a function reference (which is
#pod passed C<VAR> as its only argument and must return the value).
#pod
#pod If the value returned for C<VAR> is defined, it will be interpolated
#pod into the string at that point. By default, variables which are not
#pod defined are by default left as is in the string.
#pod
#pod The C<%opts> parameter may be used to modify the behavior of this
#pod function. The following (case insensitive) keys are recognized:
#pod
#pod =over
#pod
#pod =item format I<boolean>
#pod
#pod If this flag is true, the template string may provide a C<sprintf>
#pod compatible format which will be used to generate the interpolated
#pod value. The format should be appended to the variable name with
#pod an intervening C<:> character, e.g.
#pod
#pod ${VAR:fmt}
#pod
#pod For example,
#pod
#pod %var = ( foo => 3 );
#pod print strinterp( '${foo:%03d}', \%var, { format => 1 } );
#pod
#pod would result in
#pod
#pod 003
#pod
#pod
#pod =item raiseundef I<boolean>
#pod
#pod If true, a variable which has not been defined will result in an
#pod exception being raised. This defaults to false.
#pod
#pod =item emptyundef I<boolean>
#pod
#pod If true, a variable which has not been defined will be replaced with
#pod the empty string. This defaults to false.
#pod
#pod =item useENV I<boolean>
#pod
#pod If true, the C<%ENV> hash will be searched for variables which are not
#pod defined in the passed C<%var> hash. This defaults to true.
#pod
#pod =item recurse I<boolean>
#pod
#pod If true, derived values are themselves scanned for variables to
#pod interpolate. To specify a limit to the number of levels of recursions
#pod to attempt, set the C<recurse_limit> option. Circular dependencies
#pod are caught, but just to be safe there's a limit of recursion levels
#pod specified by C<recurse_fail_limit>, beyond which an exception is
#pod thrown.
#pod
#pod For example,
#pod
#pod my %var = ( a => '$b', b => '$c', c => 'd' );
#pod strinterp( '$a', \%var ) => '$b'
#pod strinterp( '$a', \%var, { recurse => 1 } ) => 'd'
#pod strinterp( '$a', \%var, { recurse => 1, recurse_limit => 1 } ) => '$c'
#pod
#pod strinterp( '$a', { a => '$b', b => '$a' } , { recurse => 1 }
#pod recursive interpolation loop detected with repeated
#pod interpolation of $a
#pod
#pod =item recurse_limit I<integer>
#pod
#pod The number of recursion levels to descend when recursing into a
#pod variable's value before stopping. The default is C<0>, which means no
#pod limit.
#pod
#pod =item recurse_fail_limit I<integer>
#pod
#pod The number of recursion levels to descend when recursing into a
#pod variable's value before giving up and croaking. The default is C<100>.
#pod Setting this to C<0> means no limit.
#pod
#pod
#pod =back
#pod
#pod =back
#pod
#pod
#pod =head1 DIAGNOSTICS
#pod
#pod =over
#pod
#pod =item C<< undefined variable: %s >>
#pod
#pod This string is thrown if the C<RaiseUndef> option is set and the
#pod variable C<%s> is not defined.
#pod
#pod =item C<< recursive interpolation loop detected with repeated interpolation of <%s> >>
#pod
#pod When resolving nested interpolated values (with the C<recurse> option
#pod true ) a circular loop was found.
#pod
#pod =item C<< recursion fail-safe limit (%d) reached at interpolation of <%s> >>
#pod
#pod The recursion fail safe limit (C<recurse_fail_limit>) was reached while
#pod interpolating nested variable values (with the C<recurse> option true ).
#pod
#pod =back
#pod