view release on metacpan or  search on metacpan

devel/scanprov  view on Meta::CPAN

                       ? ((exists $base_ref->{$_->{"Perl_$_->{name}"}}
                           ? ()
                           : "Perl_$_->{name}"))
                       : $_->{name})
                  } @functions;

# These symbols will be found in the autogen'd files, and they may be
# commented out in them.
find_first_mentions($perls_ref,
                    \@missing,
                    [ 'embed.h', 'proto.h' ],
                    0,          # Don't strip comments
                   'F'
                   );

sub symbol_order    # Sort based on first word on line
{
    my $stripped_a = $a =~ s/ ^ \s* //rx;
    $stripped_a =~ s/ \s.* //x;

    my $stripped_b = $b =~ s/ ^ \s* //rx;
    $stripped_b =~ s/ \s.* //x;

    return dictionary_order($stripped_a, $stripped_b);
}

sub format_output_line
{
    my $sym = shift;
    my $code = shift;

    return sprintf "%-30s # $code $id_text\n", $sym;
}

sub find_first_mentions
{
    my $perls_ref =    shift;   # List of perls to look in
    my $look_for_ref = shift;   # List of symbol names to look for
    my $hdrs =         shift;   # Glob of hdrs to look in
    my $strip_comments = shift;
    my $code           = shift; # Mark entries as having this type

    use feature 'state';
    state $first_perl = 1;

    $hdrs = [ $hdrs ] unless ref $hdrs;

    my %remaining;
    $remaining{$_} = $code for @$look_for_ref;

    my %v;

    # We look in descending order of perl versions.  Each time through the
    # loop %remaining is narrowed.
    for my $p (@$perls_ref) {
        print "checking perl $p->{version}...\n";

        # Get the hdr files associated with this version
        my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`;
        chomp $archlib;
        local @ARGV;
        push @ARGV, glob "$archlib/CORE/$_" for @$hdrs;

        # %sym's keys are every single thing that looks like an identifier
        # (beginning with a non-digit \w, followed by \w*) that occurs in any
        # header, regardless of where (outside of comments).  For macros, it
        # can't end in an underscore, nor be like 'AbCd', which are marks for
        # internal.
        my %sym;

        local $/ = undef;
        while (<<>>) {  # Read in the whole next file as one string.

            # This would override function definitions with macro ones
            next if $code eq 'M' && $ARGV =~ m! / embed\.h $ !x;

            my $is_config_h = $ARGV =~ m! / config\.h $ !x;

            my $contents = $_;

            # Strip initial '/*' in config.h /*#define... lines.  This just
            # means the item isn't available on the platform this program is
            # being run on.
            $contents =~ s! ^ /\* \s* (?=\#\s*define\s) !!mx if $is_config_h;

            # Strip comments, from perl faq
            if ($strip_comments) {
                $contents =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#defined $2 ? $2 : ""#gse;
            }

            # For macros, we look for #defines
            if ($code eq 'M') {
                my %defines;

                while ($contents =~ m/ ^ \s* \# \s* define \s+

                                       # A symbol not ending in underscore
                                       ( [A-Za-z][_A-Za-z0-9]*[A-Za-z0-9] )
                                     /mxg)
                {
                    my $this_define = $1;

                    # These are internal and not of external interest, so just
                    # noise if we were to index them
                    next if $this_define =~ / ^ PERL_ARGS_ASSERT /x;

                    # Names like AbCd are internal
                    next if $this_define =~ /[[:upper:]][[:lower:]][[:upper:]][[:lower:]]/;

                    $defines{$this_define}++;
                }
                $sym{$_}++ for keys %defines;

                # For functions, etc we get all the symbols for the latest
                # perl passed in, but for macros, it is just the ones for the
                # known documented ones, and we have to find the rest.  This
                # allows us to keep the logic for that in just one place:
                # here.
                if ($first_perl) {

                    # config.h symbols are documented; the rest aren't, so use