[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       

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

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