String-Interpolate-Named-1.06/0000755000400000040000000000000015034122466014015 5ustar jvjvString-Interpolate-Named-1.06/t/0000755000400000040000000000000015034122466014260 5ustar jvjvString-Interpolate-Named-1.06/t/20-multi.t0000644000400000040000000000152415000760211016005 0ustar jvjv#! perl use warnings; use strict; use Test::More; my $tests = 0; -d "t" && chdir("t"); use_ok('String::Interpolate::Named'); $tests++; # Using OO with explicit ctl setting. my $s = String::Interpolate::Named->new; $s->ctl( { separator => ":", args => { title => "Hi There!", subtitle => ["%{capo|CAPO %{}}"], multi => [ "Alpha", "Beta" ], capo => 1, key => [ "G" ], h => "Z", head => [ "yes" ], }, } ); @ARGV = qw( 10-basic.dat 20-multi.dat ); foreach ( @ARGV ) { -s -r $_ ? pass("check $_") : BAIL_OUT("$_ [$!]"); $tests++; } while ( <> ) { next if /^#/; next unless /\S/; chomp; my ( $tpl, $exp ) = split( /\t+/, $_ ); my $res = $s->interpolate($tpl); is( $res, $exp, "$tpl -> $exp" ); $tests++; } done_testing($tests); String-Interpolate-Named-1.06/t/13-act.dat0000644000400000040000000000232614153377542015755 0ustar jvjv# No substitutions abcd abcd # Percent -> % ab%cd ab%cd # Dollar -> $ ab$cd ab$cd # Lone brace ab{cd ab{cd ab${cd ab${cd ab}cd ab}cd # Variable ab${head}def abyesdef ab${head}def${head}xy abyesdefyesxy ${head}def yesdef ${h}def Zdef ${true} 1 ${false} 0 # Subtitute the value X${head}Y XyesY X${head=yes}Y XY X${head=no}Y XY # Subtitute the 'true' part X${head|foo}Y XfooY X${head|fo\|o}Y Xfo|oY X${head|1}Y X1Y X${head|0}Y X0Y X${hexd|foo}Y XY X|${hexd|fo\|o}|Y X||Y # ${} refers to the value of the key. X${head|This is ${}!}Y XThis is yes!Y X${head=yes|This is ${}!}Y XThis is yes!Y X${head=no|This is ${}!}Y XY X${capo=1|${} capo|${} capoes}Y X1 capoY X${capo=0|${} capoes|${} capo}Y X1 capoY # But only within a ${ ... }. X${}Y X${}Y # Subtitute the 'false' part X${head=no|foo|bar}Y XbarY X${hexd|foo|bar}Y XbarY X${hexd=yes|foo|bar}Y XbarY X${hexd=no|foo|bar}Y XbarY X${hexd=|foo|bar}Y XfooY X${hexd|foo|0}Y X0Y X${h|foo|bar}Y XfooY X${h=Z|foo|bar}Y XfooY # Nested. X${head|x${foo}z|bar}Y XxzY X${hexd|x${foo}z|bar}Y XbarY # Note that ${} is the value of foo (inner), not head (outer) X${head|x${foo|ab|f${}g}z}Y XxfgzY # Recursive substitution. ${subtitle} CAPO 1 # Transpose. ${key} G String-Interpolate-Named-1.06/t/00-load.t0000644000400000040000000000027215002100316015563 0ustar jvjv#! perl use Test::More tests => 1; BEGIN { use_ok( 'String::Interpolate::Named' ); } diag( "Testing String::Interpolate::Named $String::Interpolate::Named::VERSION, Perl $], $^X" ); String-Interpolate-Named-1.06/t/10-basic.t0000644000400000040000000000135315000760175015744 0ustar jvjv#! perl use warnings; use strict; use Test::More; my $tests = 0; -d "t" && chdir("t"); use_ok('String::Interpolate::Named'); $tests++; # Using functional interface. my $s = { args => { title => "Hi There!", subtitle => [ "%{capo|CAPO %{}}" ], capo => [ 1 ], key => [ "G" ], h => [ "Z" ], head => [ "yes" ], }, # trace => 1, }; @ARGV = qw( 10-basic.dat ); foreach ( @ARGV ) { -s -r $_ ? pass("check $_") : BAIL_OUT("$_ [$!]"); $tests++; } while ( <> ) { next if /^#/; next unless /\S/; chomp; my ( $tpl, $exp ) = split( /\t+/, $_ ); my $res = interpolate( $s, $tpl ); is( $res, $exp, "$tpl -> $exp" ); $tests++; } done_testing($tests); String-Interpolate-Named-1.06/t/13-sub.t0000644000400000040000000000143015000757675015466 0ustar jvjv#! perl use warnings; use strict; use Test::More; my $tests = 0; -d "t" && chdir("t"); use_ok('String::Interpolate::Named'); $tests++; my $args = { title => "Hi There!", subtitle => [ "%{capo|CAPO %{}}" ], capo => [ 1 ], key => [ "G" ], h => [ "Z" ], head => [ "yes" ], customer => [ "Smith", "Jones" ], }; # Using callback. my $s = { args => sub { $args->{$_[0]} } }; @ARGV = qw( 10-basic.dat ); foreach ( @ARGV ) { -s -r $_ ? pass("check $_") : BAIL_OUT("$_ [$!]"); $tests++; } while ( <> ) { next if /^#/; next unless /\S/; chomp; my ( $tpl, $exp ) = split( /\t+/, $_ ); my $res = interpolate( $s, $tpl ); is( $res, $exp, "$tpl -> $exp" ); $tests++; } done_testing($tests); String-Interpolate-Named-1.06/t/12-sub.t0000644000400000040000000000135715000760205015454 0ustar jvjv#! perl use warnings; use strict; use Test::More; my $tests = 0; -d "t" && chdir("t"); use_ok('String::Interpolate::Named'); $tests++; my $args = { title => "Hi There!", subtitle => [ "%{capo|CAPO %{}}" ], capo => [ 1 ], key => [ "G" ], h => [ "Z" ], head => [ "yes" ], }; # Using callback. my $s = { args => sub { $args->{$_[0]} } }; @ARGV = qw( 10-basic.dat ); foreach ( @ARGV ) { -s -r $_ ? pass("check $_") : BAIL_OUT("$_ [$!]"); $tests++; } while ( <> ) { next if /^#/; next unless /\S/; chomp; my ( $tpl, $exp ) = split( /\t+/, $_ ); my $res = interpolate( $s, $tpl ); is( $res, $exp, "$tpl -> $exp" ); $tests++; } done_testing($tests); String-Interpolate-Named-1.06/t/10-basic.dat0000644000400000040000000000430215001207530016236 0ustar jvjv# No substitutions abcd abcd # Lone specials ab%cd ab%cd ab{cd ab{cd ab%{cd ab%{cd ab}cd ab}cd ab\cd ab\cd ab|cd ab|cd ab\{cd ab\{cd ab\}cd ab\}cd ab\|cd ab\|cd ab\%cd ab\%cd ab\\cd ab\\cd ab\&cd ab\&cd abc\ abc\ # Variable ab%{head}def abyesdef ab%{head}def%{head}xy abyesdefyesxy %{head}def yesdef %{h}def Zdef # Subtitute the value X%{head}Y XyesY X%{head=yes}Y XY X%{head=no}Y XY # No value is empty string X%{headx}Y XY # Subtitute the 'true' part X%{head|}Y XY X%{head|foo}Y XfooY X%{head|fo\|o}Y Xfo|oY # %{} refers to the value of the key. X%{head|This is %{}!}Y XThis is yes!Y X%{head=yes|This is %{}!}Y XThis is yes!Y X%{head=no|This is %{}!}Y XY X%{capo=1|%{} capo|%{} capoes}Y X1 capoY X%{capo=0|%{} capoes|%{} capo}Y X1 capoY # But only within a %{ ... }. X%{}Y X%{}Y # Subtitute the 'false' part X%{head=no|foo|bar}Y XbarY X%{hexd|foo|bar}Y XbarY X%{hexd=yes|foo|bar}Y XbarY X%{hexd=no|foo|bar}Y XbarY X%{hexd=|foo|bar}Y XfooY X%{hexd|foo}Y XY X|%{hexd|fo\|o}|Y X||Y X%{h|foo|bar}Y XfooY X%{h=Z|foo|bar}Y XfooY # Nested. X%{head|x%{foo}z|bar}Y XxzY X%{hexd|x%{foo}z|bar}Y XbarY X%{head|x%{h|\\\|}z|bar}Y Xx|zY X%{head|x%{foo||\\\|}z|bar}Y Xx|zY # Note that %{} is the value of foo (inner), not head (outer) X%{head|x%{foo|ab|f%{}g}z}Y XxfgzY # Recursive substitution. %{subtitle} CAPO 1 # Transpose. %{key} G # Formatting %{capo:%02d} 01 %{capo=1|%{capo:%02d}|no} 01 %{capo:%02d=01|yes%{}|no} yes01 [%{capo:%6.2s}] [ 1] # Case changers %{title:uc} HI THERE! %{title:lc} hi there! %{title:ic} Hi There! %{title:lc:ic} Hi There! %{title:sc} Hi There! %{title:lc:sc} Hi there! # Formatting doesn't interfere with definedness X%{1:%02d}Y XY X%{hexd:sc}Y XY # Padding X%{key:lpad(0)}Y XGY X%{key:lpad(4)}Y X GY X%{key:lpad(4,-)}Y X---GY X%{key:lpad(4,xy)}Y XxyxGY X%{head:lpad(2)}Y XyesY X%{head:lpad(3)}Y XyesY X%{key:rpad(4)}Y XG Y X%{key:rpad(4,-)}Y XG---Y X%{key:rpad(4,xy)}Y XGxyxY X%{head:rpad(2)}Y XyesY X%{head:rpad(3)}Y XyesY # Replace %{title:replace( ,_)} Hi_There! %{title:replace( ,,)} Hi,There! %{title:replace( ,,):replace(,, )} Hi There! %{title:replace( ,\:):replace(\:, )} Hi There! %{title:replace(!,)} Hi There %{title:replace(!,\})} Hi There} String-Interpolate-Named-1.06/t/13-act.t0000644000400000040000000000136214050534677015447 0ustar jvjv#! perl use warnings; use strict; use Test::More; my $tests = 0; -d "t" && chdir("t"); use_ok('String::Interpolate::Named'); $tests++; my $args = { title => "Hi There!", subtitle => [ '${capo|CAPO ${}}' ], capo => [ 1 ], key => [ "G" ], h => [ "Z" ], head => [ "yes" ], true => 1, false => 0, }; my $s = { activator => '$', args => $args }; @ARGV = qw( 13-act.dat ); foreach ( @ARGV ) { -s -r $_ ? pass("check $_") : BAIL_OUT("$_ [$!]"); $tests++; } while ( <> ) { next if /^#/; next unless /\S/; chomp; my ( $tpl, $exp ) = split( /\t+/, $_ ); my $res = interpolate( $s, $tpl ); is( $res, $exp, "$tpl -> $exp" ); $tests++; } done_testing($tests); String-Interpolate-Named-1.06/t/14-kpat.t0000644000400000040000000000127013724776030015634 0ustar jvjv#! perl use warnings; use strict; use Test::More; my $tests = 0; use_ok('String::Interpolate::Named'); $tests++; my $s = { keypattern => qr/a+/, args => { a => "one", aa => "", aaa => "three", b => "Eins", bb => "Zwo", ab => "yes", }, }; while ( ) { next if /^#/; next unless /\S/; chomp; my ( $tpl, $exp ) = split( /\t+/, $_ ); my $res = interpolate( $s, $tpl ); is( $res, $exp, "$tpl -> $exp" ); $tests++; } done_testing($tests); __DATA__ # Valid ab%{a}def abonedef ab%{aa}def abdef %{aaa}def threedef # Not valid ab%{b}def ab%{b}def ab%{bb}def ab%{bb}def %{ab}def %{ab}def String-Interpolate-Named-1.06/t/20-multi.dat0000644000400000040000000000024214145167425016327 0ustar jvjv# Multi values. %{multi} Alpha:Beta %{multi.0} Alpha:Beta %{multi.1} Alpha %{multi.2} Beta %{multi.-1} Beta %{multi.-2} Alpha %{subtitle.1} CAPO 1 %{subtitle.2} String-Interpolate-Named-1.06/t/11-arrays.t0000644000400000040000000000136715000760201016160 0ustar jvjv#! perl use warnings; use strict; use Test::More; my $tests = 0; -d "t" && chdir("t"); use_ok('String::Interpolate::Named'); $tests++; # Using OO with implicit ctl setting. my $s = String::Interpolate::Named->new ( { args => { title => "Hi There!", subtitle => [ "%{capo|CAPO %{}}" ], capo => [ 1 ], key => [ "G" ], h => [ "Z" ], head => [ "yes" ], }, } ); @ARGV = qw( 10-basic.dat ); foreach ( @ARGV ) { -s -r $_ ? pass("check $_") : BAIL_OUT("$_ [$!]"); $tests++; } while ( <> ) { next if /^#/; next unless /\S/; chomp; my ( $tpl, $exp ) = split( /\t+/, $_ ); my $res = $s->interpolate($tpl); is( $res, $exp, "$tpl -> $exp" ); $tests++; } done_testing($tests); String-Interpolate-Named-1.06/README0000644000400000040000000000220213556554474014710 0ustar jvjvString-Interpolate-Named - Interpolated named arguments in string String::Interpolate::Named provides a single function, interpolate, that takes a string and substitutes named variables by target texts. Example: use String::Interpolate::Named; my $ctl = { args => { fn => "Johann", ln => "Bach" } }; say interpolate( $ctl, "The famous %{fn} %{ln}." ); # Result = "The famous Johann Bach" Other features are selecting true/false texts: "The task is %{done|ready|unfinished}." Testing specific values: "%{instrument=piano|Play this with elbows}" Selecting one out of a list of values: "First customer is %{customer.1}" SUPPORT AND DOCUMENTATION Development of this module takes place on GitHub: https://github.com/sciurius/perl-String-Interpolate-Named. You can find documentation for this module with the perldoc command. perldoc String::Interpolate::Named Please report any bugs or feature requests using the issue tracker on GitHub. COPYRIGHT AND LICENCE Copyright (C) 2018,2019 Johan Vromans This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. String-Interpolate-Named-1.06/Changes0000644000400000040000000000305315034122377015312 0ustar jvjvRevision history for String-Interpolate-Named 1.06 2025-07-11 Remove -T perl flag from 00-load.t. 1.05 2025-04-21 Added padding and replace functions. Disable 'Unicode character is illegal' warnings for older perls. 1.04 2025-04-18 Support basic formatting like case changing and printf formats. 1.03 2022-01-13 Fix substituting empty in %{key|} even if key has a value. Fix some edge cases with nesting and escaping. 1.02 2022-01-12 Fix problem with de-escaping \{ \} \| outside of substitution (issue #6); Silently provide empty values when an array selector exceeds the number of elements in the array. 1.01 2021-05-18 Allow variable lookup using a callback. Allow selection of activator. Caveat emptor. Allow setting of the pattern to match key names. Caveat emptor. Fix problem with true/false parts being false. 1.00 2019-10-31 Fix backslash escapes. \| hides the | from being seen as a |, and leaves a | (not \|) upon completion. Same for \{ and \} . Add object oriented API. Limit max number of iterations. Rework documentation. 0.05 2018-10-25 %{} should work only within a %{ ... } construct. 0.04 2018-10-24 Require perl 5.10.1 or later due to Unicode problems. Use $" as default for separator. 0.03 2018-10-23 Require perl 5.10 or later for named captures. Fix license setting in Makefile. 0.02 2018-10-23 09:56 Renamed to String::Interpolate::Named to avoid conflicts with (non-existing!) Text::Substitute. Move development to GitHub. 0.01 2018-10-20 22:35 Text::Substitute released on an unsuspecting world. String-Interpolate-Named-1.06/Makefile.PL0000644000400000040000000000203615001456474015773 0ustar jvjv#! perl use strict; use warnings; # Ease the life of the CPAN testers. exit 0 if $ENV{AUTOMATED_TESTING} && $] < 5.010001; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'String::Interpolate::Named', AUTHOR => 'Johan Vromans ', VERSION_FROM => 'lib/String/Interpolate/Named.pm', ABSTRACT_FROM => 'lib/String/Interpolate/Named.pm', LICENSE => 'perl_5', PL_FILES => {}, MIN_PERL_VERSION => "5.010001", PREREQ_PM => { }, TEST_REQUIRES => { 'Test::More' => 0, }, META_MERGE => { resources => { repository => { type => 'git', web => 'https://github.com/sciurius/perl-String-Interpolate-Named', url => 'https://github.com/sciurius/perl-String-Interpolate-Named.git', }, bugtracker => { web => "https://github.com/sciurius/perl-String-Interpolate-Named/issues", }, }, 'meta-spec' => { version => '2', url => 'https://metacpan.org/pod/CPAN::Meta::Spec', }, }, ); String-Interpolate-Named-1.06/MANIFEST0000644000400000040000000000057015034122466015150 0ustar jvjvChanges MANIFEST Makefile.PL README lib/String/Interpolate/Named.pm t/00-load.t t/10-basic.dat t/10-basic.t t/11-arrays.t t/12-sub.t t/13-act.dat t/13-act.t t/13-sub.t t/14-kpat.t t/20-multi.dat t/20-multi.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) String-Interpolate-Named-1.06/lib/0000755000400000040000000000000015034122466014563 5ustar jvjvString-Interpolate-Named-1.06/lib/String/0000755000400000040000000000000015034122466016031 5ustar jvjvString-Interpolate-Named-1.06/lib/String/Interpolate/0000755000400000040000000000000015034122466020317 5ustar jvjvString-Interpolate-Named-1.06/lib/String/Interpolate/Named.pm0000644000400000040000000003250015034122424021673 0ustar jvjv#! perl package String::Interpolate::Named; use warnings; use strict; use utf8; use Carp qw( carp croak ); # Disable 'Unicode character 0xfddX is illegal' warnings. no if $] < 5.014, q|warnings|, qw(utf8); use parent 'Exporter'; our @EXPORT = qw( interpolate ); =head1 NAME String::Interpolate::Named - Interpolated named arguments in string =cut our $VERSION = '1.06'; =head1 SYNOPSIS use String::Interpolate::Named; my $ctl = { args => { fn => "Johan", ln => "Bach" } }; say interpolate( $ctl, "The famous %{fn} %{ln}." ); # If you like object orientation. my $int = String::Interpolate::Named->new( { args => { ... } } ); say $int->interpolate("The famous %{fn} %{ln}."); =head1 DESCRIPTION String::Interpolate::Named provides a function to interpolate named I by I in a template string. The target texts are provided to the function via a hash, where the keys correspond to the named argument to be replaced, or a subroutine that performs the lookup. =head2 Named Arguments The arguments to be replaced are marked in the template by enclosing them between C<%{> and C<}>. For example, the string C<"The famous %{fn} %{ln}."> contains two named arguments, C and C. Note that the activator may be changed from C<%> into something else, see below. Throughout this document we use the default value. =head2 Basic Interpolation When interpolated, the keys C and C are looked up in the hash, and the corresponding values are substituted. If no value was found for a named argument, nothing is substituted and the C<%{...}> is removed. You can precede C<%>, C<{>, C<}> (and C<|>, see below) with a backslash C<\> to hide their special meanings. For example, C<\}> will I be considered closing an argument but yield a plain C<}> in the text. =head2 Conditional Interpolation It is possible to select replacement values depending on whether the named argument has a value or not: "This book has %{title|title %{title}}" "This book has %{title|title %{title}|no title}" These are considered C<%{if|then}> and C<%{if|then|else}> cases. Assuming argument C has the value C<"My Book">, in the first example the text C<"title My Book">, the 'then' text, will be substituted, resulting in "This book has title My Title" If C<title> does not have a value, the empty string is substituted. In the second example, the string C<"no title">, the 'else' text, will be substituted. As can be seen, the replacement texts may contain interpolations as well. For convenience, you can use C<%{}> to refer to the value of the named argument currently being examinated. The last example above can be written more shortly and elegantly as: "This book has %{title|title %{}|no title}" =head2 Testing Values Instead of testing for named variables to have a value, you can also test for specific values: "This takes %{days=1|%{} day|%{} days}" =head2 List Values The replacement values hash may be scalar (in general: strings and numbers) or lists of scalars. If a value is a list of scalars, it is possible to select a particular value from the list by appending an index (period and a number) to the named argument. Assume C<customer> has value C<[ "Jones", "Smith" ]>, then: "%{customer} will be Jones Smith" "%{customer.0} will be Jones Smith" "%{customer.1} will be Jones" "%{customer.2} will be Smith" When the value exceeds the number of elements in the list, an empty value is returned. Index zero, or no index, will return all values concatenated. =head2 Format modifiers A named variable may have I<format modifiers> attached to perform formatting operations on the substituted value. Format modifiers start with a colon C<:>. Assuming argument C<title> has the value C<"My Book">, then C<"%{title:lc}"> will yield the title in lowercase C<"my book">. The following format modifiers are available: =over 6 =item C<:lc> Yields the substituted value in all lower case. Using the example above, this will be C<"my book">. =item C<:uc> Yields the substituted value in all upper case. Using the example above, this will be C<"MY BOOK">. =item C<:ic> Yields the substituted value with initial caps, e.g. the first letter of each word is capitalized. Using the example above, this will be C<"My Book">. Indeed, no difference since the value is already correctly cased. To enforce lower case before applying initial case, use format modifiers C<:lc:ic>. =item C<:sc> Yields the substituted value with an initial cap and the rest lower case. Using the example above, this will be C<"My Book">. Again, no difference since the value already has an initial capital. To enforce lower case before applying initial case, use format modifiers C<:lc:sc>. Now the result will be C<"My book">. =item C<:lpad(>I<N>C<)> C<:lpad(>I<N>C<,>I<S>C<)> Pads the value by repeatedly prepending the string I<S> until the total width is I<N>. If I<S> is omitted, uses spaces. =item C<:rpad(>I<N>C<)> C<:rpad(>I<N>C<,>I<S>C<)> Pads the value by repeatedly appending the string I<S> until the total width is I<N>. If I<S> is omitted, uses spaces. =item C<:replace(>I<SRC>C<,>I<DST>C<)> Replaces all occurrences of I<STR> by I<DST>, If I<S> is omitted, uses spaces. =item C<:%>I<fmt> Apply standard printf() formatting, e.g. C<%{key:%03d}> yields the numeric value of C<key> as a 3-digit string, adding leading zeroes if necessary. =back Note that, when combining formatting and conditional interpolation, you must check for the I<formatted> value: "This takes %{days:%02d=01|%{} day|%{} days}" You can prevent a colon from splitting formatters with a backslash: %{title:replace( ,\:)} =head2 The Control Hash The interpolation process requires two parameters: a hash with settings and values for the named arguments, and the string to be used as a template for interpolation. The hash will be further referred to as the I<control hash>. The hash can have the following keys: =over =item args This is either a hash that contains replacement texts for the named variables, or a subroutine that gets called with a variable as argument and returns a replacement value. This element should be considered mandatory. =item separator The separator used to concatenate list values, see L<List Values> above. It defaults to Perl variable C<$"> that, on its turn, defaults to a single space. =item activator This is a single character that activates interpolation. By default this is the percent C<%> character. =item keypattern The pattern to match key names. Default is C<qr/\w+[-_\w.]*/>. =item maxiter To enable nested substitutions and recursive replacement, the interpolation process is repeated until there are no more interpolations to be made. The maximun number of iterations is limited to the value of C<maxiter>. By default maxiter is 16. =back An example of a control hash: my %ctl = ( args => { customer => [ "Jones", "Smith" ], days => 2, title => "My Title", }, separator => ", ", ); =head2 Object Oriented API my $ii = String::Interpolate::Named->new; $ii->ctl(\%ctl); $result = $ii->interpolate($template); For convenience, the control hash may be passed to the constructor: my $ii = String::Interpolate::Named->new(\%ctl); $result = $ii->interpolate($template); =head2 Functional API String::Interpolate::Named privides a single function, C<interpolate>, which is exported by default. The subroutine takes two arguments: a reference to a control hash and the template string. $result = interpolate( \%ctl, $template ); =cut =head1 METHODS =head2 new Constructs a new String::Interpolate::Named object. my $ii = String::Interpolate::Named->new; or my $ii = String::Interpolate::Named->new(\%ctl); =cut sub new { my ( $pkg, $ctl ) = @_; $ctl //= {}; bless $ctl => $pkg; } =head2 ctl Associates a control has with an existing object. $ii->ctl(\%ctl); =cut sub ctl { my ( $self, $ctl ) = @_; $self->{$_} = $ctl->{$_} for keys(%$ctl); return $self; } =head2 interpolate This routine performs the actual interpolations. It can be used as a method: $ii->interpolate($template); and functional: interpolate( \%ctl, $template ); =cut sub interpolate { my ( $ctl, $tpl ) = @_; my $maxiter = $ctl->{maxiter} // 16; my $activator = $ctl->{activator} // '%'; my $keypat = $ctl->{keypattern} // qr/\w+[-_\w.]*/; for ( my $cnt = 1; $cnt <= $maxiter; $cnt++ ) { my $prev = $tpl; # Hide escaped specials by replacing them with Unicode noncharacters. $tpl =~ s/\\\\/\x{fdd0}/g; $tpl =~ s/\\\{/\x{fdd1}/g; $tpl =~ s/\\\}/\x{fdd2}/g; $tpl =~ s/\\\|/\x{fdd3}/g; $tpl =~ s/\\\Q$activator\E/\x{fdd4}/g; # Replace some seqs by a single char for easy matching. $tpl =~ s/\Q$activator\E\{\}/\x{fdde}/g; $tpl =~ s/\Q$activator\E\{/\x{fddf}/g; # %{ key [ .index ] [ = value ] [ | then [ | else ] ] } my $pre = ''; my $post = ''; if ( $tpl =~ s; ( ^ (?<pre> .*? ) \x{fddf} (?<key> $keypat ) (?: : (?<fmt> .*? ) )? (?: (?<op> \= ) (?<test> [^|}\x{fddf}]*) )? (?: \| (?<then> [^|}\x{fddf}]* ) (?: \| (?<else> [^|}\x{fddf}]* ) )? )? \} (?<post> .* ) $ ) ; _interpolate($ctl, {%+} ) ;exso ) { $pre = $+{pre}; $post = $+{post}; } else { $pre = $tpl; $tpl = ''; } for ( $pre, $tpl, $post ) { # Unescape escaped specials. s/\x{fdd0}/\\\\/g; s/\x{fdd1}/\\\{/g; s/\x{fdd2}/\\\}/g; s/\x{fdd3}/\\\|/g; s/\x{fdd4}/\\$activator/g; # Restore (some) seqs. s/\x{fdde}/$activator."{}"/ge; s/\x{fddf}/$activator."{"/ge; } $tpl =~ s/\\(\Q$activator\E|[{}|\\])/$1/g; warn ("'$prev' => '$pre' '$tpl' '$post'\n" ) if $ctl->{trace}; my $t = $pre . $tpl . $post; if ( $prev eq $t ) { # De-escape in subst part only (issue #6); $tpl =~ s/\\(\Q$activator\E|[{}|])/$1/g; return $pre . $tpl . $post; } $tpl = $t; warn("$cnt: $prev -> $tpl\n") if $ctl->{trace}; } Carp::croak("Maximum number of iterations exceeded"); } sub _interpolate { my ( $ctl, $i ) = @_; my $key = $i->{key} // ''; my $m = $ctl->{args}; # Establish the value for this key. my $val = ''; my $inx = 0; # Split off possible index. if ( $key =~ /^(.*)\.(-?\d+)$/ ) { ( $key, $inx ) = ( $1, $2 ); } my $newval = ref($m) eq 'CODE' ? $m->($key) : $m->{$key}; if ( defined $newval ) { $val = $newval; if ( UNIVERSAL::isa( $val, 'ARRAY' ) ) { # 1, 2, ... selects 1st, 2nd value; -1 counts from end. if ( $inx ) { if ( $inx > 0 ) { if ( $inx <= @$val ) { $val = $val->[$inx-1]; } else { $val = ""; } } else { $val = $val->[$inx]; } } # Zero or none means concatenate all. else { $val = join( $ctl->{separator} // $", @$val ); } } elsif ( $inx ) { Carp::croak("Expecting an array for variable '$key'") } } my $subst = ''; for ( split( /(?<!\\):/, $i->{fmt}//'' ) ) { last unless defined $newval; next unless my $fmt = $_; # Simple formatters. if ( $fmt eq 'lc' ) { $val = lc($val) } elsif ( $fmt eq 'uc' ) { $val = uc($val) } elsif ( $fmt eq 'sc' ) { $val = ucfirst($val) } elsif ( $fmt eq 'ic' ) { $val = f_ic($val) } # Functions. elsif ( $fmt =~ /^([lr])pad\((\d+)(?:,(.*?))?\)$/ ) { $val = f_pad( $val, $1, $2, $3 ); } elsif ( $fmt =~ /^replace\((.+?),(.*?)\)$/ ) { $val = f_replace( $val, $1, $2 ); } # Printf formatting. elsif ( $fmt =~ /^%/ ) { $val = f_printf( $val, $fmt ) } else { Carp::croak("Invalid format code '$fmt'"); } } if ( $i->{op} ) { my $test = $i->{test} // ''; if ( $i->{op} eq '=' && $val eq $test ) { $subst = $i->{then} // ''; } else { $subst = $i->{else} // ''; } } elsif ( $val ne '' ) { $subst = $i->{then} // $val; } else { $subst = $i->{else} // ''; } $subst =~ s/\x{fdde}/$val/g; return $subst; } # Formatter functions. # First arg = $val. # Return new value. sub f_ic { my ( $val ) = @_; join('', map { ucfirst } (split( /(^|\s+|-)/, $val ))); } sub f_pad { my ( $val, $lr, $len, $str ) = @_; $str //= " "; return $val unless ( my $need = $len - length($val) ) > 0; my $pad = $str x (1+int(($len-1)/length($str))); if ( $lr eq 'l' ) { return substr( $pad, 0, $need ) . $val; } $val . substr( $pad, 0, $need ); } sub f_replace { my ( $val, $rep, $str ) = @_; $val =~ s/\Q$rep\E/$str/g; $val; } sub f_printf { my ( $val, $fmt ) = @_; # A common problem is when a numeric format does not # have a value to format. Suppress the warning. no warnings qw(numeric); sprintf( $fmt, $val ); } =head1 REQUIREMENTS Minimal Perl version 5.10.1. =head1 AUTHOR Johan Vromans, C<< <JV at CPAN dot org> >> =head1 SUPPORT Development of this module takes place on GitHub: L<https://github.com/sciurius/perl-String-Interpolate-Named>. You can find documentation for this module with the perldoc command. perldoc String::Interpolate::Named Please report any bugs or feature requests using the issue tracker on GitHub. =head1 ACKNOWLEDGEMENTS Many of the existing template / interpolate / substitute modules. =head1 COPYRIGHT & LICENSE Copyright 2018,2025 Johan Vromans, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������String-Interpolate-Named-1.06/META.yml��������������������������������������������������������������0000644�0004000�0004000�00000001366�15034122466�015274� 0����������������������������������������������������������������������������������������������������ustar �jv������������������������������jv���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- abstract: 'Interpolated named arguments in string' author: - 'Johan Vromans <jv@cpan.org>' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: String-Interpolate-Named no_index: directory: - t - inc requires: perl: '5.010001' resources: bugtracker: https://github.com/sciurius/perl-String-Interpolate-Named/issues repository: https://github.com/sciurius/perl-String-Interpolate-Named.git version: '1.06' x_serialization_backend: 'CPAN::Meta::YAML version 0.020' ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������String-Interpolate-Named-1.06/META.json�������������������������������������������������������������0000644�0004000�0004000�00000002564�15034122466�015445� 0����������������������������������������������������������������������������������������������������ustar �jv������������������������������jv���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{ "abstract" : "Interpolated named arguments in string", "author" : [ "Johan Vromans <jv@cpan.org>" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "String-Interpolate-Named", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "perl" : "5.010001" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/sciurius/perl-String-Interpolate-Named/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/sciurius/perl-String-Interpolate-Named.git", "web" : "https://github.com/sciurius/perl-String-Interpolate-Named" } }, "version" : "1.06", "x_serialization_backend" : "JSON::PP version 4.16" } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������