1################################################################################
2#
3#  mkapidoc.pl -- generate apidoc.fnc from scanning the Perl source
4#
5# Should be called from the base directory for Devel::PPPort.
6# If that happens to be in the /dist directory of a perl build structure, and
7# you're doing the standard thing, no parameters are required.  Otherwise
8# (again with the standard things, its single parameter is the base directory
9# of the perl source tree to be used.
10#
11################################################################################
12#
13#  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
14#  Version 2.x, Copyright (C) 2001, Paul Marquess.
15#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
16#
17#  This program is free software; you can redistribute it and/or
18#  modify it under the same terms as Perl itself.
19#
20################################################################################
21
22use warnings;
23use strict;
24
25my $PERLROOT = $ARGV[0];
26$PERLROOT = '../..' unless $PERLROOT;
27
28die "'$PERLROOT' is invalid, or you haven't successfully run 'make' in it"
29                                                unless -e "$PERLROOT/warnings.h";
30
31my $config= "$PERLROOT/config_h.SH";
32my %seen;
33
34# Find the files in MANIFEST that are core, but not embed.fnc, nor .t's
35my @files;
36open(my $m, '<', "$PERLROOT/MANIFEST") || die "MANIFEST:$!";
37while (<$m>) {                      # In embed.fnc,
38    chomp;
39    next if m! ^ embed \. fnc \t !x;
40    next if m! ^ ( cpan | dist | t) / !x;
41    next if m! [^\t]* \.t \t !x;
42    push @files, $_;
43}
44
45# These files are also needed.  This might have to be added to in the future.
46push @files, qw(pod/perlguts.pod lib/perlxs.pod);
47
48# Find the apidoc entries in all these files
49my @entries;
50for (@files) {
51
52    s/ \t .* //x;
53    open my $f, '<', "$PERLROOT/$_" or die "Can't open $_: $!";
54
55    my $line;
56    while (defined ($line = <$f>)) {
57        chomp $line;
58        next unless $line =~ /^ =for \s+ apidoc \s+
59                             (  [^|]* \|        # flags
60                                [^|]* \|        # return type
61                              ( [^|]* )         # name
62                                (?: \| .* )?    # optional args
63                             ) /x;
64        my $meat = $1;
65        my $name = $2;
66
67        if (exists $seen{$name}) {
68            if ($seen{$name} ne $meat) {
69                print STDERR
70                    "Contradictory prototypes for $name,\n$seen{$name}\n$meat\n";
71            }
72            next;
73        }
74
75        $meat =~ s/[ \t]+$//;
76        $seen{$name} = $meat;
77
78        # Many of the entries omit the "d" flag to indicate they are
79        # documented, but we wouldn't have found this unless it was documented
80        # in the source
81        $meat =~ s/\|/d|/ unless $meat =~ /^[^|]*d/;
82
83        push @entries, "$meat\n";
84    }
85}
86
87# The entries in config_h.SH are also (documented) macros that are
88# accessible to XS code, and ppport.h backports some of them.  We
89# use only the unconditionally compiled parameterless ones (as
90# that"s all that"s backported so far, and we don"t have to know
91# the types of the parameters).
92open(my $c, "<", $config) or die "$config: $!";
93my $if_depth = 0;   # We don"t use the ones within #if statements
94                    # The #ifndef that guards the whole file is not
95                    # noticed by the code below
96while (<$c>) {
97    $if_depth ++ if / ^ \# [[:blank:]]* (ifdef | if\ defined ) /x;
98    $if_depth -- if $if_depth > 0 && / ^ \# [[:blank:]]* endif /x;
99    next unless $if_depth <= 0;
100
101    # We are only interested in #defines with no parameters
102    next unless /^ \# [[:blank:]]* define [[:blank:]]+
103                        ( [A-Za-z][A-Za-z0-9]* )
104                        [[:blank:]]
105                /x;
106    next if $seen{$1}; # Ignore duplicates
107    push @entries, "Amnd||$1\n";
108    $seen{$1}++;
109}
110close $c or die "Close failed: $!";
111
112open my $out, ">", "parts/apidoc.fnc"
113                        or die "Can't open 'parts/apidoc.fnc' for writing: $!";
114require "./parts/inc/inctools";
115print $out <<EOF;
116::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
117:
118:  !!!! Do NOT edit this file directly! -- Edit devel/mkapidoc.sh instead. !!!!
119:
120:  This file was automatically generated from the API documentation scattered
121:  all over the Perl source code. To learn more about how all this works,
122:  please read the F<HACKERS> file that came with this distribution.
123:
124::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
125
126:
127: This file lists all API functions/macros that are documented in the Perl
128: source code, but are not contained in F<embed.fnc>.
129:
130EOF
131print $out sort sort_api_lines @entries;
132close $out or die "Close failed: $!";
133