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