view release on metacpan or  search on metacpan

lib/PAX/Capture.pm  view on Meta::CPAN

            locale_sensitive => $source =~ /\buse\s+locale\b/ ? JSON::PP::true() : JSON::PP::false(),
            unicode_sensitive => $source =~ /\buse\s+utf8\b/ ? JSON::PP::true() : JSON::PP::false(),
        };
    }
    return \@patterns;
}

sub _compile_phase_events {
    my ($source) = @_;
    my @events;
    for my $hook (qw(BEGIN UNITCHECK CHECK INIT END)) {
        while ($source =~ /\b\Q$hook\E\s*\{/g) {
            push @events, {
                hook => $hook,
                offset => pos($source) - length($hook) - 1,
                source => 'static_scan',
            };
        }
    }
    while ($source =~ /\buse\s+([A-Za-z_][A-Za-z0-9_:]*)/g) {
        push @events, { hook => 'use', module => $1, source => 'static_scan' };

lib/PAX/RegionSelector.pm  view on Meta::CPAN

sub select {
    my ($self) = @_;
    my $manifest = $self->{manifest} // {};
    my $subs = $manifest->{optree_units}{subs} // [];
    my @regions;
    my @rejections;
    my $index = 0;

    for my $sub (@$subs) {
        my $name = $sub->{name} // next;
        next if $name =~ /^(main::BEGIN|main::UNITCHECK|main::CHECK|main::INIT)$/;
        next if !_is_application_sub($manifest, $sub);

        if (!$sub->{available}) {
            push @rejections, _reject($name, 'optree_unavailable', $sub->{reason});
            next;
        }

        my $kind = _classify_sub($name);
        my $support = _support_level($manifest, $kind);
        my $id = sprintf 'region-%04d', ++$index;

lib/PAX/RegionSelector.pm  view on Meta::CPAN

    }

    return {
        selected => \@regions,
        rejected => \@rejections,
    };
}

sub _classify_sub {
    my ($name) = @_;
    return 'compile_phase_hook' if $name =~ /::(?:BEGIN|UNITCHECK|CHECK|INIT)$/;
    return 'candidate_leaf_function';
}

sub _is_application_sub {
    my ($manifest, $sub) = @_;
    my $name = $sub->{name} // '';
    my $file = $sub->{closure_descriptor}{file} // '';
    return 0 if $name =~ /^main::_/;
    return 0 if $name =~ /^main::(?:encode_json|decode_json|svref_2object)$/;
    return 1 if $name =~ /^main::/;