[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");
}

@ARCHPODS = qw(
    perlaix	
    perlapollo
    perlamiga          
    perlbeos
    perlbs2000
    perlce
    perlcygwin          
    perldgux             
    perldos             
    perlepoc             
    perlfreebsd             
    perlhpux            
    perlhurd            
    perlirix            
    perlmachten         
    perlmacos
    perlmacosx
    perlmint
    perlmpeix
    perlnetware             
    perlos2             
    perlos390           
    perlos400           
    perlqnx
    perlplan9
    perlsolaris
    perltru64
    perluts
    perlvmesa
    perlvms             
    perlvos             
    perlwin32           
          );

@CJKPODS = qw(
    perlcn
    perljp
    perlko
    perltw
          );

@pods = 
  (
    qw(

    perl
    perlintro
    perlfaq
    perltoc
    perlbook

    perlsyn
    perldata
    perlop
    perlsub
    perlfunc
    perlreftut
    perldsc
    perlrequick
    perlpod
    perlpodspec
    perlstyle
    perltrap
    perlcheat

    perlrun
    perldiag
    perllexwarn
    perldebtut
    perldebug

    perlvar
    perllol
    perlopentut
    perlpacktut
    perlretut

    perlre
    perlreref
    perlref

    perlform

    perlboot
    perltoot
    perltooc
    perlobj
    perlbot
    perltie

    perlipc
    perlfork
    perlnumber

    perlthrtut
    perlothrtut

    perlport
    perllocale
    perluniintro
    perlunicode
    perlebcdic

    perlsec

    perlmod
    perlmodinstall
    perlmodlib
    perlmodstyle
    perlnewmod

    perlfaq1            
    perlfaq2            
    perlfaq3            
    perlfaq4            
    perlfaq5            
    perlfaq6            
    perlfaq7            
    perlfaq8            
    perlfaq9            

    perlcompile        

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

    perlhist           
    perldelta           
    perl58delta         
    perl573delta         
    perl572delta         
    perl571delta         
    perl570delta         
    perl561delta         
    perl56delta         
    perl5005delta       
    perl5004delta       

    perlartistic
    perlgpl

    ),

    @ARCHPODS,

  );

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

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

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} = ();

# Delete the CJK because we cannot mix their encodings.
delete @PERLPODS{@CJKPODS};
delete @PODS{@CJKPODS};
delete @pods{@CJKPODS};

# 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} && !exists $CJKPODS{$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)$/) {
	my $file = $File::Find::name;
        return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
        return if $file =~ m!(?:^|/)t/!;
        return if $file =~ m!lib/Attribute/Handlers/demo/!;
        return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
        return if $file =~ m!lib/Math/BigInt/t/!;
        return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
        return if $file =~ m!XS/(?:APItest|Typemap)!;
        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 4

	=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 4\n\n" unless $inhead1;
	    $inhead1 = 1;
	    output $_; nl(); next;
	}
	if (s/^=head2 (.*)/=item $1/) {
	    unitem();
	    output "=over 4\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 4\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
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
a83b6f46	62	@ARCHPODS = qw(
	63	perlaix
	64	perlapollo
	65	perlamiga
	66	perlbeos
	67	perlbs2000
a1f19229	68	perlce
a83b6f46	69	perlcygwin
	70	perldgux
	71	perldos
	72	perlepoc
18a271bd	73	perlfreebsd
a83b6f46	74	perlhpux
a83b6f46	75	perlhurd
469e7be4	76	perlirix
a83b6f46	77	perlmachten
a83b6f46	78	perlmacos
0d53b15f	79	perlmacosx
a83b6f46	80	perlmint
a83b6f46	81	perlmpeix
9038e305	82	perlnetware
a83b6f46	83	perlos2
a83b6f46	84	perlos390
522b859a	85	perlos400
a83b6f46	86	perlqnx
	87	perlplan9
	88	perlsolaris
	89	perltru64
91144103	90	perluts
a83b6f46	91	perlvmesa
	92	perlvms
	93	perlvos
	94	perlwin32
	95	);
	96
d8416318	97	@CJKPODS = qw(
	98	perlcn
	99	perljp
	100	perlko
	101	perltw
	102	);
	103
a83b6f46	104	@pods =
	105	(
	106	qw(
	107
c2e66d9e	108	perl
10151d09	109	perlintro
c2e66d9e	110	perlfaq
	111	perltoc
	112	perlbook
	113
	114	perlsyn
	115	perldata
	116	perlop
	117	perlsub
	118	perlfunc
	119	perlreftut
	120	perldsc
	121	perlrequick
	122	perlpod
8a93676d	123	perlpodspec
c2e66d9e	124	perlstyle
c2e66d9e	125	perltrap
e969ef56	126	perlcheat
c2e66d9e	127
	128	perlrun
	129	perldiag
	130	perllexwarn
10862624	131	perldebtut
c2e66d9e	132	perldebug
	133
	134	perlvar
	135	perllol
	136	perlopentut
34babc16	137	perlpacktut
c2e66d9e	138	perlretut
c2e66d9e	139
c2e66d9e	140	perlre
30487ceb	141	perlreref
d396a558	142	perlref
d396a558	143
c2e66d9e	144	perlform
d396a558	145
	146	perlboot
	147	perltoot
890a53b9	148	perltooc
d396a558	149	perlobj
	150	perlbot
	151	perltie
c2e66d9e	152
	153	perlipc
	154	perlfork
	155	perlnumber
53d7eaa8	156
c2e66d9e	157	perlthrtut
53d7eaa8	158	perlothrtut
c2e66d9e	159
c2e66d9e	160	perlport
d396a558	161	perllocale
07fcf8ff	162	perluniintro
d396a558	163	perlunicode
d396a558	164	perlebcdic
c2e66d9e	165
d396a558	166	perlsec
c2e66d9e	167
c2e66d9e	168	perlmod
c2e66d9e	169	perlmodinstall
35bf961c	170	perlmodlib
35bf961c	171	perlmodstyle
c2e66d9e	172	perlnewmod
c2e66d9e	173
4755096e	174	perlfaq1
	175	perlfaq2
	176	perlfaq3
	177	perlfaq4
	178	perlfaq5
	179	perlfaq6
	180	perlfaq7
	181	perlfaq8
	182	perlfaq9
	183
	184	perlcompile
	185
	186	perlembed
	187	perldebguts
	188	perlxstut
	189	perlxs
f40a6c71	190	perlclib
4755096e	191	perlguts
	192	perlcall
	193	perlutil
	194	perlfilter
	195	perldbmfilter
	196	perlapi
	197	perlintern
dc5c060f	198	perliol
4755096e	199	perlapio
	200	perltodo
	201	perlhack
2a551100	202	perldoc
4755096e	203
	204	perlhist
	205	perldelta
2a551100	206	perl58delta
77b096b5	207	perl573delta
245d750e	208	perl572delta
1db9e106	209	perl571delta
1db9e106	210	perl570delta
493a87da	211	perl561delta
4755096e	212	perl56delta
	213	perl5005delta
	214	perl5004delta
	215
2a551100	216	perlartistic
	217	perlgpl
	218
a83b6f46	219	),
a83b6f46	220
d8416318	221	@ARCHPODS,
a83b6f46	222
a83b6f46	223	);
4755096e	224
4755096e	225	for (@ARCHPODS) { s/$/.pod/ }
	226	@ARCHPODS{@ARCHPODS} = ();
	227
d8416318	228	for (@CJKPODS) { s/$/.pod/ }
	229	@CJKPODS{@CJKPODS} = ();
	230
4755096e	231	for (@pods) { s/$/.pod/ }
	232	@pods{@pods} = ();
	233	@PODS{@PODS} = ();
	234
	235	open(MANI, "../MANIFEST") \|\| die "$0: opening ../MANIFEST failed: $!";
	236	while (<MANI>) {
	237	if (m!^pod/([^.]+\.pod)\s+!i) {
	238	push @MANIPODS, $1;
	239	}
	240	}
	241	close(MANI);
	242	@MANIPODS{@MANIPODS} = ();
	243
	244	open(PERLPOD, "perl.pod") \|\| die "$0: opening perl.pod failed: $!\n";
	245	while (<PERLPOD>) {
	246	if (/^For ease of access, /../^\(If you're intending /) {
c2e66d9e	247	if (/^\s+(perl\S*)\s+\w/) {
4755096e	248	push @PERLPODS, "$1.pod";
	249	}
	250	}
	251	}
	252	close(PERLPOD);
	253	die "$0: could not find the pod listing of perl.pod\n"
	254	unless @PERLPODS;
	255	@PERLPODS{@PERLPODS} = ();
	256
d8416318	257	# Delete the CJK because we cannot mix their encodings.
	258	delete @PERLPODS{@CJKPODS};
	259	delete @PODS{@CJKPODS};
	260	delete @pods{@CJKPODS};
	261
4755096e	262	# Cross-check against ourselves
	263	# Cross-check against the MANIFEST
	264	# Cross-check against the perl.pod
	265
	266	foreach my $i (sort keys %PODS) {
	267	warn "$0: $i exists but is unknown by buildtoc\n"
	268	unless exists $pods{$i};
	269	warn "$0: $i exists but is unknown by ../MANIFEST\n"
d8416318	270	if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i} && !exists $CJKPODS{$i};
4755096e	271	warn "$0: $i exists but is unknown by perl.pod\n"
	272	unless exists $PERLPODS{$i};
	273	}
	274	foreach my $i (sort keys %pods) {
	275	warn "$0: $i is known by buildtoc but does not exist\n"
	276	unless exists $PODS{$i};
	277	}
	278	foreach my $i (sort keys %MANIPODS) {
	279	warn "$0: $i is known by ../MANIFEST but does not exist\n"
	280	unless exists $PODS{$i};
	281	}
	282	foreach my $i (sort keys %PERLPODS) {
	283	warn "$0: $i is known by perl.pod but does not exist\n"
	284	unless exists $PODS{$i};
	285	}
	286
	287	# We are ready to rock.
	288	open(OUT, ">perltoc.pod") \|\| die "$0: creating perltoc.pod failed: $!";
	289
	290	$/ = '';
	291	@ARGV = @pods;
	292
	293	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
	294
	295	=head1 NAME
	296
	297	perltoc - perl documentation table of contents
	298
	299	=head1 DESCRIPTION
	300
	301	This page provides a brief table of contents for the rest of the Perl
	302	documentation set. It is meant to be scanned quickly or grepped
	303	through to locate the proper section you're looking for.
	304
	305	=head1 BASIC DOCUMENTATION
	306
	307	EOPOD2B
	308	#' make emacs happy
	309
	310	podset(@pods);
	311
	312	find \&getpods => qw(../lib ../ext);
	313
	314	sub getpods {
	315	if (/\.p(od\|m)$/) {
4755096e	316	my $file = $File::Find::name;
ad716b8e	317	return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
2a551100	318	return if $file =~ m!(?:^\|/)t/!;
a83b6f46	319	return if $file =~ m!lib/Attribute/Handlers/demo/!;
ad716b8e	320	return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
ba62762e	321	return if $file =~ m!lib/Math/BigInt/t/!;
ad716b8e	322	return if $file =~ m!/Devel/PPPort/[Hh]arness\|lib/Devel/Harness!i;
	323	return if $file =~ m!XS/(?:APItest\|Typemap)!;
	324	die "tut $name" if $file =~ /TUT/;
4755096e	325	unless (open (F, "< $_\0")) {
	326	warn "bogus <$file>: $!";
	327	system "ls", "-l", $file;
	328	}
	329	else {
	330	my $line;
	331	while ($line = <F>) {
	332	if ($line =~ /^=head1\s+NAME\b/) {
	333	push @modpods, $file;
	334	#warn "GOOD $file\n";
	335	return;
	336	}
	337	}
	338	warn "$0: $file: cannot find =head1 NAME\n";
	339	}
	340	}
	341	}
	342
	343	die "no pods" unless @modpods;
	344
	345	for (@modpods) {
	346	#($name) = /(\w+)\.p(m\|od)$/;
	347	$name = path2modname($_);
	348	if ($name =~ /^[a-z]/) {
	349	push @pragmata, $_;
	350	} else {
	351	if ($done{$name}++) {
	352	# warn "already did $_\n";
	353	next;
	354	}
	355	push @modules, $_;
	356	push @modname, $name;
	357	}
	358	}
	359
	360	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
	361
	362
	363
	364	=head1 PRAGMA DOCUMENTATION
	365
	366	EOPOD2B
	367
	368	podset(sort @pragmata);
	369
	370	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
	371
	372
	373
	374	=head1 MODULE DOCUMENTATION
	375
	376	EOPOD2B
	377
	378	podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
	379
	380	($_= <<EOPOD2B) =~ s/^\t//gm;
	381
	382
	383	=head1 AUXILIARY DOCUMENTATION
	384
	385	Here should be listed all the extra programs' documentation, but they
	386	don't all have manual pages yet:
	387
13a2d996	388	=over 4
4755096e	389
	390	=item a2p
	391
	392	=item s2p
	393
	394	=item find2perl
	395
	396	=item h2ph
	397
	398	=item c2ph
	399
	400	=item h2xs
	401
	402	=item xsubpp
	403
	404	=item pod2man
	405
	406	=item wrapsuid
	407
	408	=back
	409
	410	=head1 AUTHOR
	411
	412	Larry Wall <F<larry\@wall.org>>, with the help of oodles
	413	of other folks.
	414
	415
	416	EOPOD2B
	417	output $_;
	418	output "\n"; # flush $LINE
	419	exit;
	420
	421	sub podset {
	422	local @ARGV = @_;
	423
	424	while(<>) {
	425	if (s/^=head1 (NAME)\s*/=head2 /) {
	426	$pod = path2modname($ARGV);
	427	unhead1();
	428	output "\n \n\n=head2 ";
	429	$_ = <>;
	430	if ( /^\s*$pod\b/ ) {
	431	s/$pod\.pm/$pod/; # '.pm' in NAME !?
	432	output $_;
	433	} else {
	434	s/^/$pod, /;
	435	output $_;
	436	}
	437	next;
	438	}
	439	if (s/^=head1 (.*)/=item $1/) {
	440	unhead2();
13a2d996	441	output "=over 4\n\n" unless $inhead1;
4755096e	442	$inhead1 = 1;
	443	output $_; nl(); next;
	444	}
	445	if (s/^=head2 (.*)/=item $1/) {
	446	unitem();
13a2d996	447	output "=over 4\n\n" unless $inhead2;
4755096e	448	$inhead2 = 1;
	449	output $_; nl(); next;
	450	}
	451	if (s/^=item ([^=].*)/$1/) {
	452	next if $pod eq 'perldiag';
	453	s/^\s\\s*$// && next;
	454	s/^\s\\s*//;
	455	s/\n/ /g;
	456	s/\s+$//;
	457	next if /^[\d.]+$/;
	458	next if $pod eq 'perlmodlib' && /^ftp:/;
13a2d996	459	##print "=over 4\n\n" unless $initem;
4755096e	460	output ", " if $initem;
	461	$initem = 1;
	462	s/\.$//;
	463	s/^-X\b/-I<X>/;
	464	output $_; next;
	465	}
	466	if (s/^=cut\s*\n//) {
	467	unhead1();
	468	next;
	469	}
	470	}
	471	}
	472
	473	sub path2modname {
	474	local $_ = shift;
	475	s/\.p(m\|od)$//;
	476	s-.*?/(lib\|ext)/--;
	477	s-/-::-g;
	478	s/(\w+)::\1/$1/;
	479	return $_;
	480	}
	481
	482	sub unhead1 {
	483	unhead2();
	484	if ($inhead1) {
	485	output "\n\n=back\n\n";
	486	}
	487	$inhead1 = 0;
	488	}
	489
	490	sub unhead2 {
	491	unitem();
	492	if ($inhead2) {
	493	output "\n\n=back\n\n";
	494	}
	495	$inhead2 = 0;
	496	}
	497
	498	sub unitem {
	499	if ($initem) {
	500	output "\n\n";
	501	##print "\n\n=back\n\n";
	502	}
	503	$initem = 0;
	504	}
	505
	506	sub nl {
	507	output "\n";
	508	}
	509
	510	my $NEWLINE; # how many newlines have we seen recently
	511	my $LINE; # what remains to be printed
	512
	513	sub output ($) {
	514	for (split /(\n)/, shift) {
	515	if ($_ eq "\n") {
	516	if ($LINE) {
	517	print OUT wrap('', '', $LINE);
	518	$LINE = '';
	519	}
	520	if ($NEWLINE < 2) {
	521	print OUT;
	522	$NEWLINE++;
	523	}
524	}
525	elsif (/\S/ && length) {
526	$LINE .= $_;
527	$NEWLINE = 0;
528	}
529	}
530	}
531
532	!NO!SUBS!
533
6bbf1b34	534	close OUT or die "Can't close $file: $!";
	535	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	536	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
	537	chdir $origdir;