This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Generate Errno and Pod::Functions with deterministic order.
[perl5.git] / ext / Pod-Functions / Functions_pm.PL
CommitLineData
6f7c8186
NC
1#!perl -w
2use strict;
aa1042d8
NC
3use Pod::Simple::SimpleTree;
4
7fa6cc82 5my ($tap, $test, %Missing);
4094982d
NC
6
7@ARGV = grep { not($_ eq '--tap' and $tap = 1) } @ARGV;
8
aa1042d8
NC
9my (%Kinds, %Flavor, @Types);
10my %Omit;
11
12my $p = Pod::Simple::SimpleTree->new;
13$p->accept_targets('Pod::Functions');
14my $tree = $p->parse_file(shift)->root;
15
16foreach my $TL_node (@$tree[2 .. $#$tree]) {
17 next unless $TL_node->[0] eq 'over-text';
18 my $i = 2;
19 while ($i <= $#$TL_node) {
20 if ($TL_node->[$i][0] ne 'item-text') {
21 ++$i;
22 next;
23 }
24
25 my $item_text = $TL_node->[$i][2];
26 die "Confused by $item_text at line $TL_node->[$i][1]{start_line}"
27 if ref $item_text;
28 $item_text =~ s/\s+\z//s;
29
30 if ($TL_node->[$i+1][0] ne 'for'
31 || $TL_node->[$i+1][1]{target} ne 'Pod::Functions') {
32 ++$i;
7fa6cc82 33 ++$Missing{$item_text} unless $Omit{$item_text};
aa1042d8
NC
34 next;
35 }
36 my $data = $TL_node->[$i+1][2];
37 die "Confused by $data at line $TL_node->[$i+1][1]{start_line}"
38 unless ref $data eq 'ARRAY';
39 my $text = $data->[2];
40 die "Confused by $text at line $TL_node->[$i+1][1]{start_line}"
41 if ref $text;
42
43 $i += 2;
44
45 if ($text =~ s/^=//) {
46 # We are in "Perl Functions by Category"
47 die "Expected a paragraph after =item at $TL_node->[$i-2][1]{start_line}"
48 unless $TL_node->[$i][0] eq 'Para';
49 my $para = $TL_node->[$i];
50 # $text is the "type" of the built-in
51 # Anything starting ! is not for inclusion in Pod::Functions
52
53 foreach my $func (@$para[2 .. $#$para]) {
54 next unless ref $func eq 'ARRAY';
55 die "Expected only C<> blocks in paragraph after item at $TL_node->[$i-2][1]{start_line}"
56 unless $func->[0] eq 'C' && !ref $func->[2];
57 # Everything is plain text (ie $func->[2] is everything)
58 # except for C<-I<X>>. So untangle up to one level of nested <>
59 my $funcname = join '', map {
60 ref $_ ? $_->[2] : $_
61 } @$func[2..$#$func];
62 $funcname =~ s!(q.?)//!$1/STRING/!;
63 push @{$Kinds{$text}}, $funcname;
64 }
65 if ($text =~ /^!/) {
66 ++$Omit{$_} foreach @{$Kinds{$text}};
67 } else {
68 push @Types, [$text, $item_text];
69 }
70 } else {
71 $item_text =~ s/ .*//;
d9b04284
NC
72 # For now, just remove any metadata about when it was added:
73 $text =~ s/^\+\S+ //;
aa1042d8
NC
74 $Flavor{$item_text} = $text;
75 ++$Omit{$item_text} if $text =~ /^!/;
76 }
77 }
78}
79
80# Take the lists of functions for each type group, and invert them to get the
81# type group (or groups) for each function:
82my %Type;
83while (my ($type, $funcs) = each %Kinds) {
84 push @{$Type{$_}}, $type foreach @$funcs;
85}
86
87# We sort __SUB__ after sub, but before substr, but __PACKAGE__ after package,
88# and __END__ after END.
89sub sort_funcs {
90 map { $_->[0] }
91 sort { uc $a->[1] cmp uc $b->[1] || $b->[1] cmp $a->[1] || $a->[0] cmp $b->[0] }
92 map { my $f = tr/_//dr; [ $_, $f ] }
93 @_;
94}
6f7c8186 95
4094982d
NC
96if ($tap) {
97 foreach my $func (sort_funcs(keys %Flavor)) {
7fa6cc82
NC
98 ++$test;
99 my $ok = $Type{$func} ? 'ok' : 'not ok';
100 print "$ok $test - $func is mentioned in at least one category group\n";
101 }
102 foreach (sort keys %Missing) {
103 # Ignore anything that looks like an alternative for a function we've
104 # already seen;
105 s!(?: [A-Z].*| \(\)|\( LIST \)| /PATTERN/.*)!!;
106 next if $Flavor{$_};
107 ++$test;
108 if (/^[_a-z]/) {
109 print "not ok $test - function '$_' has no summary for Pod::Functions\n";
110 } else {
111 print "not ok $test - section '$_' has no type for Pod::Functions\n";
112 }
4094982d 113 }
46913ee5
NC
114 foreach my $kind (sort keys %Kinds) {
115 my $funcs = $Kinds{$kind};
116 ++$test;
117 my $want = join ' ', sort_funcs(@$funcs);
118 if ("@$funcs" eq $want) {
119 print "ok $test - category $kind is correctly sorted\n";
120 } else {
121 print "not ok $test - category $kind is correctly sorted\n";
122 print STDERR "# Have @$funcs\n# Want $want\n";
123 }
124 }
4094982d
NC
125 print "1..$test\n";
126 exit;
127}
128
6f7c8186
NC
129# blead will run this with miniperl, hence we can't use autodie
130my $real = 'Functions.pm';
131my $temp = "Functions.$$";
132
133END {
4094982d 134 return if !defined $temp || !-e $temp;
6f7c8186
NC
135 unlink $temp or warn "Can't unlink '$temp': $!";
136}
137
138foreach ($real, $temp) {
139 next if !-e $_;
140 unlink $_ or die "Can't unlink '$_': $!";
141}
142
143open my $fh, '>', $temp or die "Can't open '$temp' for writing: $!";
aa1042d8 144print $fh <<'EOT';
d93fce09 145package Pod::Functions;
66c981cf 146use strict;
cb1a09d0 147
66c981cf 148=head1 NAME
cb1a09d0 149
66c981cf
AT
150Pod::Functions - Group Perl's functions a la perlfunc.pod
151
152=head1 SYNOPSIS
153
0791bc7e 154 use Pod::Functions;
66c981cf
AT
155
156 my @misc_ops = @{ $Kinds{ 'Misc' } };
157 my $misc_dsc = $Type_Description{ 'Misc' };
158
159or
160
161 perl /path/to/lib/Pod/Functions.pm
162
163This will print a grouped list of Perl's functions, like the
164L<perlfunc/"Perl Functions by Category"> section.
165
166=head1 DESCRIPTION
167
168It exports the following variables:
169
170=over 4
171
172=item %Kinds
173
3c4b39be 174This holds a hash-of-lists. Each list contains the functions in the category
66c981cf
AT
175the key denotes.
176
177=item %Type
178
3c4b39be
PF
179In this hash each key represents a function and the value is the category.
180The category can be a comma separated list.
66c981cf
AT
181
182=item %Flavor
183
184In this hash each key represents a function and the value is a short
185description of that function.
186
187=item %Type_Description
188
3c4b39be
PF
189In this hash each key represents a category of functions and the value is
190a short description of that category.
66c981cf
AT
191
192=item @Type_Order
193
3c4b39be 194This list of categories is used to produce the same order as the
66c981cf
AT
195L<perlfunc/"Perl Functions by Category"> section.
196
197=back
198
66c981cf
AT
199=cut
200
be544edc 201our $VERSION = '1.07';
b75c8c73 202
cb1a09d0
AD
203require Exporter;
204
66c981cf
AT
205our @ISA = qw(Exporter);
206our @EXPORT = qw(%Kinds %Type %Flavor %Type_Description @Type_Order);
cb1a09d0 207
39376b25
NC
208our(%Kinds, %Type, %Flavor, %Type_Description, @Type_Order);
209
210foreach (
aa1042d8
NC
211EOT
212
213foreach (@Types) {
214 my ($type, $desc) = @$_;
215 $type = "'$type'" if $type =~ /[^A-Za-z]/;
216 $desc =~ s!([\\'])!\\$1!g;
217 printf $fh " [%-9s => '%s'],\n", $type, $desc;
218}
219
220print $fh <<'EOT';
39376b25
NC
221 ) {
222 push @Type_Order, $_->[0];
223 $Type_Description{$_->[0]} = $_->[1];
cb1a09d0
AD
224};
225
226while (<DATA>) {
227 chomp;
aa1042d8 228 s/^#.*//;
cb1a09d0 229 next unless $_;
16538db1
NC
230 my($name, @data) = split "\t", $_;
231 $Flavor{$name} = pop @data;
232 $Type{$name} = join ',', @data;
233 for my $t (@data) {
66c981cf 234 push @{$Kinds{$t}}, $name;
cb1a09d0 235 }
66c981cf 236}
cb1a09d0 237
3e92a254
GS
238close DATA;
239
66c981cf 240my( $typedesc, $list );
cb1a09d0 241unless (caller) {
b75c8c73 242 foreach my $type ( @Type_Order ) {
66c981cf
AT
243 $list = join(", ", sort @{$Kinds{$type}});
244 $typedesc = $Type_Description{$type} . ":";
cb1a09d0
AD
245 write;
246 }
247}
248
249format =
250
251^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
252 $typedesc
253~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
254 $typedesc
255 ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
256 $list
257.
258
66c981cf 2591;
cb1a09d0
AD
260
261__DATA__
aa1042d8
NC
262EOT
263
264foreach my $func (sort_funcs(keys %Flavor)) {
265 my $desc = $Flavor{$func};
266 die "No types listed for $func" unless $Type{$func};
267 next if $Omit{$func};
be544edc 268 print $fh join("\t", $func, (sort @{$Type{$func}}), $desc), "\n";
aa1042d8
NC
269}
270
271close $fh or die "Can't close '$temp': $!";
272rename $temp, $real or die "Can't rename '$temp' to '$real': $!";