[p5sagit/p5-mst-13.2.git] / pod / buildtoc.PL

#!/usr/local/bin/perl

use Config;
use File::Basename qw(&basename &dirname);
use Cwd;

# List explicitly here the variables you want Configure to
# generate.  Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries.  Thus you write
#  $startperl
# to ensure Configure will look for $Config{startperl}.

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos');  # "case-forgiving"
$file =~ s/\.pl$/.com/ if ($^O eq 'VMS');              # "case-forgiving"

open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file (with variable substitutions)\n";

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";
$Config{'startperl'}
    eval 'exec perl -S \$0 "\$@"'
        if 0;
!GROK!THIS!

# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';

#
# buildtoc
#
# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
# This file is autogenerated by buildtoc.PL.
# Edit that file and run it to effect changes.
#
# Builds perltoc.pod and sanity checks the list of pods against all
# of the MANIFEST, perl.pod, and ourselves.
#

use File::Find;
use Cwd;
use Text::Wrap;

@PODS = glob("*.pod");

sub output ($);

if (-d "pod") {
  die "$0: failed to chdir('pod'): $!\n" unless chdir("pod");
}

@pods = qw(
    perl
    perlfaq
    perltoc
    perlbook

    perlsyn
    perldata
    perlop
    perlsub
    perlfunc
    perlreftut
    perldsc
    perlrequick
    perlpod
    perlstyle
    perltrap

    perlrun
    perldiag
    perllexwarn
    perldebtut
    perldebug

    perlvar
    perllol
    perlopentut
    perlretut

    perlre
    perlref

    perlform

    perlboot
    perltoot
    perltootc
    perlobj
    perlbot
    perltie

    perlipc
    perlfork
    perlnumber
    perlthrtut

    perlport
    perllocale
    perlunicode
    perlebcdic

    perlsec

    perlmod
    perlmodlib
    perlmodinstall
    perlnewmod

    perlfaq1            
    perlfaq2            
    perlfaq3            
    perlfaq4            
    perlfaq5            
    perlfaq6            
    perlfaq7            
    perlfaq8            
    perlfaq9            

    perlcompile        

    perlembed          
    perldebguts         
    perlxstut           
    perlxs              
    perlguts            
    perlcall            
    perlutil            
    perlfilter          
    perldbmfilter       
    perlapi             
    perlintern          
    perlapio            
    perltodo            
    perlhack            

    perlhist           
    perldelta           
    perl56delta         
    perl5005delta       
    perl5004delta       

    perlaix
    perlamiga          
    perlcygwin          
    perldos             
    perlhpux            
    perlmachten         
    perlos2             
    perlos390           
    perlposix-bc
    perlvms             
    perlwin32           
	  );

@ARCHPODS = qw(
    perlaix	
    perlamiga          
    perlcygwin          
    perldos             
    perlhpux            
    perlmachten         
    perlos2             
    perlos390           
    perlposix-bc
    perlvms             
    perlwin32           
          );
for (@ARCHPODS) { s/$/.pod/ }
@ARCHPODS{@ARCHPODS} = ();

for (@pods) { s/$/.pod/ }
@pods{@pods} = ();
@PODS{@PODS} = ();

open(MANI, "../MANIFEST") || die "$0: opening ../MANIFEST failed: $!";
while (<MANI>) {
  if (m!^pod/([^.]+\.pod)\s+!i) {
     push @MANIPODS, $1;
  }
}
close(MANI);
@MANIPODS{@MANIPODS} = ();

open(PERLPOD, "perl.pod") || die "$0: opening perl.pod failed: $!\n";
while (<PERLPOD>) {
  if (/^For ease of access, /../^\(If you're intending /) {
	if (/^\s+(perl\S*)\s+\w/) {
		push @PERLPODS, "$1.pod";
	}
  }
}
close(PERLPOD);
die "$0: could not find the pod listing of perl.pod\n"
  unless @PERLPODS;
@PERLPODS{@PERLPODS} = ();

# Cross-check against ourselves
# Cross-check against the MANIFEST
# Cross-check against the perl.pod

foreach my $i (sort keys %PODS) {
  warn "$0: $i exists but is unknown by buildtoc\n"
	unless exists $pods{$i};
  warn "$0: $i exists but is unknown by ../MANIFEST\n"
	if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
  warn "$0: $i exists but is unknown by perl.pod\n"
	unless exists $PERLPODS{$i};
}
foreach my $i (sort keys %pods) {
  warn "$0: $i is known by buildtoc but does not exist\n"
	unless exists $PODS{$i};
}
foreach my $i (sort keys %MANIPODS) {
  warn "$0: $i is known by ../MANIFEST but does not exist\n"
	unless exists $PODS{$i};
}
foreach my $i (sort keys %PERLPODS) {
  warn "$0: $i is known by perl.pod but does not exist\n"
	unless exists $PODS{$i};
}

# We are ready to rock.
open(OUT, ">perltoc.pod") || die "$0: creating perltoc.pod failed: $!";

$/ = '';
@ARGV = @pods;

($_= <<EOPOD2B) =~ s/^\t//gm && output($_);

	=head1 NAME

	perltoc - perl documentation table of contents

	=head1 DESCRIPTION

	This page provides a brief table of contents for the rest of the Perl
	documentation set.  It is meant to be scanned quickly or grepped
	through to locate the proper section you're looking for.

	=head1 BASIC DOCUMENTATION

EOPOD2B
#' make emacs happy

podset(@pods);

find \&getpods => qw(../lib ../ext);

sub getpods {
    if (/\.p(od|m)$/) {
	# Skip .pm files that have corresponding .pod files, and Functions.pm.
	return if /(.*)\.pm$/ && -f "$1.pod";
	my $file = $File::Find::name;
	return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself

	die "tut $name" if $file =~ /TUT/;
	unless (open (F, "< $_\0")) {
	    warn "bogus <$file>: $!";
	    system "ls", "-l", $file;
	}
	else {
	    my $line;
	    while ($line = <F>) {
		if ($line =~ /^=head1\s+NAME\b/) {
		    push @modpods, $file;
		    #warn "GOOD $file\n";
		    return;
		}
	    }
	    warn "$0: $file: cannot find =head1 NAME\n";
	}
    }
}

die "no pods" unless @modpods;

for (@modpods) {
    #($name) = /(\w+)\.p(m|od)$/;
    $name = path2modname($_);
    if ($name =~ /^[a-z]/) {
	push @pragmata, $_;
    } else {
	if ($done{$name}++) {
	    # warn "already did $_\n";
	    next;
	}
	push @modules, $_;
	push @modname, $name;
    }
}

($_= <<EOPOD2B) =~ s/^\t//gm && output($_);


	=head1 PRAGMA DOCUMENTATION

EOPOD2B

podset(sort @pragmata);

($_= <<EOPOD2B) =~ s/^\t//gm && output($_);


	=head1 MODULE DOCUMENTATION

EOPOD2B

podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );

($_= <<EOPOD2B) =~ s/^\t//gm;


	=head1 AUXILIARY DOCUMENTATION

	Here should be listed all the extra programs' documentation, but they
	don't all have manual pages yet:

	=over

	=item a2p

	=item s2p

	=item find2perl

	=item h2ph

	=item c2ph

	=item h2xs

	=item xsubpp

	=item pod2man

	=item wrapsuid

	=back

	=head1 AUTHOR

	Larry Wall <F<larry\@wall.org>>, with the help of oodles
	of other folks.


EOPOD2B
output $_;
output "\n";                    # flush $LINE
exit;

sub podset {
    local @ARGV = @_;

    while(<>) {
	if (s/^=head1 (NAME)\s*/=head2 /) {
	    $pod = path2modname($ARGV);
	    unhead1();
	    output "\n \n\n=head2 ";
	    $_ = <>;
	    if ( /^\s*$pod\b/ ) {
		s/$pod\.pm/$pod/;       # '.pm' in NAME !?
		output $_;
	    } else {
		s/^/$pod, /;
		output $_;
	    }
	    next;
	}
	if (s/^=head1 (.*)/=item $1/) {
	    unhead2();
	    output "=over\n\n" unless $inhead1;
	    $inhead1 = 1;
	    output $_; nl(); next;
	}
	if (s/^=head2 (.*)/=item $1/) {
	    unitem();
	    output "=over\n\n" unless $inhead2;
	    $inhead2 = 1;
	    output $_; nl(); next;
	}
	if (s/^=item ([^=].*)/$1/) {
	    next if $pod eq 'perldiag';
	    s/^\s*\*\s*$// && next;
	    s/^\s*\*\s*//;
	    s/\n/ /g;
	    s/\s+$//;
	    next if /^[\d.]+$/;
	    next if $pod eq 'perlmodlib' && /^ftp:/;
	    ##print "=over\n\n" unless $initem;
	    output ", " if $initem;
	    $initem = 1;
	    s/\.$//;
	    s/^-X\b/-I<X>/;
	    output $_; next;
	}
	if (s/^=cut\s*\n//) {
	    unhead1();
	    next;
	}
    }
}

sub path2modname {
    local $_ = shift;
    s/\.p(m|od)$//;
    s-.*?/(lib|ext)/--;
    s-/-::-g;
    s/(\w+)::\1/$1/;
    return $_;
}

sub unhead1 {
    unhead2();
    if ($inhead1) {
	output "\n\n=back\n\n";
    }
    $inhead1 = 0;
}

sub unhead2 {
    unitem();
    if ($inhead2) {
	output "\n\n=back\n\n";
    }
    $inhead2 = 0;
}

sub unitem {
    if ($initem) {
	output "\n\n";
	##print "\n\n=back\n\n";
    }
    $initem = 0;
}

sub nl {
    output "\n";
}

my $NEWLINE;	# how many newlines have we seen recently
my $LINE;	# what remains to be printed

sub output ($) {
    for (split /(\n)/, shift) {
	if ($_ eq "\n") {
	    if ($LINE) {
		print OUT wrap('', '', $LINE);
		$LINE = '';
	    }
	    if ($NEWLINE < 2) {
		print OUT;
		$NEWLINE++;
	    }
	}
	elsif (/\S/ && length) {
	    $LINE .= $_;
	    $NEWLINE = 0;
	}
    }
}

!NO!SUBS!

close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
chdir $origdir;
Commit	Line	Data
4b19af01	1	#!/usr/local/bin/perl
	2
	3	use Config;
	4	use File::Basename qw(&basename &dirname);
	5	use Cwd;
	6
	7	# List explicitly here the variables you want Configure to
	8	# generate. Metaconfig only looks for shell variables, so you
	9	# have to mention them as if they were shell variables, not
	10	# %Config entries. Thus you write
	11	# $startperl
	12	# to ensure Configure will look for $Config{startperl}.
	13
	14	# This forces PL files to create target in same directory as PL file.
	15	# This is so that make depend always knows where to find PL derivatives.
	16	$origdir = cwd;
	17	chdir(dirname($0));
	18	($file = basename($0)) =~ s/\.PL$//;
	19	$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
	20	$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
	21
	22	open OUT,">$file" or die "Can't create $file: $!";
	23
	24	print "Extracting $file (with variable substitutions)\n";
	25
	26	# In this section, perl variables will be expanded during extraction.
	27	# You can use $Config{...} to use Configure variables.
	28
	29	print OUT <<"!GROK!THIS!";
	30	$Config{'startperl'}
	31	eval 'exec perl -S \$0 "\$@"'
	32	if 0;
	33	!GROK!THIS!
	34
	35	# In the following, perl variables are not expanded during extraction.
	36
	37	print OUT <<'!NO!SUBS!';
	38
	39	#
	40	# buildtoc
	41	#
	42	# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
	43	# This file is autogenerated by buildtoc.PL.
	44	# Edit that file and run it to effect changes.
	45	#
	46	# Builds perltoc.pod and sanity checks the list of pods against all
	47	# of the MANIFEST, perl.pod, and ourselves.
	48	#
	49
	50	use File::Find;
	51	use Cwd;
	52	use Text::Wrap;
	53
	54	@PODS = glob("*.pod");
	55
	56	sub output ($);
	57
	58	if (-d "pod") {
	59	die "$0: failed to chdir('pod'): $!\n" unless chdir("pod");
	60	}
	61
	62	@pods = qw(
	63	perl
	64	perlfaq
65	perltoc
66	perlbook
67
68	perlsyn
69	perldata
70	perlop
71	perlsub
72	perlfunc
73	perlreftut
74	perldsc
75	perlrequick
76	perlpod
77	perlstyle
78	perltrap
79
80	perlrun
81	perldiag
82	perllexwarn
22d4bb9c	83	perldebtut
4b19af01	84	perldebug
	85
	86	perlvar
	87	perllol
	88	perlopentut
	89	perlretut
	90
4b19af01	91	perlre
22d4bb9c	92	perlref
22d4bb9c	93
4b19af01	94	perlform
22d4bb9c	95
	96	perlboot
	97	perltoot
	98	perltootc
	99	perlobj
	100	perlbot
	101	perltie
4b19af01	102
	103	perlipc
	104	perlfork
	105	perlnumber
	106	perlthrtut
	107
	108	perlport
22d4bb9c	109	perllocale
	110	perlunicode
	111	perlebcdic
4b19af01	112
22d4bb9c	113	perlsec
4b19af01	114
	115	perlmod
	116	perlmodlib
	117	perlmodinstall
	118	perlnewmod
	119
	120	perlfaq1
	121	perlfaq2
	122	perlfaq3
	123	perlfaq4
	124	perlfaq5
	125	perlfaq6
	126	perlfaq7
	127	perlfaq8
	128	perlfaq9
	129
	130	perlcompile
	131
	132	perlembed
	133	perldebguts
	134	perlxstut
	135	perlxs
	136	perlguts
	137	perlcall
	138	perlutil
	139	perlfilter
	140	perldbmfilter
	141	perlapi
	142	perlintern
	143	perlapio
	144	perltodo
	145	perlhack
	146
	147	perlhist
	148	perldelta
	149	perl56delta
	150	perl5005delta
	151	perl5004delta
	152
22d4bb9c	153	perlaix
4b19af01	154	perlamiga
	155	perlcygwin
	156	perldos
	157	perlhpux
	158	perlmachten
	159	perlos2
	160	perlos390
	161	perlposix-bc
	162	perlvms
	163	perlwin32
	164	);
	165
	166	@ARCHPODS = qw(
22d4bb9c	167	perlaix
4b19af01	168	perlamiga
	169	perlcygwin
	170	perldos
	171	perlhpux
	172	perlmachten
	173	perlos2
	174	perlos390
	175	perlposix-bc
	176	perlvms
	177	perlwin32
	178	);
	179	for (@ARCHPODS) { s/$/.pod/ }
	180	@ARCHPODS{@ARCHPODS} = ();
	181
	182	for (@pods) { s/$/.pod/ }
	183	@pods{@pods} = ();
	184	@PODS{@PODS} = ();
	185
	186	open(MANI, "../MANIFEST") \|\| die "$0: opening ../MANIFEST failed: $!";
	187	while (<MANI>) {
	188	if (m!^pod/([^.]+\.pod)\s+!i) {
	189	push @MANIPODS, $1;
	190	}
	191	}
	192	close(MANI);
	193	@MANIPODS{@MANIPODS} = ();
	194
	195	open(PERLPOD, "perl.pod") \|\| die "$0: opening perl.pod failed: $!\n";
	196	while (<PERLPOD>) {
	197	if (/^For ease of access, /../^\(If you're intending /) {
	198	if (/^\s+(perl\S*)\s+\w/) {
	199	push @PERLPODS, "$1.pod";
	200	}
	201	}
	202	}
	203	close(PERLPOD);
	204	die "$0: could not find the pod listing of perl.pod\n"
	205	unless @PERLPODS;
	206	@PERLPODS{@PERLPODS} = ();
	207
	208	# Cross-check against ourselves
	209	# Cross-check against the MANIFEST
	210	# Cross-check against the perl.pod
	211
	212	foreach my $i (sort keys %PODS) {
	213	warn "$0: $i exists but is unknown by buildtoc\n"
	214	unless exists $pods{$i};
	215	warn "$0: $i exists but is unknown by ../MANIFEST\n"
	216	if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
	217	warn "$0: $i exists but is unknown by perl.pod\n"
	218	unless exists $PERLPODS{$i};
	219	}
	220	foreach my $i (sort keys %pods) {
	221	warn "$0: $i is known by buildtoc but does not exist\n"
	222	unless exists $PODS{$i};
	223	}
	224	foreach my $i (sort keys %MANIPODS) {
	225	warn "$0: $i is known by ../MANIFEST but does not exist\n"
	226	unless exists $PODS{$i};
	227	}
	228	foreach my $i (sort keys %PERLPODS) {
	229	warn "$0: $i is known by perl.pod but does not exist\n"
	230	unless exists $PODS{$i};
	231	}
232
233	# We are ready to rock.
234	open(OUT, ">perltoc.pod") \|\| die "$0: creating perltoc.pod failed: $!";
235
236	$/ = '';
237	@ARGV = @pods;
238
239	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
240
241	=head1 NAME
242
243	perltoc - perl documentation table of contents
244
245	=head1 DESCRIPTION
246
247	This page provides a brief table of contents for the rest of the Perl
248	documentation set. It is meant to be scanned quickly or grepped
249	through to locate the proper section you're looking for.
250
251	=head1 BASIC DOCUMENTATION
252
253	EOPOD2B
254	#' make emacs happy
255
256	podset(@pods);
257
258	find \&getpods => qw(../lib ../ext);
259
260	sub getpods {
261	if (/\.p(od\|m)$/) {
262	# Skip .pm files that have corresponding .pod files, and Functions.pm.
263	return if /(.*)\.pm$/ && -f "$1.pod";
264	my $file = $File::Find::name;
265	return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
266
267	die "tut $name" if $file =~ /TUT/;
268	unless (open (F, "< $_\0")) {
269	warn "bogus <$file>: $!";
270	system "ls", "-l", $file;
271	}
272	else {
273	my $line;
274	while ($line = <F>) {
275	if ($line =~ /^=head1\s+NAME\b/) {
276	push @modpods, $file;
277	#warn "GOOD $file\n";
278	return;
279	}
280	}
281	warn "$0: $file: cannot find =head1 NAME\n";
282	}
283	}
284	}
285
286	die "no pods" unless @modpods;
287
288	for (@modpods) {
289	#($name) = /(\w+)\.p(m\|od)$/;
290	$name = path2modname($_);
291	if ($name =~ /^[a-z]/) {
292	push @pragmata, $_;
293	} else {
294	if ($done{$name}++) {
295	# warn "already did $_\n";
296	next;
297	}
298	push @modules, $_;
299	push @modname, $name;
300	}
301	}
302
303	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
304
305
306
307	=head1 PRAGMA DOCUMENTATION
308
309	EOPOD2B
310
311	podset(sort @pragmata);
312
313	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
314
315
316
317	=head1 MODULE DOCUMENTATION
318
319	EOPOD2B
320
321	podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
322
323	($_= <<EOPOD2B) =~ s/^\t//gm;
324
325
326	=head1 AUXILIARY DOCUMENTATION
327
328	Here should be listed all the extra programs' documentation, but they
329	don't all have manual pages yet:
330
331	=over
332
333	=item a2p
334
335	=item s2p
336
337	=item find2perl
338
339	=item h2ph
340
341	=item c2ph
342
343	=item h2xs
344
345	=item xsubpp
346
347	=item pod2man
348
349	=item wrapsuid
350
351	=back
352
353	=head1 AUTHOR
354
355	Larry Wall <F<larry\@wall.org>>, with the help of oodles
356	of other folks.
357
358
359	EOPOD2B
360	output $_;
361	output "\n"; # flush $LINE
362	exit;
363
364	sub podset {
365	local @ARGV = @_;
366
367	while(<>) {
368	if (s/^=head1 (NAME)\s*/=head2 /) {
369	$pod = path2modname($ARGV);
370	unhead1();
371	output "\n \n\n=head2 ";
372	$_ = <>;
373	if ( /^\s*$pod\b/ ) {
374	s/$pod\.pm/$pod/; # '.pm' in NAME !?
375	output $_;
376	} else {
377	s/^/$pod, /;
378	output $_;
379	}
380	next;
381	}
382	if (s/^=head1 (.*)/=item $1/) {
383	unhead2();
384	output "=over\n\n" unless $inhead1;
385	$inhead1 = 1;
386	output $_; nl(); next;
387	}
388	if (s/^=head2 (.*)/=item $1/) {
389	unitem();
390	output "=over\n\n" unless $inhead2;
391	$inhead2 = 1;
392	output $_; nl(); next;
393	}
394	if (s/^=item ([^=].*)/$1/) {
395	next if $pod eq 'perldiag';
396	s/^\s\\s*$// && next;
397	s/^\s\\s*//;
398	s/\n/ /g;
399	s/\s+$//;
400	next if /^[\d.]+$/;
401	next if $pod eq 'perlmodlib' && /^ftp:/;
402	##print "=over\n\n" unless $initem;
403	output ", " if $initem;
404	$initem = 1;
405	s/\.$//;
406	s/^-X\b/-I<X>/;
407	output $_; next;
408	}
409	if (s/^=cut\s*\n//) {
410	unhead1();
411	next;
412	}
413	}
414	}
415
416	sub path2modname {
417	local $_ = shift;
418	s/\.p(m\|od)$//;
419	s-.*?/(lib\|ext)/--;
420	s-/-::-g;
421	s/(\w+)::\1/$1/;
422	return $_;
423	}
424
425	sub unhead1 {
426	unhead2();
427	if ($inhead1) {
428	output "\n\n=back\n\n";
429	}
430	$inhead1 = 0;
431	}
432
433	sub unhead2 {
434	unitem();
435	if ($inhead2) {
436	output "\n\n=back\n\n";
437	}
438	$inhead2 = 0;
439	}
440
441	sub unitem {
442	if ($initem) {
443	output "\n\n";
444	##print "\n\n=back\n\n";
445	}
446	$initem = 0;
447	}
448
449	sub nl {
450	output "\n";
451	}
452
453	my $NEWLINE; # how many newlines have we seen recently
454	my $LINE; # what remains to be printed
455
456	sub output ($) {
457	for (split /(\n)/, shift) {
458	if ($_ eq "\n") {
459	if ($LINE) {
460	print OUT wrap('', '', $LINE);
461	$LINE = '';
462	}
463	if ($NEWLINE < 2) {
464	print OUT;
465	$NEWLINE++;
466	}
467	}
468	elsif (/\S/ && length) {
469	$LINE .= $_;
470	$NEWLINE = 0;
471	}
472	}
473	}
474
475	!NO!SUBS!
476
22d4bb9c	477	close OUT or die "Can't close $file: $!";
	478	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	479	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
	480	chdir $origdir;