[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

    perlsyn
    perldata
    perlop
    perlsub
    perlfunc
    perlreftut
    perldsc
    perlrequick
    perlpod
    perlstyle
    perltrap

    perlrun
    perldiag
    perllexwarn
    perldebug

    perlvar
    perllol
    perlopentut
    perlretut

    perlref
    perlre
    perlform
    perllocale
    perlunicode

    perlipc
    perlfork
    perlnumber
    perlthrtut

    perlport
    perlsec

    perlboot
    perltoot
    perltootc
    perlobj
    perlbot
    perltie

    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       

    perlamiga          
    perlcygwin          
    perldos             
    perlhpux            
    perlmachten         
    perlos2             
    perlos390           
    perlvms             
    perlwin32           
	  );

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