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
|
#!/usr/bin/perl -w
use strict;
# make it clearer when we haven't run to completion, as we can be quite
# noisy when things are working ok
sub my_die {
print STDERR "$0: ", @_;
print STDERR "\n" unless $_[-1] =~ /\n\z/;
print STDERR "ABORTED\n";
exit 255;
}
sub open_or_die {
my $filename = shift;
open my $fh, '<', $filename or my_die "Can't open $filename: $!";
return $fh;
}
sub get_pod_metadata {
my %BuildFiles;
foreach my $path (@_) {
$path =~ m!([^/]+)$!;
++$BuildFiles{$1};
}
my %state =
(
# Don't copy these top level READMEs
ignore =>
{
micro => 1,
# vms => 1,
},
);
my $source = 'perldelta.pod';
my $filename = "pod/$source";
my $fh = open_or_die($filename);
my $contents = do {local $/; <$fh>};
my @want =
$contents =~ /perldelta - what is new for perl v5\.(\d+)\.(\d+)\n/;
die "Can't extract version from $filename" unless @want;
$state{delta_target} = "perl5$want[0]$want[1]delta.pod";
# This way round so that keys can act as a MANIFEST skip list
# Targets will always be in the pod directory. Currently we can only cope
# with sources being in the same directory.
$state{copies}{$state{delta_target}} = $source;
# process pod.lst
my %Readmepods;
my $master = open_or_die('pod.lst');
foreach (<$master>) {
next if /^\#/;
# At least one upper case letter somewhere in the first group
if (/^(\S+)\s(.*)/ && $1 =~ tr/h//) {
# it's a heading
my $flags = $1;
$flags =~ tr/h//d;
my %flags = (header => 1);
$flags{toc_omit} = 1 if $flags =~ tr/o//d;
$flags{aux} = 1 if $flags =~ tr/a//d;
my_die "Unknown flag found in heading line: $_" if length $flags;
push @{$state{master}}, [\%flags, $2];
} elsif (/^(\S*)\s+(\S+)\s+(.*)/) {
# it's a section
my ($flags, $podname, $desc) = ($1, $2, $3);
my $filename = "${podname}.pod";
$filename = "pod/${filename}" if $filename !~ m{/};
my %flags = (indent => 0);
$flags{indent} = $1 if $flags =~ s/(\d+)//;
$flags{toc_omit} = 1 if $flags =~ tr/o//d;
$flags{aux} = 1 if $flags =~ tr/a//d;
$flags{perlpod_omit} = "$podname.pod" eq $state{delta_target};
$state{generated}{"$podname.pod"}++ if $flags =~ tr/g//d;
if ($flags =~ tr/r//d) {
my $readme = $podname;
$readme =~ s/^perl//;
$Readmepods{$podname} = $state{readmes}{$readme} = $desc;
$flags{readme} = 1;
} elsif ($flags{aux}) {
$state{aux}{$podname} = $desc;
} else {
$state{pods}{$podname} = $desc;
}
my_die "Unknown flag found in section line: $_" if length $flags;
my ($leafname) = $podname =~ m!([^/]+)$!;
push @{$state{master}},
[\%flags, $podname, $filename, $desc, $leafname];
} elsif (/^$/) {
push @{$state{master}}, undef;
} else {
my_die "Malformed line: $_" if $1 =~ tr/A-Z//;
}
}
close $master or my_die "close pod.lst: $!";
# Sanity cross check
my (%disk_pods, %manipods, %manireadmes, %perlpods);
my (%cpanpods, %cpanpods_leaf);
my (%our_pods);
# These are stub files for deleted documents. We don't want them to show up
# in perl.pod, they just exist so that if someone types "perldoc perltoot"
# they get some sort of pointer to the new docs.
my %ignoredpods
= map { ( "$_.pod" => 1 ) } qw( perlboot perlbot perltooc perltoot );
# Convert these to a list of filenames.
foreach (keys %{$state{pods}}, keys %Readmepods) {
$our_pods{"$_.pod"}++;
}
opendir my $dh, 'pod';
while (defined ($_ = readdir $dh)) {
next unless /\.pod\z/;
++$disk_pods{$_};
}
# Things we copy from won't be in perl.pod
# Things we copy to won't be in MANIFEST
my $mani = open_or_die('MANIFEST');
while (<$mani>) {
chomp;
s/\s+.*$//;
if (m!^pod/([^.]+\.pod)!i) {
++$manipods{$1};
} elsif (m!^README\.(\S+)!i) {
next if $state{ignore}{$1};
++$manireadmes{"perl$1.pod"};
} elsif (exists $our_pods{$_}) {
++$cpanpods{$_};
m!([^/]+)$!;
++$cpanpods_leaf{$1};
$disk_pods{$_}++
if -e $_;
}
}
close $mani or my_die "close MANIFEST: $!\n";
my $perlpod = open_or_die('pod/perl.pod');
while (<$perlpod>) {
if (/^For ease of access, /../^\(If you're intending /) {
if (/^\s+(perl\S*)\s+\w/) {
++$perlpods{"$1.pod"};
}
}
}
close $perlpod or my_die "close perlpod: $!\n";
my_die "could not find the pod listing of perl.pod\n"
unless %perlpods;
my @inconsistent;
foreach my $i (sort keys %disk_pods) {
push @inconsistent, "$0: $i exists but is unknown by buildtoc\n"
unless $our_pods{$i};
push @inconsistent, "$0: $i exists but is unknown by MANIFEST\n"
if !$manipods{$i} && !$manireadmes{$i} && !$state{copies}{$i}
&& !$state{generated}{$i} && !$cpanpods{$i};
push @inconsistent, "$0: $i exists but is unknown by perl.pod\n"
if !$perlpods{$i} && !exists $state{copies}{$i} && !$cpanpods{$i} && !$ignoredpods{$i};
}
foreach my $i (sort keys %our_pods) {
push @inconsistent, "$0: $i is known by buildtoc but does not exist\n"
unless $disk_pods{$i} or $BuildFiles{$i};
}
foreach my $i (sort keys %manipods) {
push @inconsistent, "$0: $i is known by MANIFEST but does not exist\n"
unless $disk_pods{$i};
push @inconsistent, "$0: $i is known by MANIFEST but is marked as generated\n"
if $state{generated}{$i};
}
foreach my $i (sort keys %perlpods) {
push @inconsistent, "$0: $i is known by perl.pod but does not exist\n"
unless $disk_pods{$i} or $BuildFiles{$i} or $cpanpods_leaf{$i};
}
$state{inconsistent} = \@inconsistent;
return \%state;
}
1;
# Local variables:
# cperl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# ex: set ts=8 sts=4 sw=4 et:
|
