[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       

    perlaix
    perlamiga          
    perlcygwin          
    perldos             
    perlepoc             
    perlhpux            
    perlmachten         
    perlmpeix         
    perlos2             
    perlos390           
    perlposix-bc
    perlsolaris
    perlvms             
    perlvos             
    perlwin32           
	  );

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