[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              
    perlclib            
    perlguts            
    perlcall            
    perlutil            
    perlfilter          
    perldbmfilter       
    perlapi             
    perlintern          
    perliol            
    perlapio            
    perltodo            
    perlhack            

    perlhist           
    perldelta           
    perl56delta         
    perl5005delta       
    perl5004delta       

    perlaix
    perlamiga          
    perlbs2000
    perlcygwin          
    perldos             
    perlepoc             
    perlhpux            
    perlmachten         
    perlmacos
    perlmpeix         
    perlos2             
    perlos390           
    perlsolaris
    perlvmesa
    perlvms             
    perlvos             
    perlwin32           
	  );

@ARCHPODS = qw(
    perlaix	
    perlamiga          
    perlbs2000
    perlcygwin          
    perldos             
    perlepoc             
    perlhpux            
    perlmachten         
    perlmacos
    perlmpeix
    perlos2             
    perlos390           
    perlsolaris
    perlvmesa
    perlvms             
    perlvos             
    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 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
	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
f40a6c71	136	perlclib
4755096e	137	perlguts
	138	perlcall
	139	perlutil
	140	perlfilter
	141	perldbmfilter
	142	perlapi
	143	perlintern
dc5c060f	144	perliol
4755096e	145	perlapio
	146	perltodo
	147	perlhack
	148
	149	perlhist
	150	perldelta
	151	perl56delta
	152	perl5005delta
	153	perl5004delta
	154
37d4d706	155	perlaix
4755096e	156	perlamiga
dc5c060f	157	perlbs2000
4755096e	158	perlcygwin
4755096e	159	perldos
9a997319	160	perlepoc
4755096e	161	perlhpux
4755096e	162	perlmachten
26d9b02f	163	perlmacos
ab648d5e	164	perlmpeix
4755096e	165	perlos2
4755096e	166	perlos390
d420ca49	167	perlsolaris
dc5c060f	168	perlvmesa
4755096e	169	perlvms
9a997319	170	perlvos
4755096e	171	perlwin32
	172	);
	173
	174	@ARCHPODS = qw(
37d4d706	175	perlaix
4755096e	176	perlamiga
dc5c060f	177	perlbs2000
4755096e	178	perlcygwin
4755096e	179	perldos
9a997319	180	perlepoc
4755096e	181	perlhpux
4755096e	182	perlmachten
26d9b02f	183	perlmacos
ab648d5e	184	perlmpeix
4755096e	185	perlos2
4755096e	186	perlos390
d420ca49	187	perlsolaris
dc5c060f	188	perlvmesa
4755096e	189	perlvms
9a997319	190	perlvos
4755096e	191	perlwin32
	192	);
	193	for (@ARCHPODS) { s/$/.pod/ }
	194	@ARCHPODS{@ARCHPODS} = ();
	195
	196	for (@pods) { s/$/.pod/ }
	197	@pods{@pods} = ();
	198	@PODS{@PODS} = ();
	199
	200	open(MANI, "../MANIFEST") \|\| die "$0: opening ../MANIFEST failed: $!";
	201	while (<MANI>) {
	202	if (m!^pod/([^.]+\.pod)\s+!i) {
	203	push @MANIPODS, $1;
	204	}
	205	}
	206	close(MANI);
	207	@MANIPODS{@MANIPODS} = ();
	208
	209	open(PERLPOD, "perl.pod") \|\| die "$0: opening perl.pod failed: $!\n";
	210	while (<PERLPOD>) {
	211	if (/^For ease of access, /../^\(If you're intending /) {
c2e66d9e	212	if (/^\s+(perl\S*)\s+\w/) {
4755096e	213	push @PERLPODS, "$1.pod";
	214	}
	215	}
	216	}
	217	close(PERLPOD);
	218	die "$0: could not find the pod listing of perl.pod\n"
	219	unless @PERLPODS;
	220	@PERLPODS{@PERLPODS} = ();
	221
	222	# Cross-check against ourselves
	223	# Cross-check against the MANIFEST
	224	# Cross-check against the perl.pod
	225
	226	foreach my $i (sort keys %PODS) {
	227	warn "$0: $i exists but is unknown by buildtoc\n"
	228	unless exists $pods{$i};
	229	warn "$0: $i exists but is unknown by ../MANIFEST\n"
	230	if !exists $MANIPODS{$i} && !exists $ARCHPODS{$i};
	231	warn "$0: $i exists but is unknown by perl.pod\n"
	232	unless exists $PERLPODS{$i};
	233	}
	234	foreach my $i (sort keys %pods) {
	235	warn "$0: $i is known by buildtoc but does not exist\n"
	236	unless exists $PODS{$i};
	237	}
	238	foreach my $i (sort keys %MANIPODS) {
	239	warn "$0: $i is known by ../MANIFEST but does not exist\n"
	240	unless exists $PODS{$i};
	241	}
	242	foreach my $i (sort keys %PERLPODS) {
	243	warn "$0: $i is known by perl.pod but does not exist\n"
	244	unless exists $PODS{$i};
	245	}
	246
	247	# We are ready to rock.
	248	open(OUT, ">perltoc.pod") \|\| die "$0: creating perltoc.pod failed: $!";
	249
	250	$/ = '';
	251	@ARGV = @pods;
	252
	253	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
	254
	255	=head1 NAME
	256
	257	perltoc - perl documentation table of contents
	258
	259	=head1 DESCRIPTION
	260
	261	This page provides a brief table of contents for the rest of the Perl
	262	documentation set. It is meant to be scanned quickly or grepped
	263	through to locate the proper section you're looking for.
	264
	265	=head1 BASIC DOCUMENTATION
	266
	267	EOPOD2B
	268	#' make emacs happy
	269
	270	podset(@pods);
	271
	272	find \&getpods => qw(../lib ../ext);
	273
	274	sub getpods {
	275	if (/\.p(od\|m)$/) {
	276	# Skip .pm files that have corresponding .pod files, and Functions.pm.
277	return if /(.*)\.pm$/ && -f "$1.pod";
278	my $file = $File::Find::name;
279	return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
280
281	die "tut $name" if $file =~ /TUT/;
282	unless (open (F, "< $_\0")) {
283	warn "bogus <$file>: $!";
284	system "ls", "-l", $file;
285	}
286	else {
287	my $line;
288	while ($line = <F>) {
289	if ($line =~ /^=head1\s+NAME\b/) {
290	push @modpods, $file;
291	#warn "GOOD $file\n";
292	return;
293	}
294	}
295	warn "$0: $file: cannot find =head1 NAME\n";
296	}
297	}
298	}
299
300	die "no pods" unless @modpods;
301
302	for (@modpods) {
303	#($name) = /(\w+)\.p(m\|od)$/;
304	$name = path2modname($_);
305	if ($name =~ /^[a-z]/) {
306	push @pragmata, $_;
307	} else {
308	if ($done{$name}++) {
309	# warn "already did $_\n";
310	next;
311	}
312	push @modules, $_;
313	push @modname, $name;
314	}
315	}
316
317	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
318
319
320
321	=head1 PRAGMA DOCUMENTATION
322
323	EOPOD2B
324
325	podset(sort @pragmata);
326
327	($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
328
329
330
331	=head1 MODULE DOCUMENTATION
332
333	EOPOD2B
334
335	podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
336
337	($_= <<EOPOD2B) =~ s/^\t//gm;
338
339
340	=head1 AUXILIARY DOCUMENTATION
341
342	Here should be listed all the extra programs' documentation, but they
343	don't all have manual pages yet:
344
13a2d996	345	=over 4
4755096e	346
	347	=item a2p
	348
	349	=item s2p
	350
	351	=item find2perl
	352
	353	=item h2ph
	354
	355	=item c2ph
	356
	357	=item h2xs
	358
	359	=item xsubpp
	360
	361	=item pod2man
	362
	363	=item wrapsuid
	364
	365	=back
	366
	367	=head1 AUTHOR
	368
	369	Larry Wall <F<larry\@wall.org>>, with the help of oodles
	370	of other folks.
	371
	372
	373	EOPOD2B
	374	output $_;
	375	output "\n"; # flush $LINE
	376	exit;
	377
	378	sub podset {
	379	local @ARGV = @_;
	380
	381	while(<>) {
	382	if (s/^=head1 (NAME)\s*/=head2 /) {
	383	$pod = path2modname($ARGV);
	384	unhead1();
	385	output "\n \n\n=head2 ";
	386	$_ = <>;
	387	if ( /^\s*$pod\b/ ) {
	388	s/$pod\.pm/$pod/; # '.pm' in NAME !?
	389	output $_;
	390	} else {
	391	s/^/$pod, /;
	392	output $_;
	393	}
	394	next;
	395	}
	396	if (s/^=head1 (.*)/=item $1/) {
	397	unhead2();
13a2d996	398	output "=over 4\n\n" unless $inhead1;
4755096e	399	$inhead1 = 1;
	400	output $_; nl(); next;
	401	}
	402	if (s/^=head2 (.*)/=item $1/) {
	403	unitem();
13a2d996	404	output "=over 4\n\n" unless $inhead2;
4755096e	405	$inhead2 = 1;
	406	output $_; nl(); next;
	407	}
	408	if (s/^=item ([^=].*)/$1/) {
	409	next if $pod eq 'perldiag';
	410	s/^\s\\s*$// && next;
	411	s/^\s\\s*//;
	412	s/\n/ /g;
	413	s/\s+$//;
	414	next if /^[\d.]+$/;
	415	next if $pod eq 'perlmodlib' && /^ftp:/;
13a2d996	416	##print "=over 4\n\n" unless $initem;
4755096e	417	output ", " if $initem;
	418	$initem = 1;
	419	s/\.$//;
	420	s/^-X\b/-I<X>/;
	421	output $_; next;
	422	}
	423	if (s/^=cut\s*\n//) {
	424	unhead1();
	425	next;
	426	}
	427	}
	428	}
	429
	430	sub path2modname {
	431	local $_ = shift;
	432	s/\.p(m\|od)$//;
	433	s-.*?/(lib\|ext)/--;
	434	s-/-::-g;
	435	s/(\w+)::\1/$1/;
	436	return $_;
	437	}
	438
	439	sub unhead1 {
	440	unhead2();
	441	if ($inhead1) {
	442	output "\n\n=back\n\n";
	443	}
	444	$inhead1 = 0;
	445	}
	446
	447	sub unhead2 {
	448	unitem();
	449	if ($inhead2) {
	450	output "\n\n=back\n\n";
	451	}
	452	$inhead2 = 0;
	453	}
	454
	455	sub unitem {
	456	if ($initem) {
	457	output "\n\n";
	458	##print "\n\n=back\n\n";
	459	}
	460	$initem = 0;
	461	}
	462
	463	sub nl {
	464	output "\n";
	465	}
	466
	467	my $NEWLINE; # how many newlines have we seen recently
	468	my $LINE; # what remains to be printed
	469
	470	sub output ($) {
	471	for (split /(\n)/, shift) {
	472	if ($_ eq "\n") {
	473	if ($LINE) {
	474	print OUT wrap('', '', $LINE);
	475	$LINE = '';
	476	}
	477	if ($NEWLINE < 2) {
	478	print OUT;
	479	$NEWLINE++;
	480	}
481	}
482	elsif (/\S/ && length) {
483	$LINE .= $_;
484	$NEWLINE = 0;
485	}
486	}
487	}
488
489	!NO!SUBS!
490
6bbf1b34	491	close OUT or die "Can't close $file: $!";
	492	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	493	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
	494	chdir $origdir;