[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             
    perllol             
    perlrequick         
    perlretut           

    perlrun             
    perllexwarn         
    perldebug           

    perlopentut         
    perlvar             
    perlmod             
    perlpod             

    perlstyle           
    perlmodlib          
    perlmodinstall      
    perlnewmod          
    perltrap            
    perlport            
    perlsec             

    perlref             
    perlre              
    perlform            
    perllocale          
    perlunicode         

    perlboot            
    perltoot            
    perltootc           
    perlobj             
    perlbot             
    perltie             

    perlipc             
    perlnumber          
    perlfork            
    perlthrtut          

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