Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Filter::Interpolate

by BrentDax (Hermit)
on Jul 06, 2001 at 07:39 UTC ( #94374=sourcecode: print w/ replies, xml ) Need Help??

Category: Miscellaneous
Author/Contact Info Copyright (C) 2001 Brent Dax. All Rights Reserved.
brentdax1@earthlink.net
Description: Filter::Interpolate allows you to put something like $(Foo) into a string, and have it interpolate the return value of Foo() in a scalar context. @(Foo) is used for list context. This code is a source filter; it depends on Filter::Simple, which depends on a lot of other things.

Please be gentle; it's very easy to outsmart this module. In particular, $(Foo('(')) will eat your entire program looking for a closing parenthesis (and then die gracefully), while $(Foo(')')) will give you a very strange error message about a missing curly or square bracket.

This module can also be used to force context--$() can be used instead of scalar(), and @() can be used instead of the mythical list(). In some cases @() may be the only way to get a list context.

I chose these semantics because they're pretty much identical to those proposed for Perl 6.

No XS required. POD is embedded. test.pl for this module is available upon request.

package Filter::Interpolate;

use Filter::Simple;

FILTER {
    my($trynext, $parencount, @code)=(0, 0, split //);
    
    for(@code) {
        $trynext=1, next if $_ eq '$';
        if($trynext) {
            if($_ eq '(') {
                $parencount=1;
                $_='{\\scalar(';
            }
            
            $trynext=0;
        }
        elsif($parencount) {
            if($_ eq '(') {
                $parencount++;
            }
            elsif($_ eq ')') {
                $parencount--;
                $_=')}' unless $parencount;
            }
        }
    }
    
    $_=join '', @code;
    
    die "Filter::Interpolate: unbalanced parenthesis" if($parencount);
    
    ($trynext, $parencount, @code)=(0, 0, split //);
    
    for(@code) {
        $trynext=1, next if $_ eq '@';
        if($trynext) {
            if($_ eq '(') {
                $parencount=1;
                $_='{[';
            }
            
            $trynext=0;
        }
        elsif($parencount) {
            if($_ eq '(') {
                $parencount++;
            }
            elsif($_ eq ')') {
                $parencount--;
                $_=']}' unless $parencount;
            }
        }
    }
    
    die "Filter::Interpolate: unbalanced parenthesis" if($parencount);
    
    $_=join '', @code;
};

=head1 NAME

Filter::Interpolate - Interpolated Function Calls

=head1 SYNOPSIS

    use Filter::Interpolate;
    
    sub Foo { '1' }
    sub Bar { 1..5 }
    sub Baz { @_ }
    sub Context { wantarray ? 'list' : 'scalar' }

    print "Foo: $(Foo)\n";                #prints Foo: 1
    print "Bar: @(Bar)\n";                #prints Bar: 1 2 3 4 5

    print "Baz: $(Baz('a', 'b'))";        #prints Baz: b
    print "Baz: @(Baz('a', 'b'))";        #prints Baz: a b

    print "$(Context)";                    #prints scalar
    print "@(Context)";                    #prints list

=head1 DESCRIPTION

Filter::Interpolate allows you to interpolate function calls into 
strings.  Because of Perl's contexts, Filter::Interpolate requires a 
sigil (a funny character--$ or @ in this case) to tell the function 
being called which context to use; thus, the syntax is 
C<$(>I<call>C<)> for scalar context or C<@(>I<call>C<)> for list 
context.  (This syntax is expected to be used for the same thing in 
Perl 6, too.)

Filter::Interpolate will work on both fuction and method calls.  It 
will work on parenthesized calls c<as long as the parenthesis are 
balanced>.  It even works outside quotes, where it can be used to
control context.  (This may be the only way to get a list context 
in some cases, for example.)

=head1 BUGS

=over 4

=item *
Filter::Interpolate doesn't really grok Perl that well, so it can't 
tell what you mean when you pass a parameter like C<')'>.  (It 
won't have any trouble if you put the other type of parenthesis in 
front of it, however; the best way to code around this problem is 
probably something like C<function_call(qw/( )/[1])>.)  It can also 
get confused when a parameter is '(', making it eat your entire 
program looking for a closing parenthesis.  I'm not sure how these 
problems could be fixed, but I'm looking into it.

=item *
As strange as it looks, the correct way to interpolate an 
expression like (Foo)[2] is @(Foo)[2].  This is a side effect of 
how the module works internally; I'll leave that as-is, since 
that's (probably) the way Perl 6 will be doing it anyway.

=item *
This code will look horrible if you try using B::Deparse on it.  
Y'see, when the module is used, your beautiful $(Foo) is butchered 
into ${\scalar(Foo)}.  Your also-beautiful @(Foo) fares only a 
little better, becoming @{[Foo]}.  (Yes, that's the at-brace-bracket 
hack.)  Just don't try it--you won't be terribly happy with the 
output's appearance.

=back

=head1 AUTHOR

Copyright (C) 2001 Brent Dax.  All rights reserved.

This module is free software. It may be used, redistributed and/or 
modified under the terms of the Perl Artistic License (see 
http://www.perl.com/perl/misc/Artistic.html).

=cut

Comment on Filter::Interpolate
Download Code
Replies are listed 'Best First'.
Re: Filter::Interpolate
by BrentDax (Hermit) on Jul 07, 2001 at 12:31 UTC
    I managed to rewrite this in a far smaller form. Also, at Damian Conway's urging, I renamed the module to Perl6::Interpolators. The pod is basically the same, with the first paragraph of 'BUGS' removed. Anyway, here's the new code, which uses Text::Balanced:

    package Perl6::Interpolators; use Filter::Simple; use Text::Balanced qw(extract_codeblock); FILTER { my($inside_stuff, $t, $pos); while(($pos=index($_, '$(')) != -1) { $t=substr($_, $pos); $inside_stuff=extract_codeblock($t, '()', qr/\$/); s<\$\Q$inside_stuff\E><\${\\scalar$inside_stuff}>; } ($inside_stuff, $t, $pos)=(undef, undef, undef); while(($pos=index($_, '@(')) != -1) { $t=substr($_, $pos); $inside_stuff=extract_codeblock($t, '()', qr/\@/); s<\@\Q$inside_stuff\E><\@{[$inside_stuff]}>; } };

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://94374]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (18)
As of 2015-07-30 19:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (273 votes), past polls