Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Filter::Interpolate

by BrentDax (Hermit)
on Jul 06, 2001 at 07:39 UTC ( [id://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
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]}>; } };

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2024-04-25 07:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found