[p5sagit/p5-mst-13.2.git] / autodoc.pl

#!/usr/bin/perl -w

require 5.003;	# keep this compatible, an old perl is all we may have before
                # we build the new one

BEGIN {
  push @INC, 'lib';
  require 'regen_lib.pl';
}


#
# See database of global and static function prototypes in embed.fnc
# This is used to generate prototype headers under various configurations,
# export symbols lists for different platforms, and macros to provide an
# implicit interpreter context argument.
#

open IN, "embed.fnc" or die $!;

# walk table providing an array of components in each line to
# subroutine, printing the result
sub walk_table (&@) {
    my $function = shift;
    my $filename = shift || '-';
    my $leader = shift;
    my $trailer = shift;
    my $F;
    local *F;
    if (ref $filename) {	# filehandle
	$F = $filename;
    }
    else {
	safer_unlink $filename;
	open F, ">$filename" or die "Can't open $filename: $!";
	binmode F;
	$F = \*F;
    }
    print $F $leader if $leader;
    seek IN, 0, 0;		# so we may restart
    while (<IN>) {
	chomp;
	next if /^:/;
	while (s|\\\s*$||) {
	    $_ .= <IN>;
	    chomp;
	}
	s/\s+$//;
	my @args;
	if (/^\s*(#|$)/) {
	    @args = $_;
	}
	else {
	    @args = split /\s*\|\s*/, $_;
	}
	s/\b(NN|NULLOK)\b\s+//g for @args;
	print $F $function->(@args);
    }
    print $F $trailer if $trailer;
    unless (ref $filename) {
	close $F or die "Error closing $filename: $!";
    }
}

my %apidocs;
my %gutsdocs;
my %docfuncs;
my %seenfuncs;

my $curheader = "Unknown section";

sub autodoc ($$) { # parse a file and extract documentation info
    my($fh,$file) = @_;
    my($in, $doc, $line);
FUNC:
    while (defined($in = <$fh>)) {
        if ($in=~ /^=head1 (.*)/) {
            $curheader = $1;
            next FUNC;
        }
	$line++;
	if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
	    my $proto = $1;
	    $proto = "||$proto" unless $proto =~ /\|/;
	    my($flags, $ret, $name, @args) = split /\|/, $proto;
	    my $docs = "";
DOC:
	    while (defined($doc = <$fh>)) {
		$line++;
		last DOC if $doc =~ /^=\w+/;
		if ($doc =~ m:^\*/$:) {
		    warn "=cut missing? $file:$line:$doc";;
		    last DOC;
		}
		$docs .= $doc;
	    }
	    $docs = "\n$docs" if $docs and $docs !~ /^\n/;
	    if ($flags =~ /m/) {
		if ($flags =~ /A/) {
		    $apidocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
		}
		else {
		    $gutsdocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
		}
	    }
	    else {
		$docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args];
	    }
	    if (defined $doc) {
		if ($doc =~ /^=(?:for|head)/) {
		    $in = $doc;
		    redo FUNC;
		}
	    } else {
		warn "$file:$line:$in";
	    }
	}
    }
}

sub docout ($$$) { # output the docs for one function
    my($fh, $name, $docref) = @_;
    my($flags, $docs, $ret, $file, @args) = @$docref;
    $name =~ s/\s*$//;

    $docs .= "NOTE: this function is experimental and may change or be
removed without notice.\n\n" if $flags =~ /x/;
    $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
	if $flags =~ /p/;

    print $fh "=item $name\nX<$name>\n$docs";

    if ($flags =~ /U/) { # no usage
	# nothing
    } elsif ($flags =~ /s/) { # semicolon ("dTHR;")
	print $fh "\t\t$name;\n\n";
    } elsif ($flags =~ /n/) { # no args
	print $fh "\t$ret\t$name\n\n";
    } else { # full usage
	print $fh "\t$ret\t$name";
	print $fh "(" . join(", ", @args) . ")";
	print $fh "\n\n";
    }
    print $fh "=for hackers\nFound in file $file\n\n";
}

sub readonly_header (*) {
    my $fh = shift;
    print $fh <<"_EOH_";
-*- buffer-read-only: t -*-

!!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
This file is built by $0 extracting documentation from the C source
files.

_EOH_
}

sub readonly_footer (*) {
    my $fh = shift;
    print $fh <<'_EOF_';
=cut

 ex: set ro:
_EOF_
}

my $file;
# glob() picks up docs from extra .c or .h files that may be in unclean
# development trees.
my $MANIFEST = do {
  local ($/, *FH);
  open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
  <FH>;
};

for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
    open F, "< $file" or die "Cannot open $file for docs: $!\n";
    $curheader = "Functions in file $file\n";
    autodoc(\*F,$file);
    close F or die "Error closing $file: $!\n";
}

safer_unlink "pod/perlapi.pod";
open (DOC, ">pod/perlapi.pod") or
	die "Can't create pod/perlapi.pod: $!\n";
binmode DOC;

walk_table {	# load documented functions into appropriate hash
    if (@_ > 1) {
	my($flags, $retval, $func, @args) = @_;
	return "" unless $flags =~ /d/;
	$func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl
	$retval =~ s/\t//;
	my $docref = delete $docfuncs{$func};
	$seenfuncs{$func} = 1;
	if ($docref and @$docref) {
	    if ($flags =~ /A/) {
		$docref->[0].="x" if $flags =~ /M/;
		$apidocs{$docref->[4]}{$func} =
		    [$docref->[0] . 'A', $docref->[1], $retval, $docref->[3],
			@args];
	    } else {
		$gutsdocs{$docref->[4]}{$func} =
		    [$docref->[0], $docref->[1], $retval, $docref->[3], @args];
	    }
	}
	else {
	    warn "no docs for $func\n" unless $seenfuncs{$func};
	}
    }
    return "";
} \*DOC;

for (sort keys %docfuncs) {
    # Have you used a full for apidoc or just a func name?
    # Have you used Ap instead of Am in the for apidoc?
    warn "Unable to place $_!\n";
}

readonly_header(DOC);

print DOC <<'_EOB_';
=head1 NAME

perlapi - autogenerated documentation for the perl public API

=head1 DESCRIPTION
X<Perl API> X<API> X<api>

This file contains the documentation of the perl public API generated by
embed.pl, specifically a listing of functions, macros, flags, and variables
that may be used by extension writers.  The interfaces of any functions that
are not listed here are subject to change without notice.  For this reason,
blindly using functions listed in proto.h is to be avoided when writing
extensions.

Note that all Perl API global variables must be referenced with the C<PL_>
prefix.  Some macros are provided for compatibility with the older,
unadorned names, but this support may be disabled in a future release.

The listing is alphabetical, case insensitive.

_EOB_

my $key;
# case insensitive sort, with fallback for determinacy
for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %apidocs) {
    my $section = $apidocs{$key}; 
    print DOC "\n=head1 $key\n\n=over 8\n\n";
    # Again, fallback for determinacy
    for my $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$section) {
        docout(\*DOC, $key, $section->{$key});
    }
    print DOC "\n=back\n";
}

print DOC <<'_EOE_';

=head1 AUTHORS

Until May 1997, this document was maintained by Jeff Okamoto
<okamoto@corp.hp.com>.  It is now maintained as part of Perl itself.

With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
Stephen McCamant, and Gurusamy Sarathy.

API Listing originally by Dean Roehrich <roehrich@cray.com>.

Updated to be autogenerated from comments in the source by Benjamin Stuhl.

=head1 SEE ALSO

perlguts(1), perlxs(1), perlxstut(1), perlintern(1)

_EOE_

readonly_footer(DOC);

close(DOC) or die "Error closing pod/perlapi.pod: $!";

safer_unlink "pod/perlintern.pod";
open(GUTS, ">pod/perlintern.pod") or
		die "Unable to create pod/perlintern.pod: $!\n";
binmode GUTS;
readonly_header(GUTS);
print GUTS <<'END';
=head1 NAME

perlintern - autogenerated documentation of purely B<internal>
		 Perl functions

=head1 DESCRIPTION
X<internal Perl functions> X<interpreter functions>

This file is the autogenerated documentation of functions in the
Perl interpreter that are documented using Perl's internal documentation
format but are not marked as part of the Perl API. In other words,
B<they are not for use in extensions>!

END

for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
    my $section = $gutsdocs{$key}; 
    print GUTS "\n=head1 $key\n\n=over 8\n\n";
    for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
        docout(\*GUTS, $key, $section->{$key});
    }
    print GUTS "\n=back\n";
}

print GUTS <<'END';

=head1 AUTHORS

The autodocumentation system was originally added to the Perl core by
Benjamin Stuhl. Documentation is by whoever was kind enough to
document their functions.

=head1 SEE ALSO

perlguts(1), perlapi(1)

END
readonly_footer(GUTS);

close GUTS or die "Error closing pod/perlintern.pod: $!";
Commit	Line	Data
94bdecf9	1	#!/usr/bin/perl -w
	2
	3	require 5.003; # keep this compatible, an old perl is all we may have before
	4	# we build the new one
	5
36bb303b	6	BEGIN {
36bb303b	7	push @INC, 'lib';
9ad884cb	8	require 'regen_lib.pl';
69e39a9a	9	}
a64c954a	10
a64c954a	11
94bdecf9	12	#
346f75ff	13	# See database of global and static function prototypes in embed.fnc
94bdecf9	14	# This is used to generate prototype headers under various configurations,
	15	# export symbols lists for different platforms, and macros to provide an
	16	# implicit interpreter context argument.
	17	#
	18
	19	open IN, "embed.fnc" or die $!;
	20
	21	# walk table providing an array of components in each line to
	22	# subroutine, printing the result
	23	sub walk_table (&@) {
	24	my $function = shift;
	25	my $filename = shift \|\| '-';
	26	my $leader = shift;
	27	my $trailer = shift;
	28	my $F;
	29	local *F;
	30	if (ref $filename) { # filehandle
	31	$F = $filename;
	32	}
	33	else {
36bb303b	34	safer_unlink $filename;
94bdecf9	35	open F, ">$filename" or die "Can't open $filename: $!";
c333cfe7	36	binmode F;
94bdecf9	37	$F = \*F;
	38	}
	39	print $F $leader if $leader;
	40	seek IN, 0, 0; # so we may restart
	41	while (<IN>) {
	42	chomp;
	43	next if /^:/;
78c9d763	44	while (s\|\\\s*$\|\|) {
94bdecf9	45	$_ .= <IN>;
	46	chomp;
	47	}
23f1b5c3	48	s/\s+$//;
94bdecf9	49	my @args;
	50	if (/^\s*(#\|$)/) {
	51	@args = $_;
	52	}
	53	else {
	54	@args = split /\s\\|\s/, $_;
	55	}
1b6737cc	56	s/\b(NN\|NULLOK)\b\s+//g for @args;
94bdecf9	57	print $F $function->(@args);
	58	}
	59	print $F $trailer if $trailer;
36bb303b	60	unless (ref $filename) {
	61	close $F or die "Error closing $filename: $!";
	62	}
94bdecf9	63	}
	64
	65	my %apidocs;
	66	my %gutsdocs;
	67	my %docfuncs;
7eb550cf	68	my %seenfuncs;
94bdecf9	69
	70	my $curheader = "Unknown section";
	71
	72	sub autodoc ($$) { # parse a file and extract documentation info
	73	my($fh,$file) = @_;
	74	my($in, $doc, $line);
	75	FUNC:
	76	while (defined($in = <$fh>)) {
	77	if ($in=~ /^=head1 (.*)/) {
	78	$curheader = $1;
	79	next FUNC;
	80	}
	81	$line++;
78c9d763	82	if ($in =~ /^=for\s+apidoc\s+(.?)\s\n/) {
94bdecf9	83	my $proto = $1;
	84	$proto = "\|\|$proto" unless $proto =~ /\\|/;
	85	my($flags, $ret, $name, @args) = split /\\|/, $proto;
	86	my $docs = "";
	87	DOC:
	88	while (defined($doc = <$fh>)) {
94bdecf9	89	$line++;
	90	last DOC if $doc =~ /^=\w+/;
	91	if ($doc =~ m:^\*/$:) {
	92	warn "=cut missing? $file:$line:$doc";;
	93	last DOC;
	94	}
	95	$docs .= $doc;
	96	}
	97	$docs = "\n$docs" if $docs and $docs !~ /^\n/;
	98	if ($flags =~ /m/) {
	99	if ($flags =~ /A/) {
	100	$apidocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
	101	}
	102	else {
	103	$gutsdocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
	104	}
	105	}
	106	else {
	107	$docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args];
	108	}
	109	if (defined $doc) {
e509e693	110	if ($doc =~ /^=(?:for\|head)/) {
94bdecf9	111	$in = $doc;
	112	redo FUNC;
	113	}
	114	} else {
	115	warn "$file:$line:$in";
	116	}
	117	}
	118	}
	119	}
	120
	121	sub docout ($$$) { # output the docs for one function
	122	my($fh, $name, $docref) = @_;
	123	my($flags, $docs, $ret, $file, @args) = @$docref;
d8c40edc	124	$name =~ s/\s*$//;
94bdecf9	125
	126	$docs .= "NOTE: this function is experimental and may change or be
	127	removed without notice.\n\n" if $flags =~ /x/;
	128	$docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
	129	if $flags =~ /p/;
	130
d8c40edc	131	print $fh "=item $name\nX<$name>\n$docs";
94bdecf9	132
	133	if ($flags =~ /U/) { # no usage
	134	# nothing
	135	} elsif ($flags =~ /s/) { # semicolon ("dTHR;")
	136	print $fh "\t\t$name;\n\n";
	137	} elsif ($flags =~ /n/) { # no args
	138	print $fh "\t$ret\t$name\n\n";
	139	} else { # full usage
	140	print $fh "\t$ret\t$name";
	141	print $fh "(" . join(", ", @args) . ")";
	142	print $fh "\n\n";
	143	}
	144	print $fh "=for hackers\nFound in file $file\n\n";
	145	}
	146
e0492643	147	sub readonly_header (*) {
	148	my $fh = shift;
	149	print $fh <<"_EOH_";
	150	-- buffer-read-only: t --
	151
	152	!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
	153	This file is built by $0 extracting documentation from the C source
	154	files.
	155
	156	_EOH_
	157	}
	158
	159	sub readonly_footer (*) {
	160	my $fh = shift;
	161	print $fh <<'_EOF_';
	162	=cut
	163
3f98fbb3	164	ex: set ro:
e0492643	165	_EOF_
	166	}
	167
94bdecf9	168	my $file;
69e39a9a	169	# glob() picks up docs from extra .c or .h files that may be in unclean
	170	# development trees.
	171	my $MANIFEST = do {
	172	local ($/, *FH);
	173	open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
	174	<FH>;
	175	};
	176
	177	for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
94bdecf9	178	open F, "< $file" or die "Cannot open $file for docs: $!\n";
	179	$curheader = "Functions in file $file\n";
	180	autodoc(\*F,$file);
	181	close F or die "Error closing $file: $!\n";
	182	}
	183
36bb303b	184	safer_unlink "pod/perlapi.pod";
94bdecf9	185	open (DOC, ">pod/perlapi.pod") or
94bdecf9	186	die "Can't create pod/perlapi.pod: $!\n";
c333cfe7	187	binmode DOC;
94bdecf9	188
7eb550cf	189	walk_table { # load documented functions into appropriate hash
94bdecf9	190	if (@_ > 1) {
	191	my($flags, $retval, $func, @args) = @_;
	192	return "" unless $flags =~ /d/;
	193	$func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl
	194	$retval =~ s/\t//;
78c9d763	195	my $docref = delete $docfuncs{$func};
7eb550cf	196	$seenfuncs{$func} = 1;
78c9d763	197	if ($docref and @$docref) {
	198	if ($flags =~ /A/) {
	199	$docref->[0].="x" if $flags =~ /M/;
7eb550cf	200	$apidocs{$docref->[4]}{$func} =
	201	[$docref->[0] . 'A', $docref->[1], $retval, $docref->[3],
	202	@args];
78c9d763	203	} else {
7eb550cf	204	$gutsdocs{$docref->[4]}{$func} =
78c9d763	205	[$docref->[0], $docref->[1], $retval, $docref->[3], @args];
	206	}
	207	}
	208	else {
7eb550cf	209	warn "no docs for $func\n" unless $seenfuncs{$func};
94bdecf9	210	}
	211	}
	212	return "";
	213	} \*DOC;
	214
	215	for (sort keys %docfuncs) {
	216	# Have you used a full for apidoc or just a func name?
	217	# Have you used Ap instead of Am in the for apidoc?
	218	warn "Unable to place $_!\n";
	219	}
	220
e0492643	221	readonly_header(DOC);
e0492643	222
94bdecf9	223	print DOC <<'_EOB_';
	224	=head1 NAME
	225
	226	perlapi - autogenerated documentation for the perl public API
	227
	228	=head1 DESCRIPTION
d8c40edc	229	X<Perl API> X<API> X<api>
94bdecf9	230
	231	This file contains the documentation of the perl public API generated by
	232	embed.pl, specifically a listing of functions, macros, flags, and variables
	233	that may be used by extension writers. The interfaces of any functions that
	234	are not listed here are subject to change without notice. For this reason,
	235	blindly using functions listed in proto.h is to be avoided when writing
	236	extensions.
	237
	238	Note that all Perl API global variables must be referenced with the C<PL_>
	239	prefix. Some macros are provided for compatibility with the older,
	240	unadorned names, but this support may be disabled in a future release.
	241
	242	The listing is alphabetical, case insensitive.
	243
	244	_EOB_
	245
	246	my $key;
6a477168	247	# case insensitive sort, with fallback for determinacy
6a477168	248	for $key (sort { uc($a) cmp uc($b) \|\| $a cmp $b } keys %apidocs) {
94bdecf9	249	my $section = $apidocs{$key};
94bdecf9	250	print DOC "\n=head1 $key\n\n=over 8\n\n";
22469dce	251	# Again, fallback for determinacy
22469dce	252	for my $key (sort { uc($a) cmp uc($b) \|\| $a cmp $b } keys %$section) {
94bdecf9	253	docout(\*DOC, $key, $section->{$key});
	254	}
	255	print DOC "\n=back\n";
	256	}
	257
	258	print DOC <<'_EOE_';
	259
	260	=head1 AUTHORS
	261
	262	Until May 1997, this document was maintained by Jeff Okamoto
	263	<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
	264
	265	With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
	266	Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
	267	Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
	268	Stephen McCamant, and Gurusamy Sarathy.
	269
	270	API Listing originally by Dean Roehrich <roehrich@cray.com>.
	271
	272	Updated to be autogenerated from comments in the source by Benjamin Stuhl.
	273
	274	=head1 SEE ALSO
	275
	276	perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
	277
	278	_EOE_
	279
e0492643	280	readonly_footer(DOC);
94bdecf9	281
36bb303b	282	close(DOC) or die "Error closing pod/perlapi.pod: $!";
94bdecf9	283
36bb303b	284	safer_unlink "pod/perlintern.pod";
94bdecf9	285	open(GUTS, ">pod/perlintern.pod") or
94bdecf9	286	die "Unable to create pod/perlintern.pod: $!\n";
c333cfe7	287	binmode GUTS;
e0492643	288	readonly_header(GUTS);
94bdecf9	289	print GUTS <<'END';
	290	=head1 NAME
	291
	292	perlintern - autogenerated documentation of purely B<internal>
	293	Perl functions
	294
	295	=head1 DESCRIPTION
d8c40edc	296	X<internal Perl functions> X<interpreter functions>
94bdecf9	297
	298	This file is the autogenerated documentation of functions in the
	299	Perl interpreter that are documented using Perl's internal documentation
	300	format but are not marked as part of the Perl API. In other words,
	301	B<they are not for use in extensions>!
	302
	303	END
	304
	305	for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
	306	my $section = $gutsdocs{$key};
	307	print GUTS "\n=head1 $key\n\n=over 8\n\n";
	308	for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
	309	docout(\*GUTS, $key, $section->{$key});
	310	}
	311	print GUTS "\n=back\n";
	312	}
	313
	314	print GUTS <<'END';
	315
	316	=head1 AUTHORS
	317
	318	The autodocumentation system was originally added to the Perl core by
	319	Benjamin Stuhl. Documentation is by whoever was kind enough to
	320	document their functions.
	321
	322	=head1 SEE ALSO
	323
	324	perlguts(1), perlapi(1)
	325
	326	END
e0492643	327	readonly_footer(GUTS);
94bdecf9	328
36bb303b	329	close GUTS or die "Error closing pod/perlintern.pod: $!";