1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
#!/usr/bin/perl
################################################################################
#
# mkapidoc.pl -- generate apidoc.fnc from scanning the Perl source
#
# Should be called from the base directory for Devel::PPPort.
# If that happens to be in the /dist directory of a perl build structure, and
# you're doing the standard thing, no parameters are required. Otherwise
# (again with the standard things, its single parameter is the base directory
# of the perl source tree to be used.
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
use warnings;
use strict;
use File::Find;
use re '/aa';
my $PERLROOT = $ARGV[0];
unless ($PERLROOT) {
$PERLROOT = '../..';
print STDERR "$0: perl directory root argument not specified. Assuming '$PERLROOT'\n";
}
die "'$PERLROOT' is invalid, or you haven't successfully run 'make' in it"
unless -e "$PERLROOT/warnings.h";
my $maindir = '.';
require "$maindir/parts/ppptools.pl";
my %seen;
# Find the files in MANIFEST that are core, but not embed.fnc, nor .t's
my @files;
open(my $m, '<', "$PERLROOT/MANIFEST") || die "MANIFEST:$!";
while (<$m>) { # In embed.fnc,
chomp;
next if m! ^ embed \. fnc \t !x;
next if m! ^ ( cpan | dist | t) / !x;
next if m! [^\t]* \.t \t !x;
s/\t.*//;
push @files, "$PERLROOT/$_";
}
close $m or die "Can't close $m: $!";
# Here, we have the lists of doc files and root First, get the known macros
# and functions from embed.fnc, converting from an array into a hash (for
# convenience)
my %embeds;
my %apidoc;
foreach my $entry (parse_embed("$maindir/parts/embed.fnc")) {
my $name = $entry->{'name'};
my $cond = $entry->{'cond'};
my $flags = join "", sort { lc $a cmp lc $b or $a cmp $b }
keys $entry->{flags}->%*;
my @arg_pairs;
foreach my $pair ($entry->{args}->@*) {
push @arg_pairs, join " ", $pair->@*;
}
my $args = join "|", @arg_pairs;
die "Multiple entries for $embeds{$name}{$cond}"
if defined $embeds{$name}{$cond};
# Save the embed.fnc entry
$embeds{$name}{$cond} = "$flags|$entry->{'ret'}|$name|$args";
}
# Examine the SEE ALSO section of perlapi which should contain links to all
# the pods with apidoc entries in them. Add them to the MANIFEST list.
my $file;
sub callback {
return unless $_ eq $file;
return if $_ eq 'config.h'; # We don't examine this one
return if $_ eq 'perlintern.pod'; # We don't examine this one
return if $File::Find::dir =~ / \/ ( cpan | dist | t ) \b /x;
push @files, $File::Find::name;
}
open my $a, '<', "$PERLROOT/pod/perlapi.pod"
or die "Can't open perlapi.pod ($PERLROOT needs to have been built): $!";
while (<$a>) {
next unless / ^ =head1\ SEE\ ALSO /x;
while (<$a>) {
# The lines look like:
# F<config.h>, L<perlintern>, L<perlapio>, L<perlcall>, L<perlclib>,
last if /^=/;
my @tags = split /, \s* | \s+ /x; # Allow comma- or just space-separated
foreach my $tag (@tags) {
if ($tag =~ / ^ F< (.*) > $ /x) {
$file = $1;
}
elsif ($tag =~ / ^ L< (.*) > $ /x) {
$file = "$1.pod";
}
else {
die "Unknown tag '$tag'";
}
find(\&callback, $PERLROOT);
}
}
}
my ($controlling_flags, $controlling_ret_type, $controlling_args);
# Look through all the files that potentially have apidoc entries
# These may be associated with embed.fnc, in which case we do nothing;
# otherwise, we output them to apidoc.fnc, potentially modified.
for my $file (@files) {
$file =~ s/ \t .* //x; # Trim all but first column
open my $f, '<', "$file" or die "Can't open $file: $!";
my $line;
while (defined ($line = <$f>)) {
chomp $line;
next unless $line =~ / ^ =for \s+ apidoc ( _item )? \s+
(?:
( [^|]*? ) # flags, backoff trailing
# white space
\s* \| \s*
( [^|]*? ) # return type
\s* \| \s*
)? # flags and ret type are all
# or nothing
( [^|]+? ) # name
\s*
(?: \| \s* ( .* ) \s* )? # optional args
$
/x;
my $item = $1 // 0;
my $flags = $2 // "";
my $ret_type = $3 // "";
my $name = $4;
my $args = $5 // "";
next unless $name; # Not an apidoc line
# If embed.fnc already contains this name, this better be an empty
# entry, unless it has the M flag, meaning there is another macro
# defined for it.
if (defined $embeds{$name}) {
my @conds = keys $embeds{$name}->%*;
# If this is just the anchor for where the pod is in the source,
# the entry is already fully in embed.fnc.
if ("$flags$ret_type$args" eq "") {
if (! $item) {
foreach my $cond (@conds) {
# For a plain apidoc entry, save the inputs, so as to apply them
# to any following apidoc_item lines.
($controlling_flags, $controlling_ret_type, $controlling_args)
= $embeds{$name}{$cond} =~ / ( [^|]* ) \| ( [^|]* ) \| (?: [^|]* ) \| (.*) /x;
$controlling_flags =~ s/[iMpb]//g;
$controlling_flags .= 'm' unless $controlling_flags =~ /m/;
last;
}
}
next;
}
# And the only reason we should have something with other
# information than what's in embed.fnc is if it is an M flag,
# meaning there is an extra macro for this function, and this is
# documenting that.
my $msg;
foreach my $cond (@conds) {
if ($embeds{$name}{$cond} !~ / ^ [^|]* M /x) {
$msg = "Specify only name when main entry is in embed.fnc";
last;
}
}
if (! defined $msg) {
if ($flags !~ /m/) {
$msg = "Must have 'm' flag for overriding 'M' embed.fnc entry";
}
elsif ($flags =~ /p/) {
$msg = "Must not have 'p' flag for overriding 'M' embed.fnc entry";
}
}
die "$msg: $file: $.: \n'$line'\n" if defined $msg;
}
# Here, we have an entry for apidoc.fnc, one that isn't in embed.fnc.
# If this is an apidoc_item line, there was a plain apidoc line
# earlier, and we saved the values from that to use here (if here is
# empty).
if ($item) {
$flags = $controlling_flags unless $flags ne "";
$ret_type = $controlling_ret_type unless $ret_type ne "";
$args = $controlling_args unless $args ne "";
}
else {
# For a plain apidoc entry, save the inputs, so as to apply them
# to any following apidoc_item lines.
$controlling_flags = $flags;
$controlling_ret_type = $ret_type;
$controlling_args = $args;
}
# Many of the entries omit the "d" flag to indicate they are
# documented, but we got here because of an apidoc line, which
# indicates it is documented in the source
$flags .= 'd' unless $flags =~ /d/;
# We currently don't handle typedefs, nor this special case
next if $flags =~ /y/;
next if $name eq 'JMPENV_PUSH';
my $entry = "$flags|$ret_type|$name";
$entry .= "|$args" if $args ne "";
$apidoc{$name}{entry} = $entry;
}
}
my $outfile = "$maindir/parts/apidoc.fnc";
open my $out, ">", $outfile
or die "Can't open '$outfile' for writing: $!";
require "$maindir/parts/inc/inctools";
print $out <<EOF;
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:
: !!!! Do NOT edit this file directly! -- Edit devel/mkapidoc.sh instead. !!!!
:
: This file was automatically generated from the API documentation scattered
: all over the Perl source code. To learn more about how all this works,
: please read the F<HACKERS> file that came with this distribution.
:
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:
: This file lists all API functions/macros that are documented in the Perl
: source code, but are not contained in F<embed.fnc>.
:
EOF
print $out join "\n", sort sort_api_lines map { $apidoc{$_}{entry} } keys %apidoc;
close $out or die "Close failed: $!";
print "$outfile regenerated\n";
|
