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

#!/usr/bin/perl -w
# 
# Unconditionally regenerate:
#
#    pod/perlintern.pod
#    pod/perlapi.pod
#
# from information stored in
#
#    embed.fnc
#    plus all the .c and .h files listed in MANIFEST
#
# Has an optional arg, which is the directory to chdir to before reading
# MANIFEST and *.[ch].
#
# This script is normally invoked as part of 'make all', but is also
# called from from regen.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.
#

my %docs;
my %funcflags;
my %macro = (
	     ax => 1,
	     items => 1,
	     ix => 1,
	     svtype => 1,
	    );
my %missing;

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 =~ /^#\s*define\s+([A-Za-z_][A-Za-z_0-9]+)\(/ &&
	    ($file ne 'embed.h' || $file ne 'proto.h')) {
	    $macro{$1} = $file;
	    next FUNC;
	}
        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/;

	    # Check the consistency of the flags
	    my ($embed_where, $inline_where);
	    my ($embed_may_change, $inline_may_change);

	    my $docref = delete $funcflags{$name};
	    if ($docref and %$docref) {
		$embed_where = $docref->{flags} =~ /A/ ? 'api' : 'guts';
		$embed_may_change = $docref->{flags} =~ /M/;
	    } else {
		$missing{$name} = $file;
	    }
	    if ($flags =~ /m/) {
		$inline_where = $flags =~ /A/ ? 'api' : 'guts';
		$inline_may_change = $flags =~ /x/;

		if (defined $embed_where && $inline_where ne $embed_where) {
		    warn "Function '$name' inconsistency: embed.fnc says $embed_where, Pod says $inline_where";
		}

		if (defined $embed_may_change
		    && $inline_may_change ne $embed_may_change) {
		    my $message = "Function '$name' inconsistency: ";
		    if ($embed_may_change) {
			$message .= "embed.fnc says 'may change', Pod does not";
		    } else {
			$message .= "Pod says 'may change', embed.fnc does not";
		    }
		    warn $message;
		}
	    } elsif (!defined $embed_where) {
		warn "Unable to place $name!\n";
		next;
	    } else {
		$inline_where = $embed_where;
		$flags .= 'x' if $embed_may_change;
		@args = @{$docref->{args}};
		$ret = $docref->{retval};
	    }

	    $docs{$inline_where}{$curheader}{$name}
		= [$flags, $docs, $ret, $file, @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 output {
    my ($podname, $header, $dochash, $footer) = @_;
    my $filename = "pod/$podname.pod";
    open my $fh, '>', $filename or die "Can't open $filename: $!";

    print $fh <<"_EOH_", $header;
-*- buffer-read-only: t -*-

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

_EOH_

    my $key;
    # case insensitive sort, with fallback for determinacy
    for $key (sort { uc($a) cmp uc($b) || $a cmp $b } keys %$dochash) {
	my $section = $dochash->{$key}; 
	print $fh "\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($fh, $key, $section->{$key});
	}
	print $fh "\n=back\n";
    }

    print $fh $footer, <<'_EOF_';
=cut

 ex: set ro:
_EOF_

    close $fh or die "Can't close $filename: $!";
}

if (@ARGV) {
    my $workdir = shift;
    chdir $workdir
        or die "Couldn't chdir to '$workdir': $!";
}

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

while (<IN>) {
    chomp;
    next if /^:/;
    while (s|\\\s*$||) {
	$_ .= <IN>;
	chomp;
    }
    s/\s+$//;
    next if /^\s*(#|$)/;

    my ($flags, $retval, $func, @args) = split /\s*\|\s*/, $_;

    next unless $func;

    s/\b(NN|NULLOK)\b\s+//g for @args;
    $func =~ s/\t//g; # clean up fields from embed.pl
    $retval =~ s/\t//;

    $funcflags{$func} = {
			 flags => $flags,
			 retval => $retval,
			 args => \@args,
			};
}

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";
}

for (sort keys %funcflags) {
    next unless $funcflags{$_}{flags} =~ /d/;
    warn "no docs for $_\n"
}

foreach (sort keys %missing) {
    next if $macro{$_};
    # Heuristics for known not-a-function macros:
    next if /^[A-Z]/;
    next if /^dj?[A-Z]/;

    warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc";
}

# walk table providing an array of components in each line to
# subroutine, printing the result

output('perlapi', <<'_EOB_', $docs{api}, <<'_EOE_');
=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.

Perl was originally written to handle US-ASCII only (that is characters
whose ordinal numbers are in the range 0 - 127).
And documentation and comments may still use the term ASCII, when
sometimes in fact the entire range from 0 - 255 is meant.

Note that Perl can be compiled and run under EBCDIC (See L<perlebcdic>)
or ASCII.  Most of the documentation (and even comments in the code)
ignore the EBCDIC possibility.  
For almost all purposes the differences are transparent.
As an example, under EBCDIC,
instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
whenever this documentation refers to C<utf8>
(and variants of that name, including in function names),
it also (essentially transparently) means C<UTF-EBCDIC>.
But the ordinals of characters differ between ASCII, EBCDIC, and
the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
than in UTF-8.

Also, on some EBCDIC machines, functions that are documented as operating on
US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all
256 characters in the EBCDIC range, not just the subset corresponding to
US-ASCII.

The listing below is alphabetical, case insensitive.

_EOB_

=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_

output('perlintern', <<'END', $docs{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

=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
Commit	Line	Data
94bdecf9	1	#!/usr/bin/perl -w
6294c161	2	#
	3	# Unconditionally regenerate:
	4	#
	5	# pod/perlintern.pod
	6	# pod/perlapi.pod
	7	#
	8	# from information stored in
	9	#
	10	# embed.fnc
	11	# plus all the .c and .h files listed in MANIFEST
	12	#
	13	# Has an optional arg, which is the directory to chdir to before reading
	14	# MANIFEST and *.[ch].
	15	#
	16	# This script is normally invoked as part of 'make all', but is also
	17	# called from from regen.pl.
94bdecf9	18
56a0c332	19	use strict;
a64c954a	20
94bdecf9	21	#
346f75ff	22	# See database of global and static function prototypes in embed.fnc
94bdecf9	23	# This is used to generate prototype headers under various configurations,
	24	# export symbols lists for different platforms, and macros to provide an
	25	# implicit interpreter context argument.
	26	#
	27
6a235718	28	my %docs;
5ce57792	29	my %funcflags;
	30	my %macro = (
	31	ax => 1,
	32	items => 1,
	33	ix => 1,
	34	svtype => 1,
	35	);
	36	my %missing;
94bdecf9	37
	38	my $curheader = "Unknown section";
	39
	40	sub autodoc ($$) { # parse a file and extract documentation info
	41	my($fh,$file) = @_;
	42	my($in, $doc, $line);
	43	FUNC:
	44	while (defined($in = <$fh>)) {
5ce57792	45	if ($in =~ /^#\s*define\s+([A-Za-z_][A-Za-z_0-9]+)\(/ &&
	46	($file ne 'embed.h' \|\| $file ne 'proto.h')) {
	47	$macro{$1} = $file;
	48	next FUNC;
	49	}
94bdecf9	50	if ($in=~ /^=head1 (.*)/) {
	51	$curheader = $1;
	52	next FUNC;
	53	}
	54	$line++;
78c9d763	55	if ($in =~ /^=for\s+apidoc\s+(.?)\s\n/) {
94bdecf9	56	my $proto = $1;
	57	$proto = "\|\|$proto" unless $proto =~ /\\|/;
	58	my($flags, $ret, $name, @args) = split /\\|/, $proto;
	59	my $docs = "";
	60	DOC:
	61	while (defined($doc = <$fh>)) {
94bdecf9	62	$line++;
	63	last DOC if $doc =~ /^=\w+/;
	64	if ($doc =~ m:^\*/$:) {
	65	warn "=cut missing? $file:$line:$doc";;
	66	last DOC;
	67	}
	68	$docs .= $doc;
	69	}
	70	$docs = "\n$docs" if $docs and $docs !~ /^\n/;
5ce57792	71
	72	# Check the consistency of the flags
	73	my ($embed_where, $inline_where);
	74	my ($embed_may_change, $inline_may_change);
	75
	76	my $docref = delete $funcflags{$name};
	77	if ($docref and %$docref) {
	78	$embed_where = $docref->{flags} =~ /A/ ? 'api' : 'guts';
	79	$embed_may_change = $docref->{flags} =~ /M/;
	80	} else {
	81	$missing{$name} = $file;
94bdecf9	82	}
5ce57792	83	if ($flags =~ /m/) {
	84	$inline_where = $flags =~ /A/ ? 'api' : 'guts';
	85	$inline_may_change = $flags =~ /x/;
	86
	87	if (defined $embed_where && $inline_where ne $embed_where) {
	88	warn "Function '$name' inconsistency: embed.fnc says $embed_where, Pod says $inline_where";
	89	}
	90
	91	if (defined $embed_may_change
	92	&& $inline_may_change ne $embed_may_change) {
	93	my $message = "Function '$name' inconsistency: ";
	94	if ($embed_may_change) {
	95	$message .= "embed.fnc says 'may change', Pod does not";
	96	} else {
	97	$message .= "Pod says 'may change', embed.fnc does not";
	98	}
	99	warn $message;
	100	}
	101	} elsif (!defined $embed_where) {
	102	warn "Unable to place $name!\n";
	103	next;
	104	} else {
	105	$inline_where = $embed_where;
	106	$flags .= 'x' if $embed_may_change;
	107	@args = @{$docref->{args}};
	108	$ret = $docref->{retval};
94bdecf9	109	}
5ce57792	110
	111	$docs{$inline_where}{$curheader}{$name}
	112	= [$flags, $docs, $ret, $file, @args];
	113
94bdecf9	114	if (defined $doc) {
e509e693	115	if ($doc =~ /^=(?:for\|head)/) {
94bdecf9	116	$in = $doc;
	117	redo FUNC;
	118	}
	119	} else {
	120	warn "$file:$line:$in";
	121	}
	122	}
	123	}
	124	}
	125
	126	sub docout ($$$) { # output the docs for one function
	127	my($fh, $name, $docref) = @_;
	128	my($flags, $docs, $ret, $file, @args) = @$docref;
d8c40edc	129	$name =~ s/\s*$//;
94bdecf9	130
	131	$docs .= "NOTE: this function is experimental and may change or be
	132	removed without notice.\n\n" if $flags =~ /x/;
	133	$docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
	134	if $flags =~ /p/;
	135
d8c40edc	136	print $fh "=item $name\nX<$name>\n$docs";
94bdecf9	137
	138	if ($flags =~ /U/) { # no usage
	139	# nothing
	140	} elsif ($flags =~ /s/) { # semicolon ("dTHR;")
	141	print $fh "\t\t$name;\n\n";
	142	} elsif ($flags =~ /n/) { # no args
	143	print $fh "\t$ret\t$name\n\n";
	144	} else { # full usage
	145	print $fh "\t$ret\t$name";
	146	print $fh "(" . join(", ", @args) . ")";
	147	print $fh "\n\n";
	148	}
	149	print $fh "=for hackers\nFound in file $file\n\n";
	150	}
	151
7b73ff98	152	sub output {
	153	my ($podname, $header, $dochash, $footer) = @_;
	154	my $filename = "pod/$podname.pod";
	155	open my $fh, '>', $filename or die "Can't open $filename: $!";
	156
	157	print $fh <<"_EOH_", $header;
e0492643	158	-- buffer-read-only: t --
	159
	160	!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
	161	This file is built by $0 extracting documentation from the C source
	162	files.
	163
	164	_EOH_
e0492643	165
7b73ff98	166	my $key;
	167	# case insensitive sort, with fallback for determinacy
	168	for $key (sort { uc($a) cmp uc($b) \|\| $a cmp $b } keys %$dochash) {
	169	my $section = $dochash->{$key};
	170	print $fh "\n=head1 $key\n\n=over 8\n\n";
	171	# Again, fallback for determinacy
	172	for my $key (sort { uc($a) cmp uc($b) \|\| $a cmp $b } keys %$section) {
	173	docout($fh, $key, $section->{$key});
	174	}
	175	print $fh "\n=back\n";
	176	}
	177
	178	print $fh $footer, <<'_EOF_';
e0492643	179	=cut
e0492643	180
3f98fbb3	181	ex: set ro:
e0492643	182	_EOF_
7b73ff98	183
7b73ff98	184	close $fh or die "Can't close $filename: $!";
e0492643	185	}
e0492643	186
cd093254	187	if (@ARGV) {
	188	my $workdir = shift;
	189	chdir $workdir
	190	or die "Couldn't chdir to '$workdir': $!";
	191	}
	192
bc350081	193	open IN, "embed.fnc" or die $!;
bc350081	194
bc350081	195	while (<IN>) {
	196	chomp;
	197	next if /^:/;
	198	while (s\|\\\s*$\|\|) {
	199	$_ .= <IN>;
	200	chomp;
	201	}
	202	s/\s+$//;
	203	next if /^\s*(#\|$)/;
	204
	205	my ($flags, $retval, $func, @args) = split /\s\\|\s/, $_;
	206
bc350081	207	next unless $func;
	208
	209	s/\b(NN\|NULLOK)\b\s+//g for @args;
	210	$func =~ s/\t//g; # clean up fields from embed.pl
	211	$retval =~ s/\t//;
	212
5ce57792	213	$funcflags{$func} = {
	214	flags => $flags,
	215	retval => $retval,
	216	args => \@args,
	217	};
	218	}
	219
	220	my $file;
	221	# glob() picks up docs from extra .c or .h files that may be in unclean
	222	# development trees.
	223	my $MANIFEST = do {
	224	local ($/, *FH);
	225	open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
	226	<FH>;
	227	};
	228
	229	for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
	230	open F, "< $file" or die "Cannot open $file for docs: $!\n";
	231	$curheader = "Functions in file $file\n";
	232	autodoc(\*F,$file);
	233	close F or die "Error closing $file: $!\n";
	234	}
	235
	236	for (sort keys %funcflags) {
	237	next unless $funcflags{$_}{flags} =~ /d/;
	238	warn "no docs for $_\n"
bc350081	239	}
94bdecf9	240
5ce57792	241	foreach (sort keys %missing) {
	242	next if $macro{$_};
	243	# Heuristics for known not-a-function macros:
	244	next if /^[A-Z]/;
	245	next if /^dj?[A-Z]/;
	246
	247	warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc";
94bdecf9	248	}
94bdecf9	249
5ce57792	250	# walk table providing an array of components in each line to
	251	# subroutine, printing the result
	252
6a235718	253	output('perlapi', <<'_EOB_', $docs{api}, <<'_EOE_');
94bdecf9	254	=head1 NAME
	255
	256	perlapi - autogenerated documentation for the perl public API
	257
	258	=head1 DESCRIPTION
d8c40edc	259	X<Perl API> X<API> X<api>
94bdecf9	260
	261	This file contains the documentation of the perl public API generated by
	262	embed.pl, specifically a listing of functions, macros, flags, and variables
	263	that may be used by extension writers. The interfaces of any functions that
	264	are not listed here are subject to change without notice. For this reason,
	265	blindly using functions listed in proto.h is to be avoided when writing
	266	extensions.
	267
	268	Note that all Perl API global variables must be referenced with the C<PL_>
	269	prefix. Some macros are provided for compatibility with the older,
	270	unadorned names, but this support may be disabled in a future release.
	271
2bbc8d55	272	Perl was originally written to handle US-ASCII only (that is characters
	273	whose ordinal numbers are in the range 0 - 127).
	274	And documentation and comments may still use the term ASCII, when
	275	sometimes in fact the entire range from 0 - 255 is meant.
	276
	277	Note that Perl can be compiled and run under EBCDIC (See L<perlebcdic>)
	278	or ASCII. Most of the documentation (and even comments in the code)
	279	ignore the EBCDIC possibility.
	280	For almost all purposes the differences are transparent.
	281	As an example, under EBCDIC,
	282	instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
	283	whenever this documentation refers to C<utf8>
	284	(and variants of that name, including in function names),
	285	it also (essentially transparently) means C<UTF-EBCDIC>.
	286	But the ordinals of characters differ between ASCII, EBCDIC, and
	287	the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
	288	than in UTF-8.
	289
	290	Also, on some EBCDIC machines, functions that are documented as operating on
	291	US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all
	292	256 characters in the EBCDIC range, not just the subset corresponding to
	293	US-ASCII.
	294
	295	The listing below is alphabetical, case insensitive.
94bdecf9	296
	297	_EOB_
	298
94bdecf9	299	=head1 AUTHORS
	300
	301	Until May 1997, this document was maintained by Jeff Okamoto
	302	<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
	303
	304	With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
	305	Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
	306	Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
	307	Stephen McCamant, and Gurusamy Sarathy.
	308
	309	API Listing originally by Dean Roehrich <roehrich@cray.com>.
	310
	311	Updated to be autogenerated from comments in the source by Benjamin Stuhl.
	312
	313	=head1 SEE ALSO
	314
	315	perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
	316
	317	_EOE_
	318
6a235718	319	output('perlintern', <<'END', $docs{guts}, <<'END');
94bdecf9	320	=head1 NAME
	321
	322	perlintern - autogenerated documentation of purely B<internal>
	323	Perl functions
	324
	325	=head1 DESCRIPTION
d8c40edc	326	X<internal Perl functions> X<interpreter functions>
94bdecf9	327
	328	This file is the autogenerated documentation of functions in the
	329	Perl interpreter that are documented using Perl's internal documentation
	330	format but are not marked as part of the Perl API. In other words,
	331	B<they are not for use in extensions>!
	332
	333	END
	334
94bdecf9	335	=head1 AUTHORS
	336
	337	The autodocumentation system was originally added to the Perl core by
	338	Benjamin Stuhl. Documentation is by whoever was kind enough to
	339	document their functions.
	340
	341	=head1 SEE ALSO
	342
	343	perlguts(1), perlapi(1)
	344
	345	END