[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

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