[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';
}

use strict;

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