view release on metacpan or  search on metacpan

lib/Acme/Gosub.pm  view on Meta::CPAN

package Acme::Gosub;

use strict;
use warnings;
use vars qw($VERSION);
use Carp;

$VERSION = '0.1.6';

# LOAD FILTERING MODULE...
use Filter::Util::Call;

# CATCH ATTEMPTS TO CALL case OUTSIDE THE SCOPE OF ANY switch

my $next_label_idx = 0;
use vars qw(%ret_labels);

$::_S_W_I_T_C_H = sub { croak "case/when statement not in switch/given block" };

my $offset;
my $fallthrough;

sub import
{
    $fallthrough = grep /\bfallthrough\b/, @_;
    $offset = (caller)[2]+1;
    filter_add({}) unless @_>1 && $_[1] eq 'noimport';
    my $pkg = caller;
    1;
}

sub unimport
{
    filter_del()
}

sub filter
{
    my($self) = @_ ;
    local $Acme::Gosub::file = (caller)[1];

    my $status = 1;
    $status = filter_read(1_000_000);
    return $status if $status<0;
        $_ = filter_blocks($_,$offset);
    $_ = "# line $offset\n" . $_ if $offset; undef $offset;
    return $status;
}

use Text::Balanced ':ALL';

sub line
{
    my ($pretext,$offset) = @_;
    ($pretext=~tr/\n/\n/)+($offset||0);
}

my $EOP = qr/\n\n|\Z/;
my $CUT = qr/\n=cut.*$EOP/;
my $pod_or_DATA = qr/ ^=(?:head[1-4]|item) .*? $CUT
                    | ^=pod .*? $CUT
                    | ^=for .*? $EOP
                    | ^=begin \s* (\S+) .*? \n=end \s* \1 .*? $EOP
                    | ^__(DATA|END)__\n.*
                    /smx;

my $casecounter = 1;
sub filter_blocks
{
    my ($source, $line) = @_;
    return $source unless $source =~ /gosub|greturn/;
    pos $source = 0;
    my $text = "";
    component: while (pos $source < length $source)
    {
        if ($source =~ m/(\G\s*use\s+Acme::Gosub\b)/gc)
        {
            $text .= q{use Acme::Gosub 'noimport'};
            next component;
        }
        my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0);
        if (defined $pos[0])
        {
            my $pre = substr($source,$pos[0],$pos[1]); # matched prefix
            $text .= $pre . substr($source,$pos[2],$pos[18]-$pos[2]);
            next component;
        }
        if ($source =~ m/\G\s*($pod_or_DATA)/gc) {
            next component;
        }
        @pos = Text::Balanced::_match_variable(\$source,qr/\s*/);
        if (defined $pos[0])
        {
            $text .= " " if $pos[0] < $pos[2];
            $text .= substr($source,$pos[0],$pos[4]-$pos[0]);
            next component;
        }

        if ($source =~ m/\G(\n*)(\s*)gosub\b/gc)
        {