xref: /openbsd/gnu/usr.bin/perl/autodoc.pl (revision 3d61058a)
1#!/usr/bin/perl -w
2
3use Text::Tabs;
4#
5# Unconditionally regenerate:
6#
7#    pod/perlintern.pod
8#    pod/perlapi.pod
9#
10# from information stored in
11#
12#    embed.fnc
13#    plus all the core .c, .h, and .pod files listed in MANIFEST
14#    plus %extra_input_pods
15
16my %extra_input_pods = ( 'dist/ExtUtils-ParseXS/lib/perlxs.pod' => 1 );
17
18# Has an optional arg, which is the directory to chdir to before reading
19# MANIFEST and the files
20#
21# This script is invoked as part of 'make all'
22#
23# The generated pod consists of sections of related elements, functions,
24# macros, and variables.  The keys of %valid_sections give the current legal
25# ones.  Just add a new key to add a section.
26#
27# Throughout the files read by this script are lines like
28#
29# =for apidoc_section Section Name
30# =for apidoc_section $section_name_variable
31#
32# "Section Name" (after having been stripped of leading space) must be one of
33# the legal section names, or an error is thrown.  $section_name_variable must
34# be one of the legal section name variables defined below; these expand to
35# legal section names.  This form is used so that minor wording changes in
36# these titles can be confined to this file.  All the names of the variables
37# end in '_scn'; this suffix is optional in the apidoc_section lines.
38#
39# All API elements defined between this line and the next 'apidoc_section'
40# line will go into the section "Section Name" (or $section_name_variable),
41# sorted by dictionary order within it.  perlintern and perlapi are parallel
42# documents, each potentially with a section "Section Name".  Each element is
43# marked as to which document it goes into.  If there are none for a
44# particular section in perlapi, that section is omitted.
45#
46# Also, in .[ch] files, there may be
47#
48# =head1 Section Name
49#
50# lines in comments.  These are also used by this program to switch to section
51# "Section Name".  The difference is that if there are any lines after the
52# =head1, inside the same comment, and before any =for apidoc-ish lines, they
53# are used as a heading for section "Section Name" (in both perlintern and
54# perlapi).  This includes any =head[2-5].  If more than one '=head1 Section
55# Name' line has content, they appear in the generated pod in an undefined
56# order.  Note that you can't use a $section_name_variable in =head1 lines
57#
58# The next =head1, =for apidoc_section, or file end terminates what goes into
59# the current section
60#
61# The %valid_sections hash below also can have header content, which will
62# appear before any =head1 content.  The hash can also have footer content
63# content, which will appear at the end of the section, after all the
64# elements.
65#
66# The lines that define the actual functions, etc are documented in embed.fnc,
67# because they have flags which must be kept in sync with that file.
68
69use strict;
70use warnings;
71
72my $config_h = 'config.h';
73if (@ARGV >= 2 && $ARGV[0] eq "-c") {
74    shift;
75    $config_h = shift;
76}
77
78my $nroff_min_indent = 4;   # for non-heading lines
79# 80 column terminal - 2 for pager adding 2 columns;
80my $max_width = 80 - 2 - $nroff_min_indent;
81my $standard_indent = 4;  # Any additional indentations
82
83if (@ARGV) {
84    my $workdir = shift;
85    chdir $workdir
86        or die "Couldn't chdir to '$workdir': $!";
87}
88require './regen/regen_lib.pl';
89require './regen/embed_lib.pl';
90
91my %described_elsewhere;
92
93#
94# See database of global and static function prototypes in embed.fnc
95# This is used to generate prototype headers under various configurations,
96# export symbols lists for different platforms, and macros to provide an
97# implicit interpreter context argument.
98#
99
100my %docs;
101my %seen;
102my %funcflags;
103my %missing;
104my %missing_macros;
105
106my $link_text = "Described in";
107
108my $description_indent = 4;
109my $usage_indent = 3;   # + initial blank yields 4 total
110
111my $AV_scn = 'AV Handling';
112my $callback_scn = 'Callback Functions';
113my $casting_scn = 'Casting';
114my $casing_scn = 'Character case changing';
115my $classification_scn = 'Character classification';
116my $names_scn = 'Character names';
117my $scope_scn = 'Compile-time scope hooks';
118my $compiler_scn = 'Compiler and Preprocessor information';
119my $directives_scn = 'Compiler directives';
120my $concurrency_scn = 'Concurrency';
121my $COP_scn = 'COPs and Hint Hashes';
122my $CV_scn = 'CV Handling';
123my $custom_scn = 'Custom Operators';
124my $debugging_scn = 'Debugging';
125my $display_scn = 'Display functions';
126my $embedding_scn = 'Embedding, Threads, and Interpreter Cloning';
127my $errno_scn = 'Errno';
128my $exceptions_scn = 'Exception Handling (simple) Macros';
129my $filesystem_scn = 'Filesystem configuration values';
130my $filters_scn = 'Source Filters';
131my $floating_scn = 'Floating point';
132my $genconfig_scn = 'General Configuration';
133my $globals_scn = 'Global Variables';
134my $GV_scn = 'GV Handling and Stashes';
135my $hook_scn = 'Hook manipulation';
136my $HV_scn = 'HV Handling';
137my $io_scn = 'Input/Output';
138my $io_formats_scn = 'I/O Formats';
139my $integer_scn = 'Integer';
140my $lexer_scn = 'Lexer interface';
141my $locale_scn = 'Locales';
142my $magic_scn = 'Magic';
143my $memory_scn = 'Memory Management';
144my $MRO_scn = 'MRO';
145my $multicall_scn = 'Multicall Functions';
146my $numeric_scn = 'Numeric Functions';
147my $rpp_scn = 'Reference-counted stack manipulation';
148
149# Now combined, as unclear which functions go where, but separate names kept
150# to avoid 1) other code changes; 2) in case it seems better to split again
151my $optrees_scn = 'Optrees';
152my $optree_construction_scn = $optrees_scn; # Was 'Optree construction';
153my $optree_manipulation_scn = $optrees_scn; # Was 'Optree Manipulation Functions'
154my $pack_scn = 'Pack and Unpack';
155my $pad_scn = 'Pad Data Structures';
156my $password_scn = 'Password and Group access';
157my $reports_scn = 'Reports and Formats';
158my $paths_scn = 'Paths to system commands';
159my $prototypes_scn = 'Prototype information';
160my $regexp_scn = 'REGEXP Functions';
161my $signals_scn = 'Signals';
162my $site_scn = 'Site configuration';
163my $sockets_scn = 'Sockets configuration values';
164my $stack_scn = 'Stack Manipulation Macros';
165my $string_scn = 'String Handling';
166my $SV_flags_scn = 'SV Flags';
167my $SV_scn = 'SV Handling';
168my $tainting_scn = 'Tainting';
169my $time_scn = 'Time';
170my $typedefs_scn = 'Typedef names';
171my $unicode_scn = 'Unicode Support';
172my $utility_scn = 'Utility Functions';
173my $versioning_scn = 'Versioning';
174my $warning_scn = 'Warning and Dieing';
175my $XS_scn = 'XS';
176
177# Kept separate at end
178my $undocumented_scn = 'Undocumented elements';
179
180my %valid_sections = (
181    $AV_scn => {},
182    $callback_scn => {},
183    $casting_scn => {},
184    $casing_scn => {},
185    $classification_scn => {},
186    $scope_scn => {},
187    $compiler_scn => {},
188    $directives_scn => {},
189    $concurrency_scn => {},
190    $COP_scn => {},
191    $CV_scn => {
192        header => <<~'EOT',
193            This section documents functions to manipulate CVs which are
194            code-values, meaning subroutines.  For more information, see
195            L<perlguts>.
196            EOT
197    },
198
199    $custom_scn => {},
200    $debugging_scn => {},
201    $display_scn => {},
202    $embedding_scn => {},
203    $errno_scn => {},
204    $exceptions_scn => {},
205    $filesystem_scn => {
206        header => <<~'EOT',
207            Also see L</List of capability HAS_foo symbols>.
208            EOT
209        },
210    $filters_scn => {},
211    $floating_scn => {
212        header => <<~'EOT',
213            Also L</List of capability HAS_foo symbols> lists capabilities
214            that arent in this section.  For example C<HAS_ASINH>, for the
215            hyperbolic sine function.
216            EOT
217        },
218    $genconfig_scn => {
219        header => <<~'EOT',
220            This section contains configuration information not otherwise
221            found in the more specialized sections of this document.  At the
222            end is a list of C<#defines> whose name should be enough to tell
223            you what they do, and a list of #defines which tell you if you
224            need to C<#include> files to get the corresponding functionality.
225            EOT
226
227        footer => <<~EOT,
228
229            =head2 List of capability C<HAS_I<foo>> symbols
230
231            This is a list of those symbols that dont appear elsewhere in ths
232            document that indicate if the current platform has a certain
233            capability.  Their names all begin with C<HAS_>.  Only those
234            symbols whose capability is directly derived from the name are
235            listed here.  All others have their meaning expanded out elsewhere
236            in this document.  This (relatively) compact list is because we
237            think that the expansion would add little or no value and take up
238            a lot of space (because there are so many).  If you think certain
239            ones should be expanded, send email to
240            L<perl5-porters\@perl.org|mailto:perl5-porters\@perl.org>.
241
242            Each symbol here will be C<#define>d if and only if the platform
243            has the capability.  If you need more detail, see the
244            corresponding entry in F<config.h>.  For convenience, the list is
245            split so that the ones that indicate there is a reentrant version
246            of a capability are listed separately
247
248            __HAS_LIST__
249
250            And, the reentrant capabilities:
251
252            __HAS_R_LIST__
253
254            Example usage:
255
256            =over $standard_indent
257
258             #ifdef HAS_STRNLEN
259               use strnlen()
260             #else
261               use an alternative implementation
262             #endif
263
264            =back
265
266            =head2 List of C<#include> needed symbols
267
268            This list contains symbols that indicate if certain C<#include>
269            files are present on the platform.  If your code accesses the
270            functionality that one of these is for, you will need to
271            C<#include> it if the symbol on this list is C<#define>d.  For
272            more detail, see the corresponding entry in F<config.h>.
273
274            __INCLUDE_LIST__
275
276            Example usage:
277
278            =over $standard_indent
279
280             #ifdef I_WCHAR
281               #include <wchar.h>
282             #endif
283
284            =back
285            EOT
286      },
287    $globals_scn => {},
288    $GV_scn => {},
289    $hook_scn => {},
290    $HV_scn => {},
291    $io_scn => {},
292    $io_formats_scn => {
293        header => <<~'EOT',
294            These are used for formatting the corresponding type For example,
295            instead of saying
296
297             Perl_newSVpvf(pTHX_ "Create an SV with a %d in it\n", iv);
298
299            use
300
301             Perl_newSVpvf(pTHX_ "Create an SV with a " IVdf " in it\n", iv);
302
303            This keeps you from having to know if, say an IV, needs to be
304            printed as C<%d>, C<%ld>, or something else.
305            EOT
306      },
307    $integer_scn => {},
308    $lexer_scn => {},
309    $locale_scn => {},
310    $magic_scn => {},
311    $memory_scn => {},
312    $MRO_scn => {},
313    $multicall_scn => {},
314    $numeric_scn => {},
315    $optrees_scn => {},
316    $optree_construction_scn => {},
317    $optree_manipulation_scn => {},
318    $pack_scn => {},
319    $pad_scn => {},
320    $password_scn => {},
321    $paths_scn => {},
322    $prototypes_scn => {},
323    $regexp_scn => {},
324    $reports_scn => {
325        header => <<~"EOT",
326            These are used in the simple report generation feature of Perl.
327            See L<perlform>.
328            EOT
329      },
330    $rpp_scn => {
331        header => <<~'EOT',
332            Functions for pushing and pulling items on the stack when the
333            stack is reference counted. They are intended as replacements
334            for the old PUSHs, POPi, EXTEND etc pp macros within pp
335            functions.
336            EOT
337      },
338    $signals_scn => {},
339    $site_scn => {
340        header => <<~'EOT',
341            These variables give details as to where various libraries,
342            installation destinations, I<etc.>, go, as well as what various
343            installation options were selected
344            EOT
345      },
346    $sockets_scn => {},
347    $stack_scn => {},
348    $string_scn => {
349        header => <<~EOT,
350            See also C<L</$unicode_scn>>.
351            EOT
352      },
353    $SV_flags_scn => {},
354    $SV_scn => {},
355    $tainting_scn => {},
356    $time_scn => {},
357    $typedefs_scn => {},
358    $unicode_scn => {
359        header => <<~EOT,
360            L<perlguts/Unicode Support> has an introduction to this API.
361
362            See also C<L</$classification_scn>>,
363            C<L</$casing_scn>>,
364            and C<L</$string_scn>>.
365            Various functions outside this section also work specially with
366            Unicode.  Search for the string "utf8" in this document.
367            EOT
368      },
369    $utility_scn => {},
370    $versioning_scn => {},
371    $warning_scn => {},
372    $XS_scn => {},
373);
374
375# Somewhat loose match for an apidoc line so we can catch minor typos.
376# Parentheses are used to capture portions so that below we verify
377# that things are the actual correct syntax.
378my $apidoc_re = qr/ ^ (\s*)            # $1
379                      (=?)             # $2
380                      (\s*)            # $3
381                      for (\s*)        # $4
382                      apidoc (_item)?  # $5
383                      (\s*)            # $6
384                      (.*?)            # $7
385                      \s* \n /x;
386# Only certain flags, dealing with display, are acceptable for apidoc_item
387my $display_flags = "fFnDopTx;";
388
389sub check_api_doc_line ($$) {
390    my ($file, $in) = @_;
391
392    return unless $in =~ $apidoc_re;
393
394    my $is_item = defined $5;
395    my $is_in_proper_form = length $1 == 0
396                         && length $2 > 0
397                         && length $3 == 0
398                         && length $4 > 0
399                         && length $7 > 0
400                         && (    length $6 > 0
401                             || ($is_item && substr($7, 0, 1) eq '|'));
402    my $proto_in_file = $7;
403    my $proto = $proto_in_file;
404    $proto = "||$proto" if $proto !~ /\|/;
405    my ($flags, $ret_type, $name, @args) = split /\s*\|\s*/, $proto;
406
407    $name && $is_in_proper_form or die <<EOS;
408Bad apidoc at $file line $.:
409  $in
410Expected:
411  =for apidoc flags|returntype|name|arg|arg|...
412  =for apidoc flags|returntype|name
413  =for apidoc name
414(or 'apidoc_item')
415EOS
416
417    die "Only [$display_flags] allowed in apidoc_item:\n$in"
418                            if $is_item && $flags =~ /[^$display_flags]/;
419
420    return ($name, $flags, $ret_type, $is_item, $proto_in_file, @args);
421}
422
423sub embed_override($) {
424    my ($element_name) = shift;
425
426    # If the entry is also in embed.fnc, it should be defined
427    # completely there, but not here
428    my $embed_docref = delete $funcflags{$element_name};
429
430    return unless $embed_docref and %$embed_docref;
431
432    my $flags = $embed_docref->{'flags'};
433    warn "embed.fnc entry '$element_name' missing 'd' flag"
434                                            unless $flags =~ /d/;
435
436    return ($flags, $embed_docref->{'ret_type'}, $embed_docref->{args}->@*);
437}
438
439# The section that is in effect at the beginning of the given file.  If not
440# listed here, an apidoc_section line must precede any apidoc lines.
441# This allows the files listed here that generally are single-purpose, to not
442# have to worry about the autodoc section
443my %initial_file_section = (
444                            'av.c' => $AV_scn,
445                            'av.h' => $AV_scn,
446                            'cv.h' => $CV_scn,
447                            'deb.c' => $debugging_scn,
448                            'dist/ExtUtils-ParseXS/lib/perlxs.pod' => $XS_scn,
449                            'doio.c' => $io_scn,
450                            'gv.c' => $GV_scn,
451                            'gv.h' => $GV_scn,
452                            'hv.h' => $HV_scn,
453                            'locale.c' => $locale_scn,
454                            'malloc.c' => $memory_scn,
455                            'numeric.c' => $numeric_scn,
456                            'opnames.h' => $optree_construction_scn,
457                            'pad.h'=> $pad_scn,
458                            'patchlevel.h' => $versioning_scn,
459                            'perlio.h' => $io_scn,
460                            'pod/perlapio.pod' => $io_scn,
461                            'pod/perlcall.pod' => $callback_scn,
462                            'pod/perlembed.pod' => $embedding_scn,
463                            'pod/perlfilter.pod' => $filters_scn,
464                            'pod/perliol.pod' => $io_scn,
465                            'pod/perlmroapi.pod' => $MRO_scn,
466                            'pod/perlreguts.pod' => $regexp_scn,
467                            'pp_pack.c' => $pack_scn,
468                            'pp_sort.c' => $SV_scn,
469                            'regcomp.c' => $regexp_scn,
470                            'regexp.h' => $regexp_scn,
471                            'sv.h' => $SV_scn,
472                            'sv.c' => $SV_scn,
473                            'sv_inline.h' => $SV_scn,
474                            'taint.c' => $tainting_scn,
475                            'unicode_constants.h' => $unicode_scn,
476                            'utf8.c' => $unicode_scn,
477                            'utf8.h' => $unicode_scn,
478                            'vutil.c' => $versioning_scn,
479                           );
480
481sub autodoc ($$) { # parse a file and extract documentation info
482    my($fh,$file) = @_;
483    my($in, $line_num, $header, $section);
484
485    $section = $initial_file_section{$file}
486                                    if defined $initial_file_section{$file};
487
488    my $file_is_C = $file =~ / \. [ch] $ /x;
489
490    # Count lines easier
491    my $get_next_line = sub { $line_num++; return <$fh> };
492
493    # Read the file
494    while ($in = $get_next_line->()) {
495        last unless defined $in;
496
497        next unless (    $in =~ / ^ =for [ ]+ apidoc /x
498                                      # =head1 lines only have effect in C files
499                     || ($file_is_C && $in =~ /^=head1/));
500
501        # Here, the line introduces a portion of the input that we care about.
502        # Either it is for an API element, or heading text which we expect
503        # will be used for elements later in the file
504
505        my ($text, $element_name, $flags, $ret_type, $is_item, $proto_in_file);
506        my (@args, @items);
507
508        # If the line starts a new section ...
509        if ($in=~ /^ = (?: for [ ]+ apidoc_section | head1 ) [ ]+ (.*) /x) {
510
511            $section = $1;
512            if ($section =~ / ^ \$ /x) {
513                $section .= '_scn' unless $section =~ / _scn $ /;
514                $section = eval "$section";
515                die "Unknown \$section variable '$section' in $file: $@" if $@;
516            }
517            die "Unknown section name '$section' in $file near line $.\n"
518                                    unless defined $valid_sections{$section};
519
520        }
521        elsif ($in=~ /^ =for [ ]+ apidoc \B /x) {   # Otherwise better be a
522                                                    # plain apidoc line
523            die "Unknown apidoc-type line '$in'" unless $in=~ /^=for apidoc_item/;
524            die "apidoc_item doesn't immediately follow an apidoc entry: '$in'";
525        }
526        else {  # Plain apidoc
527
528            ($element_name, $flags, $ret_type, $is_item, $proto_in_file, @args)
529                                                = check_api_doc_line($file, $in);
530            # Override this line with any info in embed.fnc
531            my ($embed_flags, $embed_ret_type, @embed_args)
532                                                = embed_override($element_name);
533            if ($embed_ret_type) {
534                warn "embed.fnc entry overrides redundant information in"
535                    . " '$proto_in_file' in $file"
536                                               if $flags || $ret_type || @args;
537                $flags = $embed_flags;
538                $ret_type = $embed_ret_type;
539                @args = @embed_args;
540            }
541            elsif ($flags !~ /[my]/)  { # Not in embed.fnc, is missing if not
542                                        # a macro or typedef
543                $missing{$element_name} = $file;
544            }
545
546            die "flag '$1' is not legal (for function $element_name (from $file))"
547                        if $flags =~ / ( [^AabCDdEeFfGhiIMmNnTOoPpRrSsUuvWXxy;#] ) /x;
548
549            die "'u' flag must also have 'm' or 'y' flags' for $element_name"
550                                            if $flags =~ /u/ && $flags !~ /[my]/;
551            warn ("'$element_name' not \\w+ in '$proto_in_file' in $file")
552                        if $flags !~ /N/ &&
553                           $element_name !~ / ^ (?:struct\s+)? [_[:alpha:]] \w* $ /x;
554
555            if ($flags =~ /#/) {
556                die "Return type must be empty for '$element_name'"
557                                                                   if $ret_type;
558                $ret_type = '#ifdef';
559            }
560
561            if (exists $seen{$element_name} && $flags !~ /h/) {
562                die ("'$element_name' in $file was already documented in $seen{$element_name}");
563            }
564            else {
565                $seen{$element_name} = $file;
566            }
567        }
568
569        # Here we have processed the initial line in the heading text or API
570        # element, and have saved the important information from it into the
571        # corresponding variables.  Now accumulate the text that applies to it
572        # up to a terminating line, which is one of:
573        # 1) =cut
574        # 2) =head (in a C file only =head1)
575        # 3) an end comment line in a C file: m:^\s*\*/:
576        # 4) =for apidoc... (except apidoc_item lines)
577        $text = "";
578        my $head_ender_num = ($file_is_C) ? 1 : "";
579        while (defined($in = $get_next_line->())) {
580
581            last if $in =~ /^=cut/x;
582            last if $in =~ /^=head$head_ender_num/;
583
584            if ($file_is_C && $in =~ m: ^ \s* \* / $ :x) {
585
586                # End of comment line in C files is a fall-back terminator,
587                # but warn only if there actually is some accumulated text
588                warn "=cut missing? $file:$line_num:$in" if $text =~ /\S/;
589                last;
590            }
591
592            if ($in !~ / ^ =for [ ]+ apidoc /x) {
593                $text .= $in;
594                next;
595            }
596
597            # Here, the line is an apidoc line.  All but apidoc_item terminate
598            # the text being accumulated.
599            last if $in =~ / ^ =for [ ]+ apidoc_section /x;
600
601            my ($item_name, $item_flags, $item_ret_type, $is_item,
602                    $item_proto, @item_args) = check_api_doc_line($file, $in);
603            last unless $is_item;
604
605            # Here, is an apidoc_item_line; They can only come within apidoc
606            # paragraphs.
607            die "Unexpected api_doc_item line '$item_proto'"
608                                                        unless $element_name;
609
610            # We accept blank lines between these, but nothing else;
611            die "apidoc_item lines must immediately follow apidoc lines for "
612              . " '$element_name' in $file"
613                                                            if $text =~ /\S/;
614            # Override this line with any info in embed.fnc
615            my ($embed_flags, $embed_ret_type, @embed_args)
616                                                = embed_override($item_name);
617            if ($embed_ret_type) {
618                warn "embed.fnc entry overrides redundant information in"
619                    . " '$item_proto' in $file"
620                                if $item_flags || $item_ret_type || @item_args;
621
622                $item_flags = $embed_flags;
623                $item_ret_type = $embed_ret_type;
624                @item_args = @embed_args;
625            }
626
627            # Use the base entry flags if none for this item; otherwise add in
628            # any non-display base entry flags.
629            if ($item_flags) {
630                $item_flags .= $flags =~ s/[$display_flags]//rg;
631            }
632            else {
633                $item_flags = $flags;
634            }
635            $item_ret_type = $ret_type unless $item_ret_type;
636            @item_args = @args unless @item_args;
637            push @items, { name     => $item_name,
638                           ret_type => $item_ret_type,
639                           flags    => $item_flags,
640                           args     => [ @item_args ],
641                         };
642
643            # This line shows that this element is documented.
644            delete $funcflags{$item_name};
645        }
646
647        # Here, are done accumulating the text for this item.  Trim it
648        $text =~ s/ ^ \s* //x;
649        $text =~ s/ \s* $ //x;
650        $text .= "\n" if $text ne "";
651
652        # And treat all-spaces as nothing at all
653        undef $text unless $text =~ /\S/;
654
655        if ($element_name) {
656
657            # Here, we have accumulated into $text, the pod for $element_name
658            my $where = $flags =~ /A/ ? 'api' : 'intern';
659
660            die "No =for apidoc_section nor =head1 in $file for '$element_name'\n"
661                                                    unless defined $section;
662            my $is_link_only = ($flags =~ /h/);
663            if (! $is_link_only && exists $docs{$where}{$section}{$element_name}) {
664                warn "$0: duplicate API entry for '$element_name' in"
665                    . " $where/$section\n";
666                next;
667            }
668
669            # Override the text with just a link if the flags call for that
670            if ($is_link_only) {
671                if ($file_is_C) {
672                    die "Can't currently handle link with items to it:\n$in"
673                                                                       if @items;
674                    $docs{$where}{$section}{X_tags}{$element_name} = $file;
675                    redo;    # Don't put anything if C source
676                }
677
678                # Here, is an 'h' flag in pod.  We add a reference to the pod (and
679                # nothing else) to perlapi/intern.  (It would be better to add a
680                # reference to the correct =item,=header, but something that makes
681                # it harder is that it that might be a duplicate, like '=item *';
682                # so that is a future enhancement XXX.  Another complication is
683                # there might be more than one deserving candidates.)
684                my $podname = $file =~ s!.*/!!r;    # Rmv directory name(s)
685                $podname =~ s/\.pod//;
686                $text = "Described in L<$podname>.\n";
687
688                # Don't output a usage example for linked to documentation if
689                # it is trivial (has no arguments) and we aren't to add a
690                # semicolon
691                $flags .= 'U' if $flags =~ /n/ && $flags !~ /[U;]/;
692
693                # Keep track of all the pod files that we refer to.
694                push $described_elsewhere{$podname}->@*, $podname;
695            }
696
697            $docs{$where}{$section}{$element_name}{flags} = $flags;
698            $docs{$where}{$section}{$element_name}{pod} = $text;
699            $docs{$where}{$section}{$element_name}{file} = $file;
700            $docs{$where}{$section}{$element_name}{ret_type} = $ret_type;
701            push $docs{$where}{$section}{$element_name}{args}->@*, @args;
702            push $docs{$where}{$section}{$element_name}{items}->@*, @items;
703        }
704        elsif ($text) {
705            $valid_sections{$section}{header} = "" unless
706                                    defined $valid_sections{$section}{header};
707            $valid_sections{$section}{header} .= "\n$text";
708        }
709
710        # We already have the first line of what's to come in $in
711        redo;
712
713    } # End of loop through input
714}
715
716my %configs;
717my @has_defs;
718my @has_r_defs;     # Reentrant symbols
719my @include_defs;
720
721sub parse_config_h {
722    use re '/aa';   # Everything is ASCII in this file
723
724    # Process config.h
725    die "Can't find $config_h" unless -e $config_h;
726    open my $fh, '<', $config_h or die "Can't open $config_h: $!";
727    while (<$fh>) {
728
729        # Look for lines like /* FOO_BAR:
730        # By convention all config.h descriptions begin like that
731        if (m[ ^ /\* [ ] ( [[:alpha:]] \w+ ) : \s* $ ]ax) {
732            my $name = $1;
733
734            # Here we are starting the description for $name in config.h.  We
735            # accumulate the entire description for it into @description.
736            # Flowing text from one input line to another is appended into the
737            # same array element to make a single flowing line element, but
738            # verbatim lines are kept as separate elements in @description.
739            # This will facilitate later doing pattern matching without regard
740            # to line boundaries on non-verbatim text.
741
742            die "Multiple config.h entries for '$name'"
743                                        if defined $configs{$name}{description};
744
745            # Get first line of description
746            $_ = <$fh>;
747
748            # Each line in the description begins with blanks followed by '/*'
749            # and some spaces.
750            die "Unexpected config.h initial line for $name: '$_'"
751                                            unless s/ ^ ( \s* \* \s* ) //x;
752            my $initial_text = $1;
753
754            # Initialize the description with this first line (after having
755            # stripped the prefix text)
756            my @description = $_;
757
758            # The first line is used as a template for how much indentation
759            # each normal succeeding line has.  Lines indented further
760            # will be considered as intended to be verbatim.  But, empty lines
761            # likely won't have trailing blanks, so just strip the whole thing
762            # for them.
763            my $strip_initial_qr = qr!   \s* \* \s* $
764                                    | \Q$initial_text\E
765                                    !x;
766            $configs{$name}{verbatim} = 0;
767
768            # Read in the remainder of the description
769            while (<$fh>) {
770                last if s| ^ \s* \* / ||x;  # A '*/' ends it
771
772                die "Unexpected config.h description line for $name: '$_'"
773                                                unless s/$strip_initial_qr//;
774
775                # Fix up the few flawed lines in config.h wherein a new
776                # sentence begins with a tab (and maybe a space after that).
777                # Although none of them currently do, let it recognize
778                # something like
779                #
780                #   "... text").  The next sentence ...
781                #
782                s/ ( \w "? \)? \. ) \t \s* ( [[:alpha:]] ) /$1  $2/xg;
783
784                # If this line has extra indentation or looks to have columns,
785                # it should be treated as verbatim.  Columns are indicated by
786                # use of interior: tabs, 3 spaces in a row, or even 2 spaces
787                # not preceded by punctuation.
788                if ($_ !~ m/  ^ \s
789                              | \S (?:                    \t
790                                    |                     \s{3}
791                                    |  (*nlb:[[:punct:]]) \s{2}
792                                   )
793                           /x)
794                {
795                    # But here, is not a verbatim line.  Add an empty line if
796                    # this is the first non-verbatim after a run of verbatims
797                    if ($description[-1] =~ /^\s/) {
798                        push @description, "\n", $_;
799                    }
800                    else {  # Otherwise, append this flowing line to the
801                            # current flowing line
802                        $description[-1] .= $_;
803                    }
804                }
805                else {
806                    $configs{$name}{verbatim} = 1;
807
808                    # The first verbatim line in a run of them is separated by an
809                    # empty line from the flowing lines above it
810                    push @description, "\n" if $description[-1] =~ /^\S/;
811
812                    $_ = Text::Tabs::expand($_);
813
814                    # Only a single space so less likely to wrap
815                    s/ ^ \s* / /x;
816
817                    push @description, $_;
818                }
819            }
820
821            push $configs{$name}{description}->@*, @description
822
823        }   # Not a description; see if it is a macro definition.
824        elsif (m! ^
825                  (?: / \* )?                   # Optional commented-out
826                                                # indication
827                      \# \s* define \s+ ( \w+ ) # $1 is the name
828                  (   \s* )                     # $2 indicates if args or not
829                  (   .*? )                     # $3 is any definition
830                  (?: / \s* \* \* / )?          # Optional trailing /**/ or / **/
831                  $
832                !x)
833        {
834            my $name = $1;
835
836            # There can be multiple definitions for a name.  We want to know
837            # if any of them has arguments, and if any has a body.
838            $configs{$name}{has_args} //= $2 eq "";
839            $configs{$name}{has_args} ||= $2 eq "";
840            $configs{$name}{has_defn} //= $3 ne "";
841            $configs{$name}{has_defn} ||= $3 ne "";
842        }
843    }
844
845    # We now have stored the description and information about every #define
846    # in the file.  The description is in a form convenient to operate on to
847    # convert to pod.  Do that now.
848    foreach my $name (keys %configs) {
849        next unless defined $configs{$name}{description};
850
851        # All adjacent non-verbatim lines of the description are appended
852        # together in a single element in the array.  This allows the patterns
853        # to work across input line boundaries.
854
855        my $pod = "";
856        while (defined ($_ = shift $configs{$name}{description}->@*)) {
857            chomp;
858
859            if (/ ^ \S /x) {  # Don't edit verbatim lines
860
861                # Enclose known file/path names not already so enclosed
862                # with <...>.  (Some entries in config.h are already
863                # '<path/to/file>')
864                my $file_name_qr = qr! [ \w / ]+ \.
865                                    (?: c | h | xs | p [lm] | pmc | PL
866                                        | sh | SH | exe ) \b
867                                    !xx;
868                my $path_name_qr = qr! (?: / \w+ )+ !x;
869                for my $re ($file_name_qr, $path_name_qr) {
870                    s! (*nlb:[ < \w / ]) ( $re ) !<$1>!gxx;
871                }
872
873                # Enclose <... file/path names with F<...> (but no double
874                # angle brackets)
875                for my $re ($file_name_qr, $path_name_qr) {
876                    s! < ( $re ) > !F<$1>!gxx;
877                }
878
879                # Explain metaconfig units
880                s/ ( \w+ \. U \b ) /$1 (part of metaconfig)/gx;
881
882                # Convert "See foo" to "See C<L</foo>>" if foo is described in
883                # this file.  Also create a link to the known file INSTALL.
884                # And, to be more general, handle "See also foo and bar", and
885                # "See also foo, bar, and baz"
886                while (m/ \b [Ss]ee \s+
887                         (?: also \s+ )?    ( \w+ )
888                         (?: ,  \s+         ( \w+ ) )?
889                         (?: ,? \s+ and \s+ ( \w+ ) )? /xg) {
890                    my @links = $1;
891                    push @links, $2 if defined $2;
892                    push @links, $3 if defined $3;
893                    foreach my $link (@links) {
894                        if ($link eq 'INSTALL') {
895                            s/ \b INSTALL \b /C<L<INSTALL>>/xg;
896                        }
897                        elsif (grep { $link =~ / \b $_ \b /x } keys %configs) {
898                            s| \b $link \b |C<L</$link>>|xg;
899                            $configs{$link}{linked} = 1;
900                            $configs{$name}{linked} = 1;
901                        }
902                    }
903                }
904
905                # Enclose what we think are symbols with C<...>.
906                no warnings 'experimental::vlb';
907                s/ (*nlb:<)
908                   (
909                        # Any word followed immediately with parens or
910                        # brackets
911                        \b \w+ (?: \( [^)]* \)    # parameter list
912                                 | \[ [^]]* \]    # or array reference
913                               )
914                    | (*plb: ^ | \s ) -D \w+    # Also -Dsymbols.
915                    | \b (?: struct | union ) \s \w+
916
917                        # Words that contain underscores (which are
918                        # definitely not text) or three uppercase letters in
919                        # a row.  Length two ones, like IV, aren't enclosed,
920                        # because they often don't look as nice.
921                    | \b \w* (?: _ | [[:upper:]]{3,} ) \w* \b
922                   )
923                    (*nla:>)
924                 /C<$1>/xg;
925
926                # These include foo when the name is HAS_foo.  This is a
927                # heuristic which works in most cases.
928                if ($name =~ / ^ HAS_ (.*) /x) {
929                    my $symbol = lc $1;
930
931                    # Don't include path components, nor things already in
932                    # <>, or with trailing '(', '['
933                    s! \b (*nlb:[/<]) $symbol (*nla:[[/>(]) \b !C<$symbol>!xg;
934                }
935            }
936
937            $pod .=  "$_\n";
938        }
939        delete $configs{$name}{description};
940
941        $configs{$name}{pod} = $pod;
942    }
943
944    # Now have converted the description to pod.  We also now have enough
945    # information that we can do cross checking to find definitions without
946    # corresponding pod, and see if they are mentioned in some description;
947    # otherwise they aren't documented.
948  NAME:
949    foreach my $name (keys %configs) {
950
951        # A definition without pod
952        if (! defined $configs{$name}{pod}) {
953
954            # Leading/trailing underscore means internal to config.h, e.g.,
955            # _GNU_SOURCE
956            next if $name =~ / ^ _ /x;
957            next if $name =~ / _ $ /x;
958
959            # MiXeD case names are internal to config.h; the first 4
960            # characters are sufficient to determine this
961            next if $name =~ / ^ [[:upper:]] [[:lower:]]
962                                 [[:upper:]] [[:lower:]]
963                            /x;
964
965            # Here, not internal to config.h.  Look to see if this symbol is
966            # mentioned in the pod of some other.  If so, assume it is
967            # documented.
968            foreach my $check_name (keys %configs) {
969                my $this_element = $configs{$check_name};
970                my $this_pod = $this_element->{pod};
971                if (defined $this_pod) {
972                    next NAME if $this_pod =~ / \b $name \b /x;
973                }
974            }
975
976            warn "$name has no documentation\n";
977            $missing_macros{$name} = 'config.h';
978
979            next;
980        }
981
982        my $has_defn = $configs{$name}{has_defn};
983        my $has_args = $configs{$name}{has_args};
984
985        # Check if any section already has an entry for this element.
986        # If so, it better be a placeholder, in which case we replace it
987        # with this entry.
988        foreach my $section (keys $docs{'api'}->%*) {
989            if (exists $docs{'api'}{$section}{$name}) {
990                my $was = $docs{'api'}{$section}{$name}->{pod};
991                $was = "" unless $was;
992                chomp $was;
993                if ($was ne "" && $was !~ m/$link_text/) {
994                    die "Multiple descriptions for $name\n"
995                        . "The '$section' section contained\n'$was'";
996                }
997                $docs{'api'}{$section}{$name}->{pod} = $configs{$name}{pod};
998                $configs{$name}{section} = $section;
999                last;
1000            }
1001            elsif (exists $docs{'intern'}{$section}{$name}) {
1002                die "'$name' is in 'config.h' meaning it is part of the API,\n"
1003                  . " but it is also in 'perlintern', meaning it isn't API\n";
1004            }
1005        }
1006
1007        my $handled = 0;    # Haven't handled this yet
1008
1009        if (defined $configs{$name}{'section'}) {
1010            # This has been taken care of elsewhere.
1011            $handled = 1;
1012        }
1013        else {
1014            my $flags = "";
1015            if ($has_defn && ! $has_args) {
1016                $configs{$name}{args} = 1;
1017            }
1018
1019            # Symbols of the form I_FOO are for #include files.  They have
1020            # special usage information
1021            if ($name =~ / ^ I_ ( .* ) /x) {
1022                my $file = lc $1 . '.h';
1023                $configs{$name}{usage} = <<~"EOT";
1024                    #ifdef $name
1025                        #include <$file>
1026                    #endif
1027                    EOT
1028            }
1029
1030            # Compute what section this variable should go into.  This
1031            # heuristic was determined by manually inspecting the current
1032            # things in config.h, and should be adjusted as necessary as
1033            # deficiencies are found.
1034            #
1035            # This is the default section for macros with a definition but
1036            # no arguments, meaning it is replaced unconditionally
1037            #
1038            my $sb = qr/ _ | \b /x; # segment boundary
1039            my $dash_or_spaces = qr/ - | \s+ /x;
1040            my $pod = $configs{$name}{pod};
1041            if ($name =~ / ^ USE_ /x) {
1042                $configs{$name}{'section'} = $site_scn;
1043            }
1044            elsif ($name =~ / SLEEP | (*nlb:SYS_) TIME | TZ | $sb TM $sb /x)
1045            {
1046                $configs{$name}{'section'} = $time_scn;
1047            }
1048            elsif (   $name =~ / ^ [[:alpha:]]+ f $ /x
1049                   && $configs{$name}{pod} =~ m/ \b format \b /ix)
1050            {
1051                $configs{$name}{'section'} = $io_formats_scn;
1052            }
1053            elsif ($name =~ /  DOUBLE | FLOAT | LONGDBL | LDBL | ^ NV
1054                            | $sb CASTFLAGS $sb
1055                            | QUADMATH
1056                            | $sb (?: IS )? NAN
1057                            | $sb (?: IS )? FINITE
1058                            /x)
1059            {
1060                $configs{$name}{'section'} =
1061                                    $floating_scn;
1062            }
1063            elsif ($name =~ / (?: POS | OFF | DIR ) 64 /x) {
1064                $configs{$name}{'section'} = $filesystem_scn;
1065            }
1066            elsif (   $name =~ / $sb (?: BUILTIN | CPP ) $sb | ^ CPP /x
1067                   || $configs{$name}{pod} =~ m/ \b align /x)
1068            {
1069                $configs{$name}{'section'} = $compiler_scn;
1070            }
1071            elsif ($name =~ / ^ [IU] [ \d V ]
1072                            | ^ INT | SHORT | LONG | QUAD | 64 | 32 /xx)
1073            {
1074                $configs{$name}{'section'} = $integer_scn;
1075            }
1076            elsif ($name =~ / $sb t $sb /x) {
1077                $configs{$name}{'section'} = $typedefs_scn;
1078                $flags .= 'y';
1079            }
1080            elsif (   $name =~ / ^ PERL_ ( PRI | SCN ) | $sb FORMAT $sb /x
1081                    && $configs{$name}{pod} =~ m/ \b format \b /ix)
1082            {
1083                $configs{$name}{'section'} = $io_formats_scn;
1084            }
1085            elsif ($name =~ / BACKTRACE /x) {
1086                $configs{$name}{'section'} = $debugging_scn;
1087            }
1088            elsif ($name =~ / ALLOC $sb /x) {
1089                $configs{$name}{'section'} = $memory_scn;
1090            }
1091            elsif (   $name =~ /   STDIO | FCNTL | EOF | FFLUSH
1092                                | $sb FILE $sb
1093                                | $sb DIR $sb
1094                                | $sb LSEEK
1095                                | $sb INO $sb
1096                                | $sb OPEN
1097                                | $sb CLOSE
1098                                | ^ DIR
1099                                | ^ INO $sb
1100                                | DIR $
1101                                | FILENAMES
1102                                /x
1103                    || $configs{$name}{pod} =~ m!  I/O | stdio
1104                                                | file \s+ descriptor
1105                                                | file \s* system
1106                                                | statfs
1107                                                !x)
1108            {
1109                $configs{$name}{'section'} = $filesystem_scn;
1110            }
1111            elsif ($name =~ / ^ SIG | SIGINFO | signal /ix) {
1112                $configs{$name}{'section'} = $signals_scn;
1113            }
1114            elsif ($name =~ / $sb ( PROTO (?: TYPE)? S? ) $sb /x) {
1115                $configs{$name}{'section'} = $prototypes_scn;
1116            }
1117            elsif (   $name =~ / ^ LOC_ /x
1118                    || $configs{$name}{pod} =~ /full path/i)
1119            {
1120                $configs{$name}{'section'} = $paths_scn;
1121            }
1122            elsif ($name =~ / $sb LC_ | LOCALE | langinfo /xi) {
1123                $configs{$name}{'section'} = $locale_scn;
1124            }
1125            elsif ($configs{$name}{pod} =~ /  GCC | C99 | C\+\+ /xi) {
1126                $configs{$name}{'section'} = $compiler_scn;
1127            }
1128            elsif ($name =~ / PASSW (OR)? D | ^ PW | ( PW | GR ) ENT /x)
1129            {
1130                $configs{$name}{'section'} = $password_scn;
1131            }
1132            elsif ($name =~ /  SOCKET | $sb SOCK /x) {
1133                $configs{$name}{'section'} = $sockets_scn;
1134            }
1135            elsif (   $name =~ / THREAD | MULTIPLICITY /x
1136                    || $configs{$name}{pod} =~ m/ \b pthread /ix)
1137            {
1138                $configs{$name}{'section'} = $concurrency_scn;
1139            }
1140            elsif ($name =~ /  PERL | ^ PRIV | SITE | ARCH | BIN
1141                                | VENDOR | ^ USE
1142                            /x)
1143            {
1144                $configs{$name}{'section'} = $site_scn;
1145            }
1146            elsif (   $pod =~ / \b floating $dash_or_spaces point \b /ix
1147                   || $pod =~ / \b (double | single) $dash_or_spaces precision \b /ix
1148                   || $pod =~ / \b doubles \b /ix
1149                   || $pod =~ / \b (?: a | the | long ) \s+ (?: double | NV ) \b /ix)
1150            {
1151                $configs{$name}{'section'} =
1152                                    $floating_scn;
1153            }
1154            else {
1155                # Above are the specific sections.  The rest go into a
1156                # grab-bag of general configuration values.  However, we put
1157                # two classes of them into lists of their names, without their
1158                # descriptions, when we think that the description doesn't add
1159                # any real value.  One list contains the #include variables:
1160                # the description is basically boiler plate for each of these.
1161                # The other list contains the very many things that are of the
1162                # form HAS_foo, and \bfoo\b is contained in its description,
1163                # and there is no verbatim text in the pod or links to/from it
1164                # (which would add value).  That means that it is likely the
1165                # intent of the variable can be gleaned from just its name,
1166                # and unlikely the description adds significant value, so just
1167                # listing them suffices.  Giving their descriptions would
1168                # expand this pod significantly with little added value.
1169                if (   ! $has_defn
1170                    && ! $configs{$name}{verbatim}
1171                    && ! $configs{$name}{linked})
1172                {
1173                    if ($name =~ / ^ I_ ( .* ) /x) {
1174                        push @include_defs, $name;
1175                        next;
1176                    }
1177                    elsif ($name =~ / ^ HAS_ ( .* ) /x) {
1178                        my $canonical_name = $1;
1179                        $canonical_name =~ s/_//g;
1180
1181                        my $canonical_pod = $configs{$name}{pod};
1182                        $canonical_pod =~ s/_//g;
1183
1184                        if ($canonical_pod =~ / \b $canonical_name \b /xi) {
1185                            if ($name =~ / $sb R $sb /x) {
1186                                push @has_r_defs, $name;
1187                            }
1188                            else {
1189                                push @has_defs, $name;
1190                            }
1191                            next;
1192                        }
1193                    }
1194                }
1195
1196                $configs{$name}{'section'} = $genconfig_scn;
1197            }
1198
1199            my $section = $configs{$name}{'section'};
1200            die "Internal error: '$section' not in \%valid_sections"
1201                            unless grep { $_ eq $section } keys %valid_sections;
1202            $flags .= 'AdmnT';
1203            $flags .= 'U' unless defined $configs{$name}{usage};
1204
1205            # All the information has been gathered; save it
1206            $docs{'api'}{$section}{$name}{flags} = $flags;
1207            $docs{'api'}{$section}{$name}{pod} = $configs{$name}{pod};
1208            $docs{'api'}{$section}{$name}{ret_type} = "";
1209            $docs{'api'}{$section}{$name}{file} = 'config.h';
1210            $docs{'api'}{$section}{$name}{usage}
1211                = $configs{$name}{usage} if defined $configs{$name}{usage};
1212            push $docs{'api'}{$section}{$name}{args}->@*, ();
1213            push $docs{'api'}{$section}{$name}{items}->@*, ();
1214        }
1215    }
1216}
1217
1218sub format_pod_indexes($) {
1219    my $entries_ref = shift;
1220
1221    # Output the X<> references to the names, packed since they don't get
1222    # displayed, but not too many per line so that when someone is editing the
1223    # file, it doesn't run on
1224
1225    my $text ="";
1226    my $line_length = 0;
1227    for my $name (sort dictionary_order $entries_ref->@*) {
1228        my $entry = "X<$name>";
1229        my $entry_length = length $entry;
1230
1231        # Don't loop forever if we have a verrry long name, and don't go too
1232        # far to the right.
1233        if ($line_length > 0 && $line_length + $entry_length > $max_width) {
1234            $text .= "\n";
1235            $line_length = 0;
1236        }
1237
1238        $text .= $entry;
1239        $line_length += $entry_length;
1240    }
1241
1242    return $text;
1243}
1244
1245sub docout ($$$) { # output the docs for one function group
1246    my($fh, $element_name, $docref) = @_;
1247
1248    # Trim trailing space
1249    $element_name =~ s/\s*$//;
1250
1251    my $flags = $docref->{flags};
1252    my $pod = $docref->{pod} // "";
1253    my $file = $docref->{file};
1254
1255    my @items = $docref->{items}->@*;
1256
1257    # Make the main element the first of the items.  This allows uniform
1258    # treatment below
1259    unshift @items, {   name => $element_name,
1260                        flags => $flags,
1261                        ret_type => $docref->{ret_type},
1262                        args => [ $docref->{args}->@* ],
1263                    };
1264
1265    warn("Empty pod for $element_name (from $file)") unless $pod =~ /\S/;
1266
1267    print $fh "\n=over $description_indent\n";
1268    print $fh "\n=item C<$_->{name}>\n" for @items;
1269
1270    # If we're printing only a link to an element, this isn't the major entry,
1271    # so no X<> here.
1272    if ($flags !~ /h/) {
1273        print $fh "X<$_->{name}>" for @items;
1274        print $fh "\n";
1275    }
1276
1277    my @deprecated;
1278    my @experimental;
1279    for my $item (@items) {
1280        push @deprecated,   "C<$item->{name}>" if $item->{flags} =~ /D/;
1281        push @experimental, "C<$item->{name}>" if $item->{flags} =~ /x/;
1282    }
1283
1284    for my $which (\@deprecated, \@experimental) {
1285        if ($which->@*) {
1286            my $is;
1287            my $it;
1288            my $list;
1289
1290            if ($which->@* == 1) {
1291                $is = 'is';
1292                $it = 'it';
1293                $list = $which->[0];
1294            }
1295            elsif ($which->@* == @items) {
1296                $is = 'are';
1297                $it = 'them';
1298                $list = (@items == 2)
1299                         ? "both forms"
1300                         : "all these forms";
1301            }
1302            else {
1303                $is = 'are';
1304                $it = 'them';
1305                my $final = pop $which->@*;
1306                $list = "the " . join ", ", $which->@*;
1307                $list .= "," if $which->@* > 1;
1308                $list .= " and $final forms";
1309            }
1310
1311            if ($which == \@deprecated) {
1312                print $fh <<~"EOT";
1313
1314                    C<B<DEPRECATED!>>  It is planned to remove $list
1315                    from a future release of Perl.  Do not use $it for
1316                    new code; remove $it from existing code.
1317                    EOT
1318            }
1319            else {
1320                print $fh <<~"EOT";
1321
1322                    NOTE: $list $is B<experimental> and may change or be
1323                    removed without notice.
1324                    EOT
1325            }
1326        }
1327    }
1328
1329    chomp $pod;     # Make sure prints pod with a single trailing \n
1330    print $fh "\n", $pod, "\n";
1331
1332    for my $item (@items) {
1333        my $item_flags = $item->{flags};
1334        my $item_name = $item->{name};
1335
1336        print $fh "\nNOTE: the C<perl_$item_name()> form is B<deprecated>.\n"
1337                                                    if $item_flags =~ /O/;
1338        # Is Perl_, but no #define foo # Perl_foo
1339        if (   ($item_flags =~ /p/ && $item_flags =~ /o/ && $item_flags !~ /M/)
1340
1341                # Can't handle threaded varargs
1342            || (   $item_flags =~ /f/
1343                && $item_flags !~ /T/
1344                && $item_name !~ /strftime/))
1345        {
1346            $item->{name} = "Perl_$item_name";
1347            print $fh <<~"EOT";
1348
1349                NOTE: C<$item_name> must be explicitly called as
1350                C<$item->{name}>
1351                EOT
1352            print $fh "with an C<aTHX_> parameter" if $item_flags !~ /T/;
1353            print $fh ".\n";
1354        }
1355    }
1356
1357    if ($flags =~ /[Uy]/) { # no usage; typedefs are considered simple enough
1358                            # to never warrant a usage line
1359        warn("U and ; flags are incompatible")
1360                                            if $flags =~ /U/ && $flags =~ /;/;
1361        # nothing
1362    } else {
1363
1364        print $fh "\n=over $usage_indent\n";
1365
1366        if (defined $docref->{usage}) {     # An override of the usage section
1367            print $fh "\n", ($docref->{usage} =~ s/^/ /mrg), "\n";
1368        }
1369        else {
1370
1371            # Add the thread context formal parameter on expanded-out names
1372            for my $item (@items) {
1373                unshift $item->{args}->@*, (($item->{args}->@*)
1374                                            ? "pTHX_"
1375                                            : "pTHX")
1376                                                   if $item->{flags} !~ /T/
1377                                                   && $item->{name} =~ /^Perl_/;
1378            }
1379
1380            # Look through all the items in this entry.  If all have the same
1381            # return type and arguments (including thread context), only the
1382            # main entry is displayed.
1383            # Also, find the longest return type and longest name so that if
1384            # multiple ones are shown, they can be vertically aligned nicely
1385            my $need_individual_usage = 0;
1386            my $longest_name_length = length $items[0]->{name};
1387            my $base_ret_type = $items[0]->{ret_type};
1388            my $longest_ret = length $base_ret_type;
1389            my @base_args = $items[0]->{args}->@*;
1390            my $base_thread_context = $items[0]->{flags} =~ /T/;
1391            for (my $i = 1; $i < @items; $i++) {
1392                my $item = $items[$i];
1393                my $args_are_equal = $item->{args}->@* == @base_args
1394                  && !grep $item->{args}[$_] ne $base_args[$_], keys @base_args;
1395                $need_individual_usage = 1
1396                                    if    $item->{ret_type} ne $base_ret_type
1397                                    || !  $args_are_equal
1398                                    ||   (   $item->{flags} =~ /T/
1399                                          != $base_thread_context);
1400                my $ret_length = length $item->{ret_type};
1401                $longest_ret = $ret_length if $ret_length > $longest_ret;
1402                my $name_length = length $item->{name};
1403                $longest_name_length = $name_length
1404                                        if $name_length > $longest_name_length;
1405            }
1406
1407            # If we're only showing one entry, only its length matters.
1408            $longest_name_length = length($items[0]->{name})
1409                                                unless $need_individual_usage;
1410            print $fh "\n";
1411
1412            my $indent = 1;     # 1 is sufficient for verbatim; =over is used
1413                                # for more
1414            my $ret_name_sep_length = 2; # spaces between return type and name
1415            my $name_indent = $indent + $longest_ret;
1416            $name_indent += $ret_name_sep_length if $longest_ret;
1417
1418            my $this_max_width =
1419                               $max_width - $description_indent - $usage_indent;
1420
1421            for my $item (@items) {
1422                my $ret_type = $item->{ret_type};
1423                my @args = $item->{args}->@*;
1424                my $name = $item->{name};
1425                my $item_flags = $item->{flags};
1426
1427                # The return type
1428                print $fh (" " x $indent), $ret_type;
1429
1430                print $fh " " x (  $ret_name_sep_length
1431                                 + $longest_ret - length $ret_type);
1432                print $fh $name;
1433
1434                if ($item_flags =~ /n/) { # no args
1435                    warn("$file: $element_name: n flag without m")
1436                                                    unless $item_flags =~ /m/;
1437                    warn("$file: $name: n flag but apparently has args")
1438                                                                    if @args;
1439                }
1440                else {
1441                    # +1 for the '('
1442                    my $arg_indent = $name_indent + $longest_name_length + 1;
1443
1444                    # Align the argument lists of the items
1445                    print $fh " " x ($longest_name_length - length($name));
1446                    print $fh "(";
1447
1448                    # Display as many of the arguments on the same line as
1449                    # will fit.
1450                    my $total_length = $arg_indent;
1451                    my $first_line = 1;
1452                    for (my $i = 0; $i < @args; $i++) {
1453                        my $arg = $args[$i];
1454                        my $arg_length = length($arg);
1455
1456                        # All but the first arg are preceded by a blank
1457                        my $use_blank = $i > 0;
1458
1459                        # +1 here and below because either the argument has a
1460                        # trailing comma or trailing ')'
1461                        $total_length += $arg_length + $use_blank + 1;
1462
1463                        # We want none of the arguments to be positioned so
1464                        # they extend too far to the right.  Ideally, they
1465                        # should all start in the same column as the arguments
1466                        # on the first line of the function display do.  But, if
1467                        # necessary, outdent them so that they all start in
1468                        # another column, with the longest ending at the right
1469                        # margin, like so:
1470                        #                   void  function_name(pTHX_ short1,
1471                        #                                    short2,
1472                        #                                    very_long_argument,
1473                        #                                    short3)
1474                        if ($total_length > $this_max_width) {
1475
1476                            # If this is the first continuation line,
1477                            # calculate the longest argument; this will be the
1478                            # one we may have to outdent for.
1479                            if ($first_line) {
1480                                $first_line = 0;
1481
1482                                # We will need at least as much as the current
1483                                # argument
1484                                my $longest_arg_length = $arg_length
1485                                                       + $use_blank + 1;
1486
1487                                # Look through the rest of the args to see if
1488                                # any are longer than this one.
1489                                for (my $j = $i + 1; $j < @args; $j++) {
1490
1491                                    # Include the trailing ',' or ')' in the
1492                                    # length.  No need to concern ourselves
1493                                    # with a leading blank, as the argument
1494                                    # would be positioned first on the next
1495                                    # line
1496                                    my $peek_arg_length = length ($args[$j])
1497                                                        + 1;
1498                                    $longest_arg_length = $peek_arg_length
1499                                      if $peek_arg_length > $longest_arg_length;
1500                                }
1501
1502                                # Calculate the new indent if necessary.
1503                                $arg_indent =
1504                                        $this_max_width - $longest_arg_length
1505                                        if $arg_indent + $longest_arg_length
1506                                                            > $this_max_width;
1507                            }
1508
1509                            print $fh "\n", (" " x $arg_indent);
1510                            $total_length = $arg_indent + $arg_length + 1;
1511                            $use_blank = 0;
1512                        }
1513
1514                        # Display this argument
1515                        print $fh " " if $use_blank;
1516                        print $fh $arg;
1517                        print $fh "," if $i < @args - 1 && $args[$i] ne 'pTHX_';
1518
1519                    } # End of loop through args
1520
1521                    print $fh ")";
1522                }
1523
1524                print $fh ";" if $item_flags =~ /;/; # semicolon: "dTHR;"
1525                print $fh "\n";
1526
1527                # Only the first entry is normally displayed
1528                last unless $need_individual_usage;
1529            }
1530        }
1531
1532        print $fh "\n=back\n";
1533    }
1534
1535    print $fh "\n=back\n";
1536    print $fh "\n=for hackers\nFound in file $file\n";
1537}
1538
1539sub construct_missings_section {
1540    my ($missings_hdr, $missings_ref) = @_;
1541    my $text = "";
1542
1543    $text .= "$missings_hdr\n" . format_pod_indexes($missings_ref);
1544
1545    if ($missings_ref->@* == 0) {
1546        return $text . "\nThere are currently no items of this type\n";
1547    }
1548
1549    # Sort the elements.
1550    my @missings = sort dictionary_order $missings_ref->@*;
1551
1552    # Make a table of the missings in columns.  Give the subroutine a width
1553    # one less than you might expect, as we indent each line by one, to mark
1554    # it as verbatim.
1555    my $table .= columnarize_list(\@missings, $max_width - 1);
1556    $table =~ s/^/ /gm;
1557
1558    return $text . "\n\n" . $table;
1559}
1560
1561sub dictionary_order {
1562    # Do a case-insensitive dictionary sort, falling back in stages to using
1563    # everything for determinancy.  The initial comparison ignores
1564    # all non-word characters and non-trailing underscores and digits, with
1565    # trailing ones collating to after any other characters.  This collation
1566    # order continues in case tie breakers are needed; sequences of digits
1567    # that do get looked at always compare numerically.  The first tie
1568    # breaker takes all digits and underscores into account.  The next tie
1569    # breaker uses a caseless character-by-character comparison of everything
1570    # (including non-word characters).  Finally is a cased comparison.
1571    #
1572    # This gives intuitive results, but obviously could be tweaked.
1573
1574    no warnings 'non_unicode';
1575
1576    local $a = $a;
1577    local $b = $b;
1578
1579    # Convert all digit sequences to same length with leading zeros, so for
1580    # example, 8 will compare less than 16 (using a fill length value that
1581    # should be longer than any sequence in the input).
1582    $a =~ s/(\d+)/sprintf "%06d", $1/ge;
1583    $b =~ s/(\d+)/sprintf "%06d", $1/ge;
1584
1585    # Translate any underscores and digits so they compare after all Unicode
1586    # characters
1587    $a =~ tr[_0-9]/\x{110000}-\x{11000A}/;
1588    $b =~ tr[_0-9]/\x{110000}-\x{11000A}/;
1589
1590    use feature 'state';
1591    # Modify \w, \W to reflect the changes.
1592    state $ud = '\x{110000}-\x{11000A}';    # xlated underscore, digits
1593    state $w = "\\w$ud";                    # new \w string
1594    state $mod_w = qr/[$w]/;
1595    state $mod_W = qr/[^$w]/;
1596
1597    # Only \w for initial comparison
1598    my $a_only_word = uc($a =~ s/$mod_W//gr);
1599    my $b_only_word = uc($b =~ s/$mod_W//gr);
1600
1601    # And not initial nor interior underscores nor digits (by squeezing them
1602    # out)
1603    my $a_stripped = $a_only_word =~ s/ (*atomic:[$ud]+) (*pla: $mod_w ) //grxx;
1604    my $b_stripped = $b_only_word =~ s/ (*atomic:[$ud]+) (*pla: $mod_w ) //grxx;
1605
1606    # If the stripped versions differ, use that as the comparison.
1607    my $cmp = $a_stripped cmp $b_stripped;
1608    return $cmp if $cmp;
1609
1610    # For the first tie breaker, repeat, but consider initial and interior
1611    # underscores and digits, again having those compare after all Unicode
1612    # characters
1613    $cmp = $a_only_word cmp $b_only_word;
1614    return $cmp if $cmp;
1615
1616    # Next tie breaker is just a caseless comparison
1617    $cmp = uc($a) cmp uc($b);
1618    return $cmp if $cmp;
1619
1620    # Finally a straight comparison
1621    return $a cmp $b;
1622}
1623
1624sub output {
1625    my ($podname, $header, $dochash, $footer, @missings_refs) = @_;
1626    #
1627    # strip leading '|' from each line which had been used to hide
1628    # pod from pod checkers.
1629    s/^\|//gm for $header, $footer, @missings_refs;
1630
1631    my $fh = open_new("pod/$podname.pod", undef,
1632                      {by => "$0 extracting documentation",
1633                       from => 'the C source files'}, 1);
1634
1635    print $fh $header, "\n";
1636
1637    for my $section_name (sort dictionary_order keys %valid_sections) {
1638        my $section_info = $dochash->{$section_name};
1639
1640        # We allow empty sections in perlintern.
1641        if (! $section_info && $podname eq 'perlapi') {
1642            warn "Empty section '$section_name' for $podname; skipped";
1643            next;
1644        }
1645
1646        print $fh "\n=head1 $section_name\n";
1647
1648        if ($section_info->{X_tags}) {
1649            print $fh "X<$_>" for sort keys $section_info->{X_tags}->%*;
1650            print $fh "\n";
1651            delete $section_info->{X_tags};
1652        }
1653
1654        if ($podname eq 'perlapi') {
1655            print $fh "\n", $valid_sections{$section_name}{header}, "\n"
1656                                if defined $valid_sections{$section_name}{header};
1657
1658            # Output any heading-level documentation and delete so won't get in
1659            # the way later
1660            if (exists $section_info->{""}) {
1661                print $fh "\n", $section_info->{""}, "\n";
1662                delete $section_info->{""};
1663            }
1664        }
1665
1666        if ($section_info && keys $section_info->%*) {
1667            for my $function_name (sort dictionary_order keys %$section_info) {
1668                docout($fh, $function_name, $section_info->{$function_name});
1669            }
1670        }
1671        else {
1672            my $pod_type = ($podname eq 'api') ? "public" : "internal";
1673            print $fh "\nThere are currently no $pod_type API items in ",
1674                      $section_name, "\n";
1675        }
1676
1677        print $fh "\n", $valid_sections{$section_name}{footer}, "\n"
1678                            if $podname eq 'perlapi'
1679                            && defined $valid_sections{$section_name}{footer};
1680    }
1681
1682
1683    my $first_time = 1;
1684    while (1) {
1685        my $missings_hdr = shift @missings_refs or last;
1686        my $missings_ref = shift @missings_refs or die "Foo";
1687
1688        if ($first_time) {
1689            $first_time = 0;
1690            print $fh <<~EOT;
1691
1692                =head1 $undocumented_scn
1693
1694                EOT
1695        }
1696
1697        print $fh construct_missings_section($missings_hdr, $missings_ref);
1698    }
1699
1700    print $fh "\n$footer\n=cut\n";
1701
1702    read_only_bottom_close_and_rename($fh);
1703}
1704
1705foreach (@{(setup_embed())[0]}) {
1706    my $embed= $_->{embed}
1707        or next;
1708    my ($flags, $ret_type, $func, $args) = @{$embed}{qw(flags return_type name args)};
1709    my @munged_args= @$args;
1710    s/\b(?:NN|NULLOK)\b\s+//g for @munged_args;
1711
1712    $funcflags{$func} = {
1713                         flags => $flags,
1714                         ret_type => $ret_type,
1715                         args => \@munged_args,
1716                        };
1717}
1718
1719# glob() picks up docs from extra .c or .h files that may be in unclean
1720# development trees.
1721open my $fh, '<', 'MANIFEST'
1722    or die "Can't open MANIFEST: $!";
1723while (my $line = <$fh>) {
1724    next unless my ($file) = $line =~ /^(\S+\.(?:[ch]|pod))\t/;
1725
1726    # Don't pick up pods from these.
1727    next if $file =~ m! ^ ( cpan | dist | ext ) / !x
1728         && ! defined $extra_input_pods{$file};
1729
1730    open F, '<', $file or die "Cannot open $file for docs: $!\n";
1731    autodoc(\*F,$file);
1732    close F or die "Error closing $file: $!\n";
1733}
1734close $fh or die "Error whilst reading MANIFEST: $!";
1735
1736parse_config_h();
1737
1738for (sort keys %funcflags) {
1739    next unless $funcflags{$_}{flags} =~ /d/;
1740    next if $funcflags{$_}{flags} =~ /h/;
1741    warn "no docs for $_\n";
1742}
1743
1744foreach (sort keys %missing) {
1745    warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc";
1746}
1747
1748# List of funcs in the public API that aren't also marked as core-only,
1749# experimental nor deprecated.
1750
1751my @undocumented_api =    grep {        $funcflags{$_}{flags} =~ /A/
1752                                   && ! $docs{api}{$_}
1753                               } keys %funcflags;
1754my @undocumented_intern = grep {        $funcflags{$_}{flags} !~ /[AS]/
1755                                   && ! $docs{intern}{$_}
1756                               } keys %funcflags;
1757my @undocumented_deprecated_api    = grep { $funcflags{$_}{flags} =~ /D/ }
1758                                                            @undocumented_api;
1759my @undocumented_deprecated_intern = grep { $funcflags{$_}{flags} =~ /D/ }
1760                                                           @undocumented_intern;
1761my @undocumented_experimental_api    =  grep { $funcflags{$_}{flags} =~ /x/ }
1762                                                            @undocumented_api;
1763my @undocumented_experimental_intern =  grep { $funcflags{$_}{flags} =~ /x/ }
1764                                                           @undocumented_intern;
1765my @missing_api = grep { $funcflags{$_}{flags} !~ /[xD]/ } @undocumented_api;
1766push @missing_api, keys %missing_macros;
1767
1768my @missing_intern = grep { $funcflags{$_}{flags} !~ /[xD]/ }
1769                                                           @undocumented_intern;
1770
1771my @other_places = ( qw(perlclib ), keys %described_elsewhere );
1772my $places_other_than_intern = join ", ",
1773            map { "L<$_>" } sort dictionary_order 'perlapi', @other_places;
1774my $places_other_than_api = join ", ",
1775            map { "L<$_>" } sort dictionary_order 'perlintern', @other_places;
1776
1777# The S< > makes things less densely packed, hence more readable
1778my $has_defs_text .= join ",S< > ", map { "C<$_>" } sort dictionary_order @has_defs;
1779my $has_r_defs_text .= join ",S< > ", map { "C<$_>" } sort dictionary_order @has_r_defs;
1780$valid_sections{$genconfig_scn}{footer} =~ s/__HAS_LIST__/$has_defs_text/;
1781$valid_sections{$genconfig_scn}{footer} =~ s/__HAS_R_LIST__/$has_r_defs_text/;
1782
1783my $include_defs_text .= join ",S< > ", map { "C<$_>" } sort dictionary_order @include_defs;
1784$valid_sections{$genconfig_scn}{footer} =~ s/__INCLUDE_LIST__/$include_defs_text/;
1785
1786my $section_list = join "\n\n", map { "=item L</$_>" }
1787                                sort(dictionary_order keys %valid_sections),
1788                                $undocumented_scn;  # Keep last
1789
1790# Leading '|' is to hide these lines from pod checkers.  khw is unsure if this
1791# is still needed.
1792my $api_hdr = <<"_EOB_";
1793|=encoding UTF-8
1794|
1795|=head1 NAME
1796|
1797|perlapi - autogenerated documentation for the perl public API
1798|
1799|=head1 DESCRIPTION
1800|X<Perl API> X<API> X<api>
1801|
1802|This file contains most of the documentation of the perl public API, as
1803|generated by F<embed.pl>.  Specifically, it is a listing of functions,
1804|macros, flags, and variables that may be used by extension writers.  Besides
1805|L<perlintern> and F<config.h>, some items are listed here as being actually
1806|documented in another pod.
1807|
1808|L<At the end|/$undocumented_scn> is a list of functions which have yet
1809|to be documented.  Patches welcome!  The interfaces of these are subject to
1810|change without notice.
1811|
1812|Some of the functions documented here are consolidated so that a single entry
1813|serves for multiple functions which all do basically the same thing, but have
1814|some slight differences.  For example, one form might process magic, while
1815|another doesn't.  The name of each variation is listed at the top of the
1816|single entry.  But if all have the same signature (arguments and return type)
1817|except for their names, only the usage for the base form is shown.  If any
1818|one of the forms has a different signature (such as returning C<const> or
1819|not) every function's signature is explicitly displayed.
1820|
1821|Anything not listed here or in the other mentioned pods is not part of the
1822|public API, and should not be used by extension writers at all.  For these
1823|reasons, blindly using functions listed in F<proto.h> is to be avoided when
1824|writing extensions.
1825|
1826|In Perl, unlike C, a string of characters may generally contain embedded
1827|C<NUL> characters.  Sometimes in the documentation a Perl string is referred
1828|to as a "buffer" to distinguish it from a C string, but sometimes they are
1829|both just referred to as strings.
1830|
1831|Note that all Perl API global variables must be referenced with the C<PL_>
1832|prefix.  Again, those not listed here are not to be used by extension writers,
1833|and may be changed or removed without notice; same with macros.
1834|Some macros are provided for compatibility with the older,
1835|unadorned names, but this support may be disabled in a future release.
1836|
1837|Perl was originally written to handle US-ASCII only (that is characters
1838|whose ordinal numbers are in the range 0 - 127).
1839|And documentation and comments may still use the term ASCII, when
1840|sometimes in fact the entire range from 0 - 255 is meant.
1841|
1842|The non-ASCII characters below 256 can have various meanings, depending on
1843|various things.  (See, most notably, L<perllocale>.)  But usually the whole
1844|range can be referred to as ISO-8859-1.  Often, the term "Latin-1" (or
1845|"Latin1") is used as an equivalent for ISO-8859-1.  But some people treat
1846|"Latin1" as referring just to the characters in the range 128 through 255, or
1847|sometimes from 160 through 255.
1848|This documentation uses "Latin1" and "Latin-1" to refer to all 256 characters.
1849|
1850|Note that Perl can be compiled and run under either ASCII or EBCDIC (See
1851|L<perlebcdic>).  Most of the documentation (and even comments in the code)
1852|ignore the EBCDIC possibility.
1853|For almost all purposes the differences are transparent.
1854|As an example, under EBCDIC,
1855|instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
1856|whenever this documentation refers to C<utf8>
1857|(and variants of that name, including in function names),
1858|it also (essentially transparently) means C<UTF-EBCDIC>.
1859|But the ordinals of characters differ between ASCII, EBCDIC, and
1860|the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy a different
1861|number of bytes than in UTF-8.
1862|
1863|The organization of this document is tentative and subject to change.
1864|Suggestions and patches welcome
1865|L<perl5-porters\@perl.org|mailto:perl5-porters\@perl.org>.
1866|
1867|The sections in this document currently are
1868|
1869|=over $standard_indent
1870
1871|$section_list
1872|
1873|=back
1874|
1875|The listing below is alphabetical, case insensitive.
1876_EOB_
1877
1878my $api_footer = <<"_EOE_";
1879|=head1 AUTHORS
1880|
1881|Until May 1997, this document was maintained by Jeff Okamoto
1882|<okamoto\@corp.hp.com>.  It is now maintained as part of Perl itself.
1883|
1884|With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
1885|Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
1886|Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
1887|Stephen McCamant, and Gurusamy Sarathy.
1888|
1889|API Listing originally by Dean Roehrich <roehrich\@cray.com>.
1890|
1891|Updated to be autogenerated from comments in the source by Benjamin Stuhl.
1892|
1893|=head1 SEE ALSO
1894|
1895|F<config.h>, $places_other_than_api
1896_EOE_
1897
1898my $api_missings_hdr = <<'_EOT_';
1899|The following functions have been flagged as part of the public
1900|API, but are currently undocumented.  Use them at your own risk,
1901|as the interfaces are subject to change.  Functions that are not
1902|listed in this document are not intended for public use, and
1903|should NOT be used under any circumstances.
1904|
1905|If you feel you need to use one of these functions, first send
1906|email to L<perl5-porters@perl.org|mailto:perl5-porters@perl.org>.
1907|It may be that there is a good reason for the function not being
1908|documented, and it should be removed from this list; or it may
1909|just be that no one has gotten around to documenting it.  In the
1910|latter case, you will be asked to submit a patch to document the
1911|function.  Once your patch is accepted, it will indicate that the
1912|interface is stable (unless it is explicitly marked otherwise) and
1913|usable by you.
1914_EOT_
1915
1916my $api_experimental_hdr = <<"_EOT_";
1917|
1918|Next are the API-flagged elements that are considered experimental.  Using one
1919|of these is even more risky than plain undocumented ones.  They are listed
1920|here because they should be listed somewhere (so their existence doesn't get
1921|lost) and this is the best place for them.
1922_EOT_
1923
1924my $api_deprecated_hdr = <<"_EOT_";
1925|
1926|Finally are deprecated undocumented API elements.
1927|Do not use any for new code; remove all occurrences of all of these from
1928|existing code.
1929_EOT_
1930
1931output('perlapi', $api_hdr, $docs{api}, $api_footer,
1932       $api_missings_hdr, \@missing_api,
1933       $api_experimental_hdr, \@undocumented_experimental_api,
1934       $api_deprecated_hdr, \@undocumented_deprecated_api);
1935
1936my $intern_hdr = <<"_EOB_";
1937|=head1 NAME
1938|
1939|perlintern - autogenerated documentation of purely B<internal>
1940|Perl functions
1941|
1942|=head1 DESCRIPTION
1943|X<internal Perl functions> X<interpreter functions>
1944|
1945|This file is the autogenerated documentation of functions in the
1946|Perl interpreter that are documented using Perl's internal documentation
1947|format but are not marked as part of the Perl API.  In other words,
1948|B<they are not for use in extensions>!
1949
1950|It has the same sections as L<perlapi>, though some may be empty.
1951|
1952_EOB_
1953
1954my $intern_footer = <<"_EOE_";
1955|
1956|=head1 AUTHORS
1957|
1958|The autodocumentation system was originally added to the Perl core by
1959|Benjamin Stuhl.  Documentation is by whoever was kind enough to
1960|document their functions.
1961|
1962|=head1 SEE ALSO
1963|
1964|F<config.h>, $places_other_than_intern
1965_EOE_
1966
1967my $intern_missings_hdr = <<"_EOT_";
1968|
1969|This section lists the elements that are otherwise undocumented.  If you use
1970|any of them, please consider creating and submitting documentation for it.
1971|
1972|Experimental and deprecated undocumented elements are listed separately at the
1973|end.
1974|
1975_EOT_
1976
1977my $intern_experimental_hdr = <<"_EOT_";
1978|
1979|Next are the experimental undocumented elements
1980|
1981_EOT_
1982
1983my $intern_deprecated_hdr = <<"_EOT_";
1984|
1985|Finally are the deprecated undocumented elements.
1986|Do not use any for new code; remove all occurrences of all of these from
1987|existing code.
1988|
1989_EOT_
1990
1991output('perlintern', $intern_hdr, $docs{intern}, $intern_footer,
1992       $intern_missings_hdr, \@missing_intern,
1993       $intern_experimental_hdr, \@undocumented_experimental_intern,
1994       $intern_deprecated_hdr, \@undocumented_deprecated_intern
1995      );
1996