forked from Perl/perl5
-
Notifications
You must be signed in to change notification settings - Fork 0
/
autodoc.pl
2972 lines (2574 loc) · 121 KB
/
autodoc.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#!/usr/bin/perl -w
use v5.41;
use Text::Tabs;
# Unconditionally regenerate:
#
# pod/perlintern.pod
# pod/perlapi.pod
my $api = "pod/perlapi.pod";
my $intern = "pod/perlintern.pod";
#
# from information stored in
#
# embed.fnc
# plus all the core .c, .h, and .pod files listed in MANIFEST
# plus %extra_input_pods
my %extra_input_pods = ( 'dist/ExtUtils-ParseXS/lib/perlxs.pod' => 1 );
# Has an optional arg, which is the directory to chdir to before reading
# MANIFEST and the files
#
# This script is invoked as part of 'make all'
#
# The generated pod consists of sections of related elements, functions,
# macros, and variables. The keys of %valid_sections give the current legal
# ones. Just add a new key to add a section.
#
# Throughout the files read by this script are lines like
#
# =for apidoc_section Section Name
# =for apidoc_section $section_name_variable
#
# "Section Name" (after having been stripped of leading space) must be one of
# the legal section names, or an error is thrown. $section_name_variable must
# be one of the legal section name variables defined below; these expand to
# legal section names. This form is used so that minor wording changes in
# these titles can be confined to this file. All the names of the variables
# end in '_scn'; this suffix is optional in the apidoc_section lines.
#
# All API elements defined between this line and the next 'apidoc_section'
# line will go into the section "Section Name" (or $section_name_variable),
# sorted by dictionary order within it. perlintern and perlapi are parallel
# documents, each potentially with a section "Section Name". Each element is
# marked as to which document it goes into. If there are none for a
# particular section in perlapi, that section is omitted.
#
# Also, in .[ch] files, there may be
#
# =head1 Section Name
#
# lines in comments. These are also used by this program to switch to section
# "Section Name". The difference is that if there are any lines after the
# =head1, inside the same comment, and before any =for apidoc-ish lines, they
# are used as a heading for section "Section Name" (in both perlintern and
# perlapi). This includes any =head[2-5]. If more than one '=head1 Section
# Name' line has content, they appear in the generated pod in an undefined
# order. Note that you can't use a $section_name_variable in =head1 lines
#
# The next =head1, =for apidoc_section, or file end terminates what goes into
# the current section
#
# The %valid_sections hash below also can have header content, which will
# appear before any =head1 content. The hash can also have footer content
# content, which will appear at the end of the section, after all the
# elements.
#
# The lines that define the actual functions, etc are documented in embed.fnc,
# because they have flags which must be kept in sync with that file.
use strict;
use warnings;
my $known_flags_re =
qr/[aA bC dD eE fF Gh iI mM nN oO pP rR sS T uU vW xX y;#?]/xx;
# Flags that don't apply to this program, like implementation details.
my $irrelevant_flags_re = qr/[ab eE G iI P rR vX?]/xx;
# Only certain flags dealing with what gets displayed, are acceptable for
# apidoc_item
my $item_flags_re = qr/[dD fF mM nN oO pT uU Wx;]/xx;
use constant {
NOT_APIDOC => -1,
ILLEGAL_APIDOC => 0, # Must be 0 so evaluates to 'false'
APIDOC_DEFN => 1,
PLAIN_APIDOC => 2,
APIDOC_ITEM => 3,
APIDOC_SECTION => 4,
# This is the line type used for elements parsed in config.h.
# Since that file is parsed after everything else, everything is
# resolved by then; and this is just a way to allow prototypes
# elsewhere in the source code to override the simplistic
# prototypes that config.h mostly deals with. Hence Configure
# doesn't have to get involved. There are just a few of these,
# with little likelihood of changes needed. They were manually
# added to handy.h via 51b56f5c7c7.
CONDITIONAL_APIDOC => 5,
};
my $config_h = 'config.h';
if (@ARGV >= 2 && $ARGV[0] eq "-c") {
shift;
$config_h = shift;
}
my $nroff_min_indent = 4; # for non-heading lines
# 80 column terminal - 2 for pager using 2 columns for itself;
my $max_width = 80 - 2 - $nroff_min_indent;
my $standard_indent = 4; # Any additional indentations
# In the usage (signature) section of entries, how many spaces should separate
# the return type from the name of the function.
my $usage_ret_name_sep_len = 2;
if (@ARGV) {
my $workdir = shift;
chdir $workdir
or die "Couldn't chdir to '$workdir': $!";
}
require './regen/regen_lib.pl';
require './regen/embed_lib.pl';
# This is the main data structure. Each key is the name of a potential API
# element available to be documentable. Each value is a hash containing
# information about that element, such as its prototype. It is initialized
# from embed.fnc, and added to as we go along.
my %elements;
# This hash is used to organize the data in %elements for output. The top
# level keys are either 'api' or 'intern' for the two pod files generated by
# this program.
#
# Under those are hashes for each section in its corresponding pod. There is
# a section for API elements involved with SV handling; another for AV
# handling, etc.
#
# Under each section are hashes for each group in the section. Each group
# consists of one or more API elements that share the same pod. Each group
# hash contains fields for the common parts of the group, and then an array of
# all the API elements that comprise it. The array determines the ordering of
# the output for the API elements.
#
# The elements are pointers to the leaf nodes in %elements. These contain all
# the information needed to know what to output for each.
my %docs;
# This hash is populated with the names of other pod files that we determine
# contain relevant information about the API elements. It is used just for
# the SEE ALSO section
my %described_elsewhere;
# keys are the full 'Perl_FOO' names in proto.h. values are currently
# unlooked at
my %protos;
my $described_in = "Described in";
my $description_indent = 4;
my $usage_indent = 3; # + initial verbatim block blank yields 4 total
my $AV_scn = 'AV Handling';
my $callback_scn = 'Callback Functions';
my $casting_scn = 'Casting';
my $casing_scn = 'Character case changing';
my $classification_scn = 'Character classification';
my $names_scn = 'Character names';
my $scope_scn = 'Compile-time scope hooks';
my $compiler_scn = 'Compiler and Preprocessor information';
my $directives_scn = 'Compiler directives';
my $concurrency_scn = 'Concurrency';
my $COP_scn = 'COPs and Hint Hashes';
my $CV_scn = 'CV Handling';
my $custom_scn = 'Custom Operators';
my $debugging_scn = 'Debugging';
my $display_scn = 'Display functions';
my $embedding_scn = 'Embedding, Threads, and Interpreter Cloning';
my $errno_scn = 'Errno';
my $exceptions_scn = 'Exception Handling (simple) Macros';
my $filesystem_scn = 'Filesystem configuration values';
my $filters_scn = 'Source Filters';
my $floating_scn = 'Floating point';
my $genconfig_scn = 'General Configuration';
my $globals_scn = 'Global Variables';
my $GV_scn = 'GV Handling and Stashes';
my $hook_scn = 'Hook manipulation';
my $HV_scn = 'HV Handling';
my $io_scn = 'Input/Output';
my $io_formats_scn = 'I/O Formats';
my $integer_scn = 'Integer';
my $lexer_scn = 'Lexer interface';
my $locale_scn = 'Locales';
my $magic_scn = 'Magic';
my $memory_scn = 'Memory Management';
my $MRO_scn = 'MRO';
my $multicall_scn = 'Multicall Functions';
my $numeric_scn = 'Numeric Functions';
my $rpp_scn = 'Reference-counted stack manipulation';
# Now combined, as unclear which functions go where, but separate names kept
# to avoid 1) other code changes; 2) in case it seems better to split again
my $optrees_scn = 'Optrees';
my $optree_construction_scn = $optrees_scn; # Was 'Optree construction';
my $optree_manipulation_scn = $optrees_scn; # Was 'Optree Manipulation Functions'
my $pack_scn = 'Pack and Unpack';
my $pad_scn = 'Pad Data Structures';
my $password_scn = 'Password and Group access';
my $reports_scn = 'Reports and Formats';
my $paths_scn = 'Paths to system commands';
my $prototypes_scn = 'Prototype information';
my $regexp_scn = 'REGEXP Functions';
my $signals_scn = 'Signals';
my $site_scn = 'Site configuration';
my $sockets_scn = 'Sockets configuration values';
my $stack_scn = 'Stack Manipulation Macros';
my $string_scn = 'String Handling';
my $SV_flags_scn = 'SV Flags';
my $SV_scn = 'SV Handling';
my $tainting_scn = 'Tainting';
my $time_scn = 'Time';
my $typedefs_scn = 'Typedef names';
my $unicode_scn = 'Unicode Support';
my $utility_scn = 'Utility Functions';
my $versioning_scn = 'Versioning';
my $warning_scn = 'Warning and Dieing';
my $XS_scn = 'XS';
# Kept separate at end
my $undocumented_scn = 'Undocumented elements';
my %valid_sections = (
$AV_scn => {},
$callback_scn => {},
$casting_scn => {},
$casing_scn => {},
$classification_scn => {},
$scope_scn => {},
$compiler_scn => {},
$directives_scn => {},
$concurrency_scn => {},
$COP_scn => {},
$CV_scn => {
header => <<~'EOT',
This section documents functions to manipulate CVs which are
code-values, meaning subroutines. For more information, see
L<perlguts>.
EOT
},
$custom_scn => {},
$debugging_scn => {},
$display_scn => {},
$embedding_scn => {},
$errno_scn => {},
$exceptions_scn => {},
$filesystem_scn => {
header => <<~'EOT',
Also see L</List of capability HAS_foo symbols>.
EOT
},
$filters_scn => {},
$floating_scn => {
header => <<~'EOT',
Also L</List of capability HAS_foo symbols> lists capabilities
that arent in this section. For example C<HAS_ASINH>, for the
hyperbolic sine function.
EOT
},
$genconfig_scn => {
header => <<~'EOT',
This section contains configuration information not otherwise
found in the more specialized sections of this document. At the
end is a list of C<#defines> whose name should be enough to tell
you what they do, and a list of #defines which tell you if you
need to C<#include> files to get the corresponding functionality.
EOT
footer => <<~EOT,
=head2 List of capability C<HAS_I<foo>> symbols
This is a list of those symbols that dont appear elsewhere in ths
document that indicate if the current platform has a certain
capability. Their names all begin with C<HAS_>. Only those
symbols whose capability is directly derived from the name are
listed here. All others have their meaning expanded out elsewhere
in this document. This (relatively) compact list is because we
think that the expansion would add little or no value and take up
a lot of space (because there are so many). If you think certain
ones should be expanded, send email to
L<perl5-porters\@perl.org|mailto:perl5-porters\@perl.org>.
Each symbol here will be C<#define>d if and only if the platform
has the capability. If you need more detail, see the
corresponding entry in F<$config_h>. For convenience, the list is
split so that the ones that indicate there is a reentrant version
of a capability are listed separately
__HAS_LIST__
And, the reentrant capabilities:
__HAS_R_LIST__
Example usage:
=over $standard_indent
#ifdef HAS_STRNLEN
use strnlen()
#else
use an alternative implementation
#endif
=back
=head2 List of C<#include> needed symbols
This list contains symbols that indicate if certain C<#include>
files are present on the platform. If your code accesses the
functionality that one of these is for, you will need to
C<#include> it if the symbol on this list is C<#define>d. For
more detail, see the corresponding entry in F<$config_h>.
__INCLUDE_LIST__
Example usage:
=over $standard_indent
#ifdef I_WCHAR
#include <wchar.h>
#endif
=back
EOT
},
$globals_scn => {},
$GV_scn => {},
$hook_scn => {},
$HV_scn => {},
$io_scn => {},
$io_formats_scn => {
header => <<~'EOT',
These are used for formatting the corresponding type For example,
instead of saying
Perl_newSVpvf(pTHX_ "Create an SV with a %d in it\n", iv);
use
Perl_newSVpvf(pTHX_ "Create an SV with a " IVdf " in it\n", iv);
This keeps you from having to know if, say an IV, needs to be
printed as C<%d>, C<%ld>, or something else.
EOT
},
$integer_scn => {},
$lexer_scn => {},
$locale_scn => {},
$magic_scn => {},
$memory_scn => {},
$MRO_scn => {},
$multicall_scn => {},
$numeric_scn => {},
$optrees_scn => {},
$optree_construction_scn => {},
$optree_manipulation_scn => {},
$pack_scn => {},
$pad_scn => {},
$password_scn => {},
$paths_scn => {},
$prototypes_scn => {},
$regexp_scn => {},
$reports_scn => {
header => <<~"EOT",
These are used in the simple report generation feature of Perl.
See L<perlform>.
EOT
},
$rpp_scn => {
header => <<~'EOT',
Functions for pushing and pulling items on the stack when the
stack is reference counted. They are intended as replacements
for the old PUSHs, POPi, EXTEND etc pp macros within pp
functions.
EOT
},
$signals_scn => {},
$site_scn => {
header => <<~'EOT',
These variables give details as to where various libraries,
installation destinations, I<etc.>, go, as well as what various
installation options were selected
EOT
},
$sockets_scn => {},
$stack_scn => {},
$string_scn => {
header => <<~EOT,
See also C<L</$unicode_scn>>.
EOT
},
$SV_flags_scn => {},
$SV_scn => {},
$tainting_scn => {},
$time_scn => {},
$typedefs_scn => {},
$unicode_scn => {
header => <<~EOT,
L<perlguts/Unicode Support> has an introduction to this API.
See also C<L</$classification_scn>>,
C<L</$casing_scn>>,
and C<L</$string_scn>>.
Various functions outside this section also work specially with
Unicode. Search for the string "utf8" in this document.
EOT
},
$utility_scn => {},
$versioning_scn => {},
$warning_scn => {},
$XS_scn => {},
);
# The section that is in effect at the beginning of the given file. If not
# listed here, an apidoc_section line must precede any apidoc lines.
# This allows the files listed here that generally are single-purpose, to not
# have to worry about the autodoc section
my %initial_file_section = (
'av.c' => $AV_scn,
'av.h' => $AV_scn,
'cv.h' => $CV_scn,
'deb.c' => $debugging_scn,
'dist/ExtUtils-ParseXS/lib/perlxs.pod' => $XS_scn,
'doio.c' => $io_scn,
'gv.c' => $GV_scn,
'gv.h' => $GV_scn,
'hv.h' => $HV_scn,
'locale.c' => $locale_scn,
'malloc.c' => $memory_scn,
'numeric.c' => $numeric_scn,
'opnames.h' => $optree_construction_scn,
'pad.h'=> $pad_scn,
'patchlevel.h' => $versioning_scn,
'perlio.h' => $io_scn,
'pod/perlapio.pod' => $io_scn,
'pod/perlcall.pod' => $callback_scn,
'pod/perlembed.pod' => $embedding_scn,
'pod/perlfilter.pod' => $filters_scn,
'pod/perliol.pod' => $io_scn,
'pod/perlmroapi.pod' => $MRO_scn,
'pod/perlreguts.pod' => $regexp_scn,
'pp_pack.c' => $pack_scn,
'pp_sort.c' => $SV_scn,
'regcomp.c' => $regexp_scn,
'regexp.h' => $regexp_scn,
'sv.h' => $SV_scn,
'sv.c' => $SV_scn,
'sv_inline.h' => $SV_scn,
'taint.c' => $tainting_scn,
'unicode_constants.h' => $unicode_scn,
'utf8.c' => $unicode_scn,
'utf8.h' => $unicode_scn,
'vutil.c' => $versioning_scn,
);
sub where_from_string ($file, $line_num = 0) {
# Returns a string of hopefully idiomatic text about the location given by
# the input parameters. The line number is not always available, and this
# centralizes into one function the logic to deal with that
return "in $file" unless $line_num;
return "at $file, line $line_num";
}
sub check_and_add_proto_defn {
my ($element, $file, $line_num, $raw_flags, $ret_type, $args_ref,
$definition_type
) = @_;
# This function constructs a hash describing what we know so far about the
# API element '$element', as determined by 'apidoc'-type lines scattered
# throughout the source code tree.
#
# This includes how to use it, and if documentation is expected for it,
# and if any such documentation has been found. (The documentation itself
# is stored separately, as any number of elements may share the same pod.)
#
# Except in limited circumstances, only one definition is allowed; that is
# checked for.
#
# The parameters: $flags, $ret_type, and $args_ref are sufficient to
# define the usage. They are checked for legality, to the limited extent
# possible. The arguments may include conventions like NN, which is a
# hint internal to embed.fnc, but which someone using the API should not
# be expected to know. This function strips those.
#
# As we parse the source, we may find an apidoc-type line that refers to
# $element before we have found the usage information. A hash is
# constructed in this case that is effectively a place-holder for the
# usage, waiting to be filled in later in the parse. A place-holder call
# is signalled by all three mentioned parameters being empty. These
# lines, however, are markers in the code where $element is documented.
# So they indicate that there is pod available for it. That information
# is added to the hash.
#
# It is possible for this to be called with a line that both defines the
# usage signature for $element, and marks the place in the source where
# the documentation is found. Handling that happens naturally here.
# This definition type is currently used only by config.h. See comments
# at the definition of this line type. If there is an existing prototype
# definition, defer to that (by setting the parameters to empty);
# otherwise use the one passed in.
if ($definition_type == CONDITIONAL_APIDOC) {
if (exists $elements{$element}) {
my @dummy;
$raw_flags = "";
$ret_type = "";
$args_ref = \@dummy;
}
$definition_type = PLAIN_APIDOC;
}
my $flags = $raw_flags =~ s/$irrelevant_flags_re//gr;
my $illegal_flags = $flags =~ s/$known_flags_re//gr;
if ($illegal_flags) {
die "flags [$illegal_flags] not legal for function"
. " $element " . where_from_string($file, $line_num);
}
$flags .= "m" if $flags =~ /M/;
my @munged_args= $args_ref->@*;
s/\b(?:NN|NULLOK)\b\s+//g for @munged_args;
my $flags_sans_d = $flags;
my $docs_expected = $flags_sans_d =~ s/d//g;
my $docs_hidden = $flags =~ /h/;
# Does this call define the signature for $element? It always does for
# APIDOC_DEFN lines, and for the other types when one of the usage
# parameters is non-empty, except when the flags indicate the actual
# definition is in some other pod.
my $is_usage_defining_occurrence =
( $definition_type == APIDOC_DEFN
|| ( ! $docs_hidden
&& ( $flags_sans_d
|| $ret_type
|| ($args_ref && $args_ref->@*))));
# Check this new entry against an existing one.
if ( $is_usage_defining_occurrence
&& $elements{$element} && $elements{$element}{proto_defined})
{
# Some functions in embed.fnc have multiple definitions depending
# on the platform's Configuration. Currently we just use the
# first one encountered in that file.
return \$elements{$element}
if $file eq 'embed.fnc'
&& $elements{$element}{file} eq 'embed.fnc';
# Use the existing entry if both it and this new attempt to create
# one have the 'h' flag set. This flag indicates that the entry
# is just a reference to the pod where the element is actually
# documented, so multiple such lines can peacefuly coexist.
return \$elements{$element} if $docs_hidden
&& $elements{$element}{flags} =~ /h/;
die "There already is an existing prototype for '$element' defined "
. where_from_string($elements{$element}{proto_defined}{file},
$elements{$element}{proto_defined}{line_num})
. " new one is " . where_from_string($file, $line_num);
}
# Here, any existing entry for this element is a placeholder. If none,
# create one. If a placeholder entry, override it with this new
# information.
if ($is_usage_defining_occurrence || ! $elements{$element}) {
$elements{$element}{name} = $element;
$elements{$element}{raw_flags} = $raw_flags; # Keep for debugging, etc.
$elements{$element}{flags} = $flags_sans_d;
$elements{$element}{ret_type} =$ret_type;
$elements{$element}{args} = \@munged_args;
$elements{$element}{file} = $file;
$elements{$element}{line_num} = $line_num // 0;
# Don't reset expecting documentation.
$elements{$element}{docs_expected} = $docs_expected
unless $elements{$element}{docs_expected};
if ($is_usage_defining_occurrence) {
$elements{$element}{proto_defined} = {
type => $definition_type,
file => $file,
line_num => $line_num // 0,
};
}
}
# All but this type are for defining pod
if ($definition_type != APIDOC_DEFN) {
if ( $elements{$element}{docs_found}
&& ! $docs_hidden
&& $elements{$element}{flags} !~ /h/ )
{
die "Attempting to document '$element' "
. where_from_string($file, $line_num)
. "; it was already documented "
. where_from_string($elements{$element}{docs_found}{file},
$elements{$element}{docs_found}{line_num});
}
else {
$elements{$element}{docs_found}{file} = $file;
$elements{$element}{docs_found}{line_num} = $line_num // 0;
}
if ($definition_type == PLAIN_APIDOC) {
$elements{$element}{is_leader} = 1;
}
}
return \$elements{$element};
}
sub classify_input_line ($file, $line_num, $input, $is_file_C) {
# Looks at an input line and classifies it as to if it is of use to us or
# not, and if so, what class of apidoc line it is. It looks for common
# typos in the input lines in order to do the classification, but dies
# when one is encountered.
#
# It returns a pair of values. The first is the classification; the
# second the trailing text of the input line, trimmed of leading and
# trailing spaces. This is viewed as the argument.
#
# The returned classification is one of the constants defined at the
# beginning of the program, like NOT_APIDOC.
#
# For NOT_APIDOC only, the returned argument is not trimmed; it is the
# whole line, including any \n.
#
# In C files only, a =head1 line is equivalent to an apidoc_section line,
# so the latter is returned for this case.
# Use simple patterns to quickly rule out lines that are of no interest to
# us, which are the vast majority.
return (NOT_APIDOC, $input)
if $input !~ / api [-_]? doc /x
and (! $is_file_C || $input !~ / head \s* 1 \s+ (.) /x);
# Only the head1 lines have a capture group. That capture was done solely
# to be able to use its existence as a shortcut to distinguish between the
# patterns here.
if (defined $1) {
# We repeat the match above, to handle the case where there is more
# than one head1 strings on the line
return (NOT_APIDOC, $input) unless $input =~ / ^
(\s*) # $1
(=?) # $2
head
(\s*) # $3
1 \s+
(.*) # $4
/x;
# Here, it looks like the line was meant to be a =head1. This is
# equivalent to an apidoc_section line if properly formed
return (APIDOC_SECTION, $4) if length $1 == 0
&& length $2 == 1
&& length $3 == 0;
# Drop down to give error
}
else {
# Here, the input has something like 'apidoc' in it. See if we think
# it was meant to be one.
return (NOT_APIDOC, $input) unless $input =~ / ^
(\s*) # $1
(=?) # $2
(\s*) # $3
(for)? # $4
(\s*) # $5
api
([_-]?) # $6
doc
([-_]?) # $7
(\w*) # $8
(\s*) # $9
(.*?) # $10
\s* \n
/x;
my $type_name = $8;
my $arg = $10;
my $type = ($type_name eq "")
? PLAIN_APIDOC
: ($type_name eq 'item')
? APIDOC_ITEM
: ($type_name eq 'defn')
? APIDOC_DEFN
: ($type_name eq 'section')
? APIDOC_SECTION
: ILLEGAL_APIDOC;
my $mostly_proper_form =
( $type != ILLEGAL_APIDOC
&& length $2 == 1 # Must have '='
&& length $3 == 0 # Must not have space after '='
&& defined $4 # Must have 'for'
&& length $5 > 0 # Must have space after =for
&& length $6 == 0 # 'apidoc' is one word
# plain apidoc has no trailing underscore; others have
# an underscore separator
&& ( ($type == PLAIN_APIDOC && length $7 == 0)
|| ($type != PLAIN_APIDOC && $7 eq '_'))
# Must have space before argument except if
# apidoc_item and first char of arg is '|'
&& ( length $9 != 0
|| ( $type == APIDOC_ITEM
&& substr($10, 0, 1) eq '|')));
if ($mostly_proper_form) {
return ($type, $arg) if length $1 == 0; # Is fully correct if left
# justified
# Ordinarily not being left justified is an error, but special
# case perlguts which has examples of how to use apidoc in
# verbatim blocks, which we don't want to confuse with a real
# instance and reject because it isn't left justified. Use a
# precise indent to get the precise lines that have this.
return (NOT_APIDOC, $input) if length $1 == 1
&& $file eq 'pod/perlguts.pod';
}
}
chomp $input;
my $where_from = where_from_string($file, $line_num);
die <<~EOS;
'$input' $where_from is not of proper form
Expected ([...] means optional; | is literal, not a meta char):
=for apidoc name
=for apidoc [flags] | [returntype] | name [|arg1] [|arg2] [|...]
=for apidoc_item name
=for apidoc_item [flags] | [returntype] | name [|arg1] [|arg2] [|...]
=for apidoc_defn flags|returntype|name[|arg|arg|...]
=for apidoc_section name
=for apidoc_section \$variable
EOS
}
sub handle_apidoc_line ($file, $line_num, $type, $arg) {
# This just does a couple of checks that would otherwise have to be
# duplicated in the calling code, and calls check_and_add_proto_defn() to
# do the real work.
my $proto_as_written = $arg;
my $proto = $proto_as_written;
$proto = "||$proto" if $proto !~ /\|/;
my ($flags, $ret_type, $name, @args) = split /\s*\|\s*/, $proto;
if ($type == APIDOC_ITEM) {
if (my $non_item_flags = $flags =~ s/$item_flags_re//gr) {
die "[$non_item_flags] illegal in apidoc_item "
. where_from_string($file, $line_num)
. " :\n$arg";
}
}
if ($flags =~ /#/) {
die "Return type must be empty for '$name' "
. where_from_string($file, $line_num) if $ret_type;
$ret_type = '#ifdef';
}
warn ("'$name' not \\w+ in '$proto_as_written' "
. where_from_string($file, $line_num))
if $flags !~ /N/
&& $name !~ / ^ (?:struct\s+)? [_[:alpha:]] \w* $ /x;
# Here, done handling any existing information about this element. Add
# this definition (which has the side effect of cleaning up any NN or
# NULLOK in @args)
my $updated = check_and_add_proto_defn($name, $file, $line_num,
# The fact that we have this line somewhere in the source
# code means we implicitly have the 'd' flag
$flags . "d",
$ret_type, \@args,
$type);
return $updated;
}
sub destination_pod ($flags) { # Into which pod should the element go whose
# flags are $1
return "unknown" if $flags eq "";
return $api if $flags =~ /A/;
return $intern;
}
sub autodoc ($fh, $file) { # parse a file and extract documentation info
my $section = $initial_file_section{$file}
if defined $initial_file_section{$file};
my $file_is_C = $file =~ / \. [ch] $ /x;
# Count lines easier and handle apidoc continuation lines
my $line_num;
my $prev_type;
my $prev_arg;
my $do_unget = 0;
my $unget_next_line = sub () {
die "Attempt to unget more than one line" if $do_unget;
$do_unget = 1;
};
# Reads, categorizes, and returns the relevant portion of the next input
# line, while joining apidoc-type lines that have continuations into a
# single line. For non-apidoc-type lines, the possibility of continuation
# lines is not considered (avoiding unintended consequences). For these,
# the entire line is returned, including trailing \n.
#
# For apidoc-type lines, only the argument portion of the line is
# returned, chomped. (The returned type tells you what the beginning
# was.) A continuation happens when the final non-space character on it
# is a backslash.
#
# (If a non-api-doc line ends with a backslash, and the next line looks
# like an apidoc-ish line, this algorithm causes it to be treated as an
# apidoc line. This might be considered a bug, or the right thing to do.)
my $get_next_line = sub {
if ($do_unget) {
$do_unget = 0;
return ($prev_type, $prev_arg);
}
my $contents = <$fh>;
if (! defined $contents) {
undef $prev_type;
undef $prev_arg;
return;
}
$line_num++;
($prev_type, $prev_arg) = classify_input_line($file, $line_num,
$contents,
$file_is_C);
return ($prev_type, $prev_arg) if $prev_type == NOT_APIDOC;
# Replace all spaces around a backslash at the end of a line with
# a single space to prepare for the continuation line to be joined
# with this. (This includes lines with spaces betweeen the
# backslash and \n, since a human reader would not readily see the
# distinction.)
while ($prev_arg =~ s/ \s* \\ \s* $ / /x) {
my $next = <$fh>;
last unless defined $next;
$line_num++;
$prev_arg .= $next;
}
return ($prev_type, $prev_arg);
};
# Read the file. Most lines are of no interest to this program, but
# individual 'apidoc_defn' lines are, as well as are blocks introduced by
# 'apidoc_section' and 'apidoc'. Text in those blocks is used
# respectively for the section heading or pod. Between plain 'apidoc'
# lines and its pod, may be any number of 'apidoc_item' lines that give
# additional api elements that the pod applies to.
my $destpod;
while (1) {
my ($outer_line_type, $arg) = $get_next_line->();
last unless defined $outer_line_type;
next if $outer_line_type == NOT_APIDOC;
my $element_name;
my @items;
my $flags = "";
my $text = "";
if ($outer_line_type == APIDOC_ITEM) {
die "apidoc_item doesn't immediately follow an apidoc entry:"
. " '$arg' " . where_from_string($file, $line_num);
}
elsif ($outer_line_type == APIDOC_DEFN) {
handle_apidoc_line($file, $line_num, $outer_line_type, $arg);
next; # 'handle_apidoc_line' handled everything for this type
}
elsif ($outer_line_type == APIDOC_SECTION) {
# Here the line starts a new section ...
$section = $arg;
# Convert $foo to its value
if ($section =~ / ^ \$ /x) {
$section .= '_scn' unless $section =~ / _scn $ /x;
$section = eval "$section";
die "Unknown \$section variable '$section' "
. where_from_string($file, $line_num) . "\n$@" if $@;
}
die "Unknown section name '$section' in $file near line $line_num\n"
unless defined $valid_sections{$section};
# Drop down to accumulate the heading text for this section.
}
elsif ($outer_line_type == PLAIN_APIDOC) {
my $leader_ref =
handle_apidoc_line($file, $line_num, $outer_line_type, $arg);
$destpod = destination_pod($$leader_ref->{flags});
push @items, $leader_ref;
# Now look for any 'apidoc_item' lines. These are in a block
# consisting solely of them, or all-blank lines
while (1) {
(my $item_line_type, $arg) = $get_next_line->();
last unless defined $item_line_type;
# Absorb blank lines
if ($item_line_type == NOT_APIDOC && $arg !~ /\S/) {
$text .= $arg;
next;
}
last unless $item_line_type == APIDOC_ITEM;
# Reset $text; those blank lines it contains merely are
# separating 'apidoc_item' lines
$text = "";
my $item_ref =
handle_apidoc_line($file, $line_num, $item_line_type, $arg);
push @items, $item_ref;
}
# Put back the line that terminated this block of items, so that
# the code below will get it as the first line.
$unget_next_line->();
# Drop down to accumulate the pod for this group. $text contains
# any blank lines that follow the final 'apidoc_item' line.
# $input is the next line to process
}
else {
die "Unknown apidoc-type line '$arg' "
. where_from_string($file, $line_num);
}
# Here, we are ready to accumulate text into either a heading, or the
# pod for an apidoc line. $text may already contain blank lines that
# are part ot this text.
#
# Accumulation stops at a terminating line, which is one of:
# 1) =cut
# 2) =headN (N must be 1 in a C file)
# 3) an end comment line in a C file: m: ^ \s* [*] / :x
# 4) =for apidoc... (except apidoc_item lines)
my $head_ender_num = ($file_is_C) ? 1 : "";
while (1) {
my ($inner_line_type, $inner_arg) = $get_next_line->();
last unless defined $inner_line_type;
last unless $inner_line_type == NOT_APIDOC;
last if $inner_arg =~ /^=cut/x;
last if $inner_arg =~ /^=head$head_ender_num/;
if ($file_is_C && $inner_arg =~ m: ^ \s* \* / $ :x) {
# End of comment line in C files is a fall-back
# terminator, but warn only if there actually is some
# accumulated text
warn "=cut missing? "
. where_from_string($file, $line_num)
. "\n$inner_arg" if $text =~ /\S/;
last;
}
$text .= $inner_arg;
}
# Here, are done accumulating the text for this element. Trim it
$text =~ s/ ^ \s* //x;
$text =~ s/ \s* $ //x;