File Coverage

blib/lib/Perl6/Variables.pm

Criterion	Covered	Total	%
statement	3	3	100.0
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	4	4	100.0

package Perl6::Variables;
$VERSION = '0.02_002';
use Filter::Simple;

my $ident = qr/ [_a-z] \w* (?: :: [_a-z] \w* )* /ix;
my $listlikely = qr/ (?: \.\. | => | , | qw | \@ $ident \b [^[] ) /x;
my $alist = qr/ [^]]* $listlikely /x;
my $hlist = qr/ [^}]* $listlikely /x;
my $clist = qr/ [^>]+ /x;

FILTER {

    $DB::single=1;
    my $text = "";
    pos = 0;

    while (pos($_)

        # array reference slice
        m/\G \$ ($ident) \.? \[ (?=$alist) /sxgc and
                $text .= qq/\@{\$$1}[/ and next;

        # array reference
        m/\G \$ ($ident) \.? \[ (?!$alist) /sxgc and
                $text .= qq/\$$1\->[/ and next;

        # hash reference constant slice
        m/\G \$ ($ident) \.? << (?=$clist) /sxgc and do {
                my $varname = $1;
                m/\G (.*?) >> /sxgc;
                my $quotedwords = $1;
                my $requotedwords = "'" . join("', '", split /\s+/, $quotedwords) . "'";
#warn "debug: quotedwords: $quotedwords\n";
#warn "debug: requotedwords: $requotedwords\n";
                if($quotedwords =~ /\s/) {
                    # @{$hashref}{foo, bar};
#warn 'hash reference constant slice: ' .  '@{$' . $varname . '}{' . $requotedwords . '}';
                    $text .=  '@{$' . $varname . '}{' . $requotedwords . '}';
                } else {
                    # $hashref->{foo}
#warn 'hash reference constant non-slice: ' .  '$' . $varname . '->{q<' . $quotedwords . '>}';
                    $text .=  '$' . $varname . '->{q<' . $quotedwords . '>}';
                }
                goto chain;
        };

        # hash reference slice
        m/\G \$ ($ident) \.? \{ (?=$hlist) /sxgc and
                $text .= qq/\@{\$$1}{/ and next;

        # hash reference with function subscript
        m/\G \$ ($ident) \.? \{ ($ident) \} /sxgc and
                $text .= '$' . $1 . '->{' . $2 . '()}' and next;

        # hash reference
        m/\G \$ ($ident) \.? \{ (?!$hlist) /sxgc and
                $text .= qq/\$$1\->{/ and next;

        # array slice
        m/\G \@ ($ident) \[ (?=$alist) /sxgc and
                $text .= qq/\@$1\[/ and next;

        # array
        m/\G \@ ($ident) \[ (?!$alist) /sxgc and
                $text .= qq/\$$1\[/ and next;

        # hash constant slice
        m/\G \% ($ident) << (?=$clist) /sxgc and do {
                my $varname = $1;
                m/\G (.*?) >> /sxgc;
                my $quotedwords = $1;
                my $requotedwords = "'" . join("', '", split /\s+/, $quotedwords) . "'";
#warn "debug: quotedwords: $quotedwords\n";
#warn "debug: requotedwords: $requotedwords\n";
                # $hash{foo} or @hash{foo, bar}
                $text .= ($quotedwords =~ /\s/ ? '@' : '$') . $varname . '{' . $requotedwords . '}';
                goto chain;
        };

        # hash slice
        m/\G \% ($ident) \{ (?=$hlist) /sxgc and
                $text .= qq/\@$1\{/ and next;

        # hash with function subscript
        m/\G \% ($ident) \{ ($ident) \} /sxgc and
                $text .= '$' . $1 . '{' . $2 . '()}' and next;

        # hash
        m/\G \% ($ident) \{ (?!$hlist) /sxgc and
                $text .= qq/\$$1\{/ and next;

        m/\G ([^\$\@%]+|.) /xgcs and
                $text .= $1;

        next;

        chain:

            if(m/\G << ($ident) >> /sxgc) {
                $text .= "{'" . $1 . "'}";
                goto chain;
            }

        next;

    }
    $_ = $text . substr($_, pos);
};

__END__