[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           
    perl572delta         
    perl571delta         
    perl570delta         
    perl56delta         
    perl5005delta       
    perl5004delta       

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

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