[perl5.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         
    perlos2             
    perlos390           
    perlposix-bc
    perlsolaris
    perlvms             
    perlvos             
    perlwin32           
	  );

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