1#!/usr/bin/perl -w 2# 3# Unconditionally regenerate: 4# 5# pod/perlintern.pod 6# pod/perlapi.pod 7# 8# from information stored in 9# 10# embed.fnc 11# plus all the .c and .h files listed in MANIFEST 12# 13# Has an optional arg, which is the directory to chdir to before reading 14# MANIFEST and *.[ch]. 15# 16# This script is invoked as part of 'make all' 17# 18# '=head1' are the only headings looked for. If the first non-blank line after 19# the heading begins with a word character, it is considered to be the first 20# line of documentation that applies to the heading itself. That is, it is 21# output immediately after the heading, before the first function, and not 22# indented. The next input line that is a pod directive terminates this 23# heading-level documentation. 24 25use strict; 26 27if (@ARGV) { 28 my $workdir = shift; 29 chdir $workdir 30 or die "Couldn't chdir to '$workdir': $!"; 31} 32require './regen/regen_lib.pl'; 33require './regen/embed_lib.pl'; 34 35# 36# See database of global and static function prototypes in embed.fnc 37# This is used to generate prototype headers under various configurations, 38# export symbols lists for different platforms, and macros to provide an 39# implicit interpreter context argument. 40# 41 42my %docs; 43my %funcflags; 44my %macro = ( 45 ax => 1, 46 items => 1, 47 ix => 1, 48 svtype => 1, 49 ); 50my %missing; 51 52my $curheader = "Unknown section"; 53 54sub autodoc ($$) { # parse a file and extract documentation info 55 my($fh,$file) = @_; 56 my($in, $doc, $line, $header_doc); 57 58 # Count lines easier 59 my $get_next_line = sub { $line++; return <$fh> }; 60 61FUNC: 62 while (defined($in = $get_next_line->())) { 63 if ($in =~ /^#\s*define\s+([A-Za-z_][A-Za-z_0-9]+)\(/ && 64 ($file ne 'embed.h' || $file ne 'proto.h')) { 65 $macro{$1} = $file; 66 next FUNC; 67 } 68 if ($in=~ /^=head1 (.*)/) { 69 $curheader = $1; 70 71 # If the next non-space line begins with a word char, then it is 72 # the start of heading-ldevel documentation. 73 if (defined($doc = $get_next_line->())) { 74 # Skip over empty lines 75 while ($doc =~ /^\s+$/) { 76 if (! defined($doc = $get_next_line->())) { 77 next FUNC; 78 } 79 } 80 81 if ($doc !~ /^\w/) { 82 $in = $doc; 83 redo FUNC; 84 } 85 $header_doc = $doc; 86 87 # Continue getting the heading-level documentation until read 88 # in any pod directive (or as a fail-safe, find a closing 89 # comment to this pod in a C language file 90HDR_DOC: 91 while (defined($doc = $get_next_line->())) { 92 if ($doc =~ /^=\w/) { 93 $in = $doc; 94 redo FUNC; 95 } 96 97 if ($doc =~ m:^\s*\*/$:) { 98 warn "=cut missing? $file:$line:$doc";; 99 last HDR_DOC; 100 } 101 $header_doc .= $doc; 102 } 103 } 104 next FUNC; 105 } 106 if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) { 107 my $proto = $1; 108 $proto = "||$proto" unless $proto =~ /\|/; 109 my($flags, $ret, $name, @args) = split /\|/, $proto; 110 my $docs = ""; 111DOC: 112 while (defined($doc = $get_next_line->())) { 113 114 # Other pod commands are considered part of the current 115 # function's docs, so can have lists, etc. 116 last DOC if $doc =~ /^=(cut|for\s+apidoc|head)/; 117 if ($doc =~ m:^\*/$:) { 118 warn "=cut missing? $file:$line:$doc";; 119 last DOC; 120 } 121 $docs .= $doc; 122 } 123 $docs = "\n$docs" if $docs and $docs !~ /^\n/; 124 125 # Check the consistency of the flags 126 my ($embed_where, $inline_where); 127 my ($embed_may_change, $inline_may_change); 128 129 my $docref = delete $funcflags{$name}; 130 if ($docref and %$docref) { 131 $embed_where = $docref->{flags} =~ /A/ ? 'api' : 'guts'; 132 $embed_may_change = $docref->{flags} =~ /M/; 133 $flags .= 'D' if $docref->{flags} =~ /D/; 134 } else { 135 $missing{$name} = $file; 136 } 137 if ($flags =~ /m/) { 138 $inline_where = $flags =~ /A/ ? 'api' : 'guts'; 139 $inline_may_change = $flags =~ /x/; 140 141 if (defined $embed_where && $inline_where ne $embed_where) { 142 warn "Function '$name' inconsistency: embed.fnc says $embed_where, Pod says $inline_where"; 143 } 144 145 if (defined $embed_may_change 146 && $inline_may_change ne $embed_may_change) { 147 my $message = "Function '$name' inconsistency: "; 148 if ($embed_may_change) { 149 $message .= "embed.fnc says 'may change', Pod does not"; 150 } else { 151 $message .= "Pod says 'may change', embed.fnc does not"; 152 } 153 warn $message; 154 } 155 } elsif (!defined $embed_where) { 156 warn "Unable to place $name!\n"; 157 next; 158 } else { 159 $inline_where = $embed_where; 160 $flags .= 'x' if $embed_may_change; 161 @args = @{$docref->{args}}; 162 $ret = $docref->{retval}; 163 } 164 165 if (exists $docs{$inline_where}{$curheader}{$name}) { 166 warn "$0: duplicate API entry for '$name' in $inline_where/$curheader\n"; 167 next; 168 } 169 $docs{$inline_where}{$curheader}{$name} 170 = [$flags, $docs, $ret, $file, @args]; 171 172 # Create a special entry with an empty-string name for the 173 # heading-level documentation. 174 if (defined $header_doc) { 175 $docs{$inline_where}{$curheader}{""} = $header_doc; 176 undef $header_doc; 177 } 178 179 if (defined $doc) { 180 if ($doc =~ /^=(?:for|head)/) { 181 $in = $doc; 182 redo FUNC; 183 } 184 } else { 185 warn "$file:$line:$in"; 186 } 187 } 188 } 189} 190 191sub docout ($$$) { # output the docs for one function 192 my($fh, $name, $docref) = @_; 193 my($flags, $docs, $ret, $file, @args) = @$docref; 194 $name =~ s/\s*$//; 195 196 if ($flags =~ /D/) { 197 $docs = "\n\nDEPRECATED! It is planned to remove this function from a 198future release of Perl. Do not use it for new code; remove it from 199existing code.\n\n$docs"; 200 } 201 else { 202 $docs = "\n\nNOTE: this function is experimental and may change or be 203removed without notice.\n\n$docs" if $flags =~ /x/; 204 } 205 $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" 206 if $flags =~ /p/; 207 $docs .= "NOTE: this function must be explicitly called as Perl_$name with an aTHX_ parameter.\n\n" 208 if $flags =~ /o/; 209 210 print $fh "=item $name\nX<$name>\n$docs"; 211 212 if ($flags =~ /U/) { # no usage 213 # nothing 214 } elsif ($flags =~ /s/) { # semicolon ("dTHR;") 215 print $fh "\t\t$name;\n\n"; 216 } elsif ($flags =~ /n/) { # no args 217 print $fh "\t$ret\t$name\n\n"; 218 } else { # full usage 219 my $p = $flags =~ /o/; # no #define foo Perl_foo 220 my $n = "Perl_"x$p . $name; 221 my $large_ret = length $ret > 7; 222 my $indent_size = 7+8 # nroff: 7 under =head + 8 under =item 223 +8+($large_ret ? 1 + length $ret : 8) 224 +length($n) + 1; 225 my $indent; 226 print $fh "\t$ret" . ($large_ret ? ' ' : "\t") . "$n("; 227 my $long_args; 228 for (@args) { 229 if ($indent_size + 2 + length > 79) { 230 $long_args=1; 231 $indent_size -= length($n) - 3; 232 last; 233 } 234 } 235 my $args = ''; 236 if ($p) { 237 $args = @args ? "pTHX_ " : "pTHX"; 238 if ($long_args) { print $fh $args; $args = '' } 239 } 240 $long_args and print $fh "\n"; 241 my $first = !$long_args; 242 while () { 243 if (!@args or 244 length $args 245 && $indent_size + 3 + length($args[0]) + length $args > 79 246 ) { 247 print $fh 248 $first ? '' : ( 249 $indent //= 250 "\t".($large_ret ? " " x (1+length $ret) : "\t") 251 ." "x($long_args ? 4 : 1 + length $n) 252 ), 253 $args, (","x($args ne 'pTHX_ ') . "\n")x!!@args; 254 $args = $first = ''; 255 } 256 @args or last; 257 $args .= ", "x!!(length $args && $args ne 'pTHX_ ') 258 . shift @args; 259 } 260 if ($long_args) { print $fh "\n", substr $indent, 0, -4 } 261 print $fh ")\n\n"; 262 } 263 print $fh "=for hackers\nFound in file $file\n\n"; 264} 265 266sub sort_helper { 267 # Do a case-insensitive dictionary sort, with only alphabetics 268 # significant, falling back to using everything for determinancy 269 return (uc($a =~ s/[[:^alpha:]]//r) cmp uc($b =~ s/[[:^alpha:]]//r)) 270 || uc($a) cmp uc($b) 271 || $a cmp $b; 272} 273 274sub output { 275 my ($podname, $header, $dochash, $missing, $footer) = @_; 276 # 277 # strip leading '|' from each line which had been used to hide 278 # pod from pod checkers. 279 s/^\|//gm for $header, $footer; 280 281 my $fh = open_new("pod/$podname.pod", undef, 282 {by => "$0 extracting documentation", 283 from => 'the C source files'}, 1); 284 285 print $fh $header; 286 287 my $key; 288 for $key (sort sort_helper keys %$dochash) { 289 my $section = $dochash->{$key}; 290 print $fh "\n=head1 $key\n\n"; 291 292 # Output any heading-level documentation and delete so won't get in 293 # the way later 294 if (exists $section->{""}) { 295 print $fh $section->{""} . "\n"; 296 delete $section->{""}; 297 } 298 print $fh "=over 8\n\n"; 299 300 for my $key (sort sort_helper keys %$section) { 301 docout($fh, $key, $section->{$key}); 302 } 303 print $fh "\n=back\n"; 304 } 305 306 if (@$missing) { 307 print $fh "\n=head1 Undocumented functions\n\n"; 308 print $fh $podname eq 'perlapi' ? <<'_EOB_' : <<'_EOB_'; 309The following functions have been flagged as part of the public API, 310but are currently undocumented. Use them at your own risk, as the 311interfaces are subject to change. Functions that are not listed in this 312document are not intended for public use, and should NOT be used under any 313circumstances. 314 315If you feel you need to use one of these functions, first send email to 316L<perl5-porters@perl.org|mailto:perl5-porters@perl.org>. It may be 317that there is a good reason for the function not being documented, and it 318should be removed from this list; or it may just be that no one has gotten 319around to documenting it. In the latter case, you will be asked to submit a 320patch to document the function. Once your patch is accepted, it will indicate 321that the interface is stable (unless it is explicitly marked otherwise) and 322usable by you. 323_EOB_ 324The following functions are currently undocumented. If you use one of 325them, you may wish to consider creating and submitting documentation for 326it. 327_EOB_ 328 print $fh "\n=over\n\n"; 329 330 for my $missing (sort @$missing) { 331 print $fh "=item $missing\nX<$missing>\n\n"; 332 } 333 print $fh "=back\n\n"; 334} 335 print $fh $footer, "=cut\n"; 336 337 read_only_bottom_close_and_rename($fh); 338} 339 340foreach (@{(setup_embed())[0]}) { 341 next if @$_ < 2; 342 my ($flags, $retval, $func, @args) = @$_; 343 s/\b(?:NN|NULLOK)\b\s+//g for @args; 344 345 $funcflags{$func} = { 346 flags => $flags, 347 retval => $retval, 348 args => \@args, 349 }; 350} 351 352# glob() picks up docs from extra .c or .h files that may be in unclean 353# development trees. 354open my $fh, '<', 'MANIFEST' 355 or die "Can't open MANIFEST: $!"; 356while (my $line = <$fh>) { 357 next unless my ($file) = $line =~ /^(\S+\.[ch])\t/; 358 359 open F, '<', $file or die "Cannot open $file for docs: $!\n"; 360 $curheader = "Functions in file $file\n"; 361 autodoc(\*F,$file); 362 close F or die "Error closing $file: $!\n"; 363} 364close $fh or die "Error whilst reading MANIFEST: $!"; 365 366for (sort keys %funcflags) { 367 next unless $funcflags{$_}{flags} =~ /d/; 368 warn "no docs for $_\n" 369} 370 371foreach (sort keys %missing) { 372 next if $macro{$_}; 373 # Heuristics for known not-a-function macros: 374 next if /^[A-Z]/; 375 next if /^dj?[A-Z]/; 376 377 warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc"; 378} 379 380# walk table providing an array of components in each line to 381# subroutine, printing the result 382 383# List of funcs in the public API that aren't also marked as experimental nor 384# deprecated. 385my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /[MD]/ && !$docs{api}{$_}, keys %funcflags; 386output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_'); 387|=encoding UTF-8 388| 389|=head1 NAME 390| 391|perlapi - autogenerated documentation for the perl public API 392| 393|=head1 DESCRIPTION 394|X<Perl API> X<API> X<api> 395| 396|This file contains the documentation of the perl public API generated by 397|F<embed.pl>, specifically a listing of functions, macros, flags, and variables 398|that may be used by extension writers. L<At the end|/Undocumented functions> 399|is a list of functions which have yet to be documented. The interfaces of 400|those are subject to change without notice. Anything not listed here is 401|not part of the public API, and should not be used by extension writers at 402|all. For these reasons, blindly using functions listed in proto.h is to be 403|avoided when writing extensions. 404| 405|In Perl, unlike C, a string of characters may generally contain embedded 406|C<NUL> characters. Sometimes in the documentation a Perl string is referred 407|to as a "buffer" to distinguish it from a C string, but sometimes they are 408|both just referred to as strings. 409| 410|Note that all Perl API global variables must be referenced with the C<PL_> 411|prefix. Again, those not listed here are not to be used by extension writers, 412|and can be changed or removed without notice; same with macros. 413|Some macros are provided for compatibility with the older, 414|unadorned names, but this support may be disabled in a future release. 415| 416|Perl was originally written to handle US-ASCII only (that is characters 417|whose ordinal numbers are in the range 0 - 127). 418|And documentation and comments may still use the term ASCII, when 419|sometimes in fact the entire range from 0 - 255 is meant. 420| 421|The non-ASCII characters below 256 can have various meanings, depending on 422|various things. (See, most notably, L<perllocale>.) But usually the whole 423|range can be referred to as ISO-8859-1. Often, the term "Latin-1" (or 424|"Latin1") is used as an equivalent for ISO-8859-1. But some people treat 425|"Latin1" as referring just to the characters in the range 128 through 255, or 426|somethimes from 160 through 255. 427|This documentation uses "Latin1" and "Latin-1" to refer to all 256 characters. 428| 429|Note that Perl can be compiled and run under either ASCII or EBCDIC (See 430|L<perlebcdic>). Most of the documentation (and even comments in the code) 431|ignore the EBCDIC possibility. 432|For almost all purposes the differences are transparent. 433|As an example, under EBCDIC, 434|instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so 435|whenever this documentation refers to C<utf8> 436|(and variants of that name, including in function names), 437|it also (essentially transparently) means C<UTF-EBCDIC>. 438|But the ordinals of characters differ between ASCII, EBCDIC, and 439|the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy a different 440|number of bytes than in UTF-8. 441| 442|The listing below is alphabetical, case insensitive. 443| 444_EOB_ 445| 446|=head1 AUTHORS 447| 448|Until May 1997, this document was maintained by Jeff Okamoto 449|<okamoto@corp.hp.com>. It is now maintained as part of Perl itself. 450| 451|With lots of help and suggestions from Dean Roehrich, Malcolm Beattie, 452|Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil 453|Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer, 454|Stephen McCamant, and Gurusamy Sarathy. 455| 456|API Listing originally by Dean Roehrich <roehrich@cray.com>. 457| 458|Updated to be autogenerated from comments in the source by Benjamin Stuhl. 459| 460|=head1 SEE ALSO 461| 462|L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern> 463| 464_EOE_ 465 466# List of non-static internal functions 467my @missing_guts = 468 grep $funcflags{$_}{flags} !~ /[As]/ && !$docs{guts}{$_}, keys %funcflags; 469 470output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END'); 471|=head1 NAME 472| 473|perlintern - autogenerated documentation of purely B<internal> 474| Perl functions 475| 476|=head1 DESCRIPTION 477|X<internal Perl functions> X<interpreter functions> 478| 479|This file is the autogenerated documentation of functions in the 480|Perl interpreter that are documented using Perl's internal documentation 481|format but are not marked as part of the Perl API. In other words, 482|B<they are not for use in extensions>! 483| 484END 485| 486|=head1 AUTHORS 487| 488|The autodocumentation system was originally added to the Perl core by 489|Benjamin Stuhl. Documentation is by whoever was kind enough to 490|document their functions. 491| 492|=head1 SEE ALSO 493| 494|L<perlguts>, L<perlapi> 495| 496END 497