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