File Coverage

blib/lib/String/Interpolate/Shell.pm

Criterion	Covered	Total	%
statement	58	64	90.6
branch	34	46	73.9
condition	5	8	62.5
subroutine	11	11	100.0
pod	1	1	100.0
total	109	130	83.8

package String::Interpolate::Shell;

# ABSTRACT: Variable interpolation, shell style

use strict;
use warnings;

use Text::Balanced qw[ extract_bracketed extract_multiple extract_quotelike];
use Params::Check qw[ check ];
use Carp;

use Exporter 'import';

our @EXPORT_OK = qw[ strinterp ];

our $VERSION = '0.02';

sub _extract {

    extract_multiple( $_[0],
                      [
                       qr/\s+/,
                       qr/\\(\\)/,
                       qr/\\(\$)/,
                       { V => qr/\$(\w+)/ },
                       { B => sub { (extract_bracketed( $_[0], '{}', qr/\$/ ))[0] } },
                      ] );
}

sub _handle_undef {

    my ( $var, $q, $attr, $rep ) = @_;

    ## no critic(ProhibitAccessOfPrivateData)

    return $var->{$q} if defined $var->{$q};

    no if $] >= 5.022, warnings => 'redundant';

    carp( sprintf( $attr->{undef_message}, $rep) )
      if $attr->{undef_verbosity} eq 'warn';

    croak( sprintf( $attr->{undef_message}, $rep) )
      if $attr->{undef_verbosity} eq 'fatal';

    return $rep if $attr->{undef_value} eq 'ignore';
}

sub strinterp{

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

    ## no critic(ProhibitAccessOfPrivateData)
    $attr = check( {
                    undef_value => { allow => [ qw[ ignore remove ] ],
                                     default => 'ignore' },
                    undef_verbosity => { allow => [ qw[ silent warn fatal ] ],
                                         default => 'silent' },
                    undef_message => { default => "undefined variable: %s\n" },
                    }, $attr || {} )
      or croak( "error parsing arguments: ", Params::Check::last_error() );

    my @matches;

    for my $matchstr ( _extract($text ) ) {

        my $ref = ref $matchstr;

        if ( 'B' eq $ref ) {

            # remove enclosing brackets
            my $match = substr( $$matchstr, 1,-1 );

            # see if there's a 'shell' modifier expression
            my ( $ind, $q, $modf, $rest ) = $match =~ /^(!)?(\w+)(:[-?=+~:])?(.*)/;

            # if there's no modifier but there is trailing cruft, it's an error
            die( "unrecognizeable variable name: \${$match}\n")
                if ! defined $modf && $rest ne '';

            # if indirect flag is set, expand variable
            if ( defined $ind ) {

                if ( defined $var->{$q} ) {
                    $q = $var->{$q};
                }
                else
                {
                    push @matches, _handle_undef( $attr, '$' . $$matchstr );
                    next;
                }
            }


            if ( ! defined $modf ) {

                push @matches, _handle_undef( $var, $q, $attr, '$' . $$matchstr );
            }

            elsif ( ':?' eq $modf ) {

                local $attr->{undef_verbosity} = 'fatal';
                local $attr->{undef_message} = $rest;

                push @matches, _handle_undef( $var, $q, $attr, '$' . $$matchstr );

            }
            elsif ( ':-' eq $modf ) {

                push @matches, defined $var->{$q} ? $var->{$q} : strinterp( $rest, $var, $attr );

            }

            elsif ( ':=' eq $modf ) {


                $var->{$q} = strinterp( $rest, $var, $attr )
                  unless defined $var->{$q};
                push @matches, $var->{$q};

            }

            elsif ( ':+' eq $modf ) {

                push @matches, strinterp( $rest, $var, $attr )
                  if defined $var->{$q};

            }

            elsif ( '::' eq $modf ) {

                push @matches, sprintf( $rest,  _handle_undef( $var, $q, $attr, '$' . $$matchstr ) );

            }

            elsif ( ':~' eq $modf ) {

                my ( $expr, $xtra, $op ) = (extract_quotelike( $rest ))[0,1,3];
                die( "unable to parse variable substitution command: $rest\n" )
                    if $xtra !~ /^\s*$/ or $op !~ /^(s|tr|y)$/;

                my $t = $var->{$q};
                ## no critic(ProhibitStringyEval)
                eval "\$t =~ $expr";
                die $@ if $@;

                push @matches, $t;

            }

            else { die( "internal error" ) }

        }
        elsif ( 'V' eq $ref ) {

            my $q = $$matchstr;

            push @matches, _handle_undef( $var, $q, $attr, "\$$q" );

        }

        elsif ( $ref ) {

            push @matches, $$matchstr;

        }
        else {

            push @matches, $matchstr;

        }


    }

    return join('', @matches);

}

1;
#
# This file is part of String-Interpolate-Shell
#
# 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::Shell - Variable interpolation, shell style

=head1 VERSION

version 0.02

=head1 SYNOPSIS

  use String::Interpolate::Shell qw[ strinterp ];

  $interpolated_text = strinterp( $text, \%var, \%attr );

=head1 DESCRIPTION

B interpolates variables into strings.
Variables are specified using a syntax similar to that use by B.
Undefined variables can be silently ignored, removed from the string,
can cause warnings to be issued or errors to be thrown.

=over

=item $I

Insert the value of the variable.

=item ${I}

Insert the value of the variable.

=item ${I:?error message}

Insert the value of the variable.  If it is not defined,
the routine croaks with the specified message.

=item ${I:-I}

Insert the value of the variable.  If it is not defined,
process the specified default text for any variable interpolations and
insert the result.

=item ${I:+I}

If the variable is defined, insert the result of interpolating
any variables into the default text.

=item ${I:=I}

Insert the value of the variable.  If it is not defined,
insert the result of interpolating any variables into the default text
and set the variable to the same value.

=item ${I::I}

Insert the value of the variable as formatted according to the
specified B compatible format.

=item ${I:~I/I/I/msixpogce}

Insert the modified value of the variable.  The modification is
specified by I, which may be any of C, C
corresponding to the Perl operators of the same name. Delimiters for
the modification may be any of those recognized by Perl.  The
modification is performed using a Perl string B.

=back

In any of the bracketed forms, if the variable name is preceded with an exclamation mark (C)
the name of the variable to be interpreted is taken from the value of the specified variable.

=head1 FUNCTIONS

=over

=item strinterp

  $interpolated_text = strinterp( $template, \%var, \%attr );

Return a string containing a copy of C<$template> with variables interpolated.

C<%var> contains the variable names and values.

C<%attr> may contain the following entries:

=over

=item undef_value

This indicates how undefined variables should be interpolated

=over

=item C

Ignore them.  The token in C<$text> is left as is.

=item C

Remove the token from C<$text>.

=back

=item undef_verbosity

This indicates how undefined variables should be reported.

=over

=item C

No message is returned.

=item C

A message is output via C.

=item C

A message is output via C.

=back

=back

=back

=head1 BUGS AND LIMITATIONS

You can make new bug reports, and view existing ones, through the
web interface at L.

=head1 AUTHOR

Diab Jerius

=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__