view release on metacpan or  search on metacpan

lib/ExtUtils/ParseXS/Node.pm  view on Meta::CPAN

        my @bad = grep !/^\w+$/, @fields;
        die "Internal error: bad field name(s) in build_subclass: (@bad)\n"
            if @bad;

        no strict 'refs';

        my $class = caller(0);
        @fields   = (@{"${parent}::FIELDS"}, @fields);
        @{"${class}::ISA"}    = $parent;
        @{"${class}::FIELDS"} = @fields;

        if ($USING_FIELDS) {
            eval qq{package $class; fields->import(\@fields); 1;}
                or die $@;
        }
    };
};


# ======================================================================

package ExtUtils::ParseXS::Node;

# Base class for all the other node types.
#
# The 'use fields' enables compile-time or run-time errors if code
# attempts to use a key which isn't listed here.

BEGIN {
    our @FIELDS = (
        'line_no',       # line number and ...
        'file',          # ... filename where this node appeared in src
        'kids',          # child nodes, if any
    );

    # do 'use fields', except: fields needs Hash::Util which is XS, which
    # needs us. So only 'use fields' on systems where Hash::Util has already
    # been built.
    if (eval 'require Hash::Util; 1;') {
        require fields;
        $USING_FIELDS = 1;
        fields->import(@FIELDS);
    }
}


# new(): takes one optional arg, $args, which is a hash ref of key/value
# pairs to initialise the object with.

sub new {
    my ($class, $args) = @_;
    $args = {} unless defined $args;

    my __PACKAGE__  $self = shift;

    if ($USING_FIELDS) {
        $self = fields::new($class);
        %$self = %$args;
    }
    else {
        $self = bless { %$args } => $class;

    }
    return $self;
}


# A very generic parse method that just notes the current file/line no.
# Typically called first as a SUPER by the parse() method of real nodes.

sub parse {
    my __PACKAGE__       $self = shift;
    my ExtUtils::ParseXS $pxs  = shift;

    $self->{file}    = $pxs->{in_pathname};
                        # account for the line array getting shifted
                        # as input lines are consumed, while line_no
                        # array isn't ever shifted
    $self->{line_no} = $pxs->{line_no}->[
                            @{$pxs->{line_no}} - @{$pxs->{line}}
                        ];
    1;
}


# Repeatedly look for keywords matching the pattern. For each found
# keyword, parse the text following them, and add any resultant nodes
# as kids to the current node. Returns a list of the successfully parsed
# and added kids.
# If $max is defined, it specifies the maximum number of keywords to
# process. This value is typically passed as undef (unlimited) or 1
# (just grab the next keyword).
# $flags can contain  $keywords_flag_MODULE or
# keywords_flag_NOT_IMPLEMENTED_YET to indicate to match one of those
# keywords too (whose syntax is slightly different from 'KEY:' and
# so need special handling

sub parse_keywords {
    my __PACKAGE__       $self  = shift;
    my ExtUtils::ParseXS $pxs   = shift;
    my                   $xsub  = shift;
    my                   $xbody = shift;
    my $max                     = shift; # max number of keywords to process
    my $pat                     = shift;
    my $flags                   = shift;

    $flags = 0 unless defined $flags;

    my $n = 0;
    my @kids;
    while (@{$pxs->{line}}) {
        my $line = shift @{$pxs->{line}};
        next unless $line =~ /\S/;

        # extract/delete recognised keyword and any following text
        my $keyword;

        if (   ($flags & $keywords_flag_MODULE)
            && ExtUtils::ParseXS::Utilities::looks_like_MODULE_line($line)
           )
        {