[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 %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 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': $!";
}

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

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

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

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 $flags =~ /d/;
    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//;

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

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

output('perlapi', <<'_EOB_', \%apidocs, <<'_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', \%gutsdocs, <<'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
94bdecf9	28	my %apidocs;
	29	my %gutsdocs;
	30	my %docfuncs;
7eb550cf	31	my %seenfuncs;
94bdecf9	32
	33	my $curheader = "Unknown section";
	34
	35	sub autodoc ($$) { # parse a file and extract documentation info
	36	my($fh,$file) = @_;
	37	my($in, $doc, $line);
	38	FUNC:
	39	while (defined($in = <$fh>)) {
	40	if ($in=~ /^=head1 (.*)/) {
	41	$curheader = $1;
	42	next FUNC;
	43	}
	44	$line++;
78c9d763	45	if ($in =~ /^=for\s+apidoc\s+(.?)\s\n/) {
94bdecf9	46	my $proto = $1;
	47	$proto = "\|\|$proto" unless $proto =~ /\\|/;
	48	my($flags, $ret, $name, @args) = split /\\|/, $proto;
	49	my $docs = "";
	50	DOC:
	51	while (defined($doc = <$fh>)) {
94bdecf9	52	$line++;
	53	last DOC if $doc =~ /^=\w+/;
	54	if ($doc =~ m:^\*/$:) {
	55	warn "=cut missing? $file:$line:$doc";;
	56	last DOC;
	57	}
	58	$docs .= $doc;
	59	}
	60	$docs = "\n$docs" if $docs and $docs !~ /^\n/;
	61	if ($flags =~ /m/) {
	62	if ($flags =~ /A/) {
	63	$apidocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
	64	}
	65	else {
	66	$gutsdocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
	67	}
	68	}
	69	else {
	70	$docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args];
	71	}
	72	if (defined $doc) {
e509e693	73	if ($doc =~ /^=(?:for\|head)/) {
94bdecf9	74	$in = $doc;
	75	redo FUNC;
	76	}
	77	} else {
	78	warn "$file:$line:$in";
	79	}
	80	}
	81	}
	82	}
	83
	84	sub docout ($$$) { # output the docs for one function
	85	my($fh, $name, $docref) = @_;
	86	my($flags, $docs, $ret, $file, @args) = @$docref;
d8c40edc	87	$name =~ s/\s*$//;
94bdecf9	88
	89	$docs .= "NOTE: this function is experimental and may change or be
	90	removed without notice.\n\n" if $flags =~ /x/;
	91	$docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
	92	if $flags =~ /p/;
	93
d8c40edc	94	print $fh "=item $name\nX<$name>\n$docs";
94bdecf9	95
	96	if ($flags =~ /U/) { # no usage
	97	# nothing
	98	} elsif ($flags =~ /s/) { # semicolon ("dTHR;")
	99	print $fh "\t\t$name;\n\n";
	100	} elsif ($flags =~ /n/) { # no args
	101	print $fh "\t$ret\t$name\n\n";
	102	} else { # full usage
	103	print $fh "\t$ret\t$name";
	104	print $fh "(" . join(", ", @args) . ")";
	105	print $fh "\n\n";
	106	}
	107	print $fh "=for hackers\nFound in file $file\n\n";
	108	}
	109
7b73ff98	110	sub output {
	111	my ($podname, $header, $dochash, $footer) = @_;
	112	my $filename = "pod/$podname.pod";
	113	open my $fh, '>', $filename or die "Can't open $filename: $!";
	114
	115	print $fh <<"_EOH_", $header;
e0492643	116	-- buffer-read-only: t --
	117
	118	!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
	119	This file is built by $0 extracting documentation from the C source
	120	files.
	121
	122	_EOH_
e0492643	123
7b73ff98	124	my $key;
	125	# case insensitive sort, with fallback for determinacy
	126	for $key (sort { uc($a) cmp uc($b) \|\| $a cmp $b } keys %$dochash) {
	127	my $section = $dochash->{$key};
	128	print $fh "\n=head1 $key\n\n=over 8\n\n";
	129	# Again, fallback for determinacy
	130	for my $key (sort { uc($a) cmp uc($b) \|\| $a cmp $b } keys %$section) {
	131	docout($fh, $key, $section->{$key});
	132	}
	133	print $fh "\n=back\n";
	134	}
	135
	136	print $fh $footer, <<'_EOF_';
e0492643	137	=cut
e0492643	138
3f98fbb3	139	ex: set ro:
e0492643	140	_EOF_
7b73ff98	141
7b73ff98	142	close $fh or die "Can't close $filename: $!";
e0492643	143	}
e0492643	144
cd093254	145	if (@ARGV) {
	146	my $workdir = shift;
	147	chdir $workdir
	148	or die "Couldn't chdir to '$workdir': $!";
	149	}
	150
94bdecf9	151	my $file;
69e39a9a	152	# glob() picks up docs from extra .c or .h files that may be in unclean
	153	# development trees.
	154	my $MANIFEST = do {
	155	local ($/, *FH);
	156	open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
	157	<FH>;
	158	};
	159
	160	for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
94bdecf9	161	open F, "< $file" or die "Cannot open $file for docs: $!\n";
	162	$curheader = "Functions in file $file\n";
	163	autodoc(\*F,$file);
	164	close F or die "Error closing $file: $!\n";
	165	}
	166
bc350081	167	open IN, "embed.fnc" or die $!;
	168
	169	# walk table providing an array of components in each line to
	170	# subroutine, printing the result
	171
	172	while (<IN>) {
	173	chomp;
	174	next if /^:/;
	175	while (s\|\\\s*$\|\|) {
	176	$_ .= <IN>;
	177	chomp;
	178	}
	179	s/\s+$//;
	180	next if /^\s*(#\|$)/;
	181
	182	my ($flags, $retval, $func, @args) = split /\s\\|\s/, $_;
	183
	184	next unless $flags =~ /d/;
	185	next unless $func;
	186
	187	s/\b(NN\|NULLOK)\b\s+//g for @args;
	188	$func =~ s/\t//g; # clean up fields from embed.pl
	189	$retval =~ s/\t//;
	190
	191	my $docref = delete $docfuncs{$func};
	192	$seenfuncs{$func} = 1;
	193	if ($docref and @$docref) {
	194	if ($flags =~ /A/) {
	195	$docref->[0].="x" if $flags =~ /M/;
	196	$apidocs{$docref->[4]}{$func} =
	197	[$docref->[0] . 'A', $docref->[1], $retval, $docref->[3],
	198	@args];
	199	} else {
	200	$gutsdocs{$docref->[4]}{$func} =
	201	[$docref->[0], $docref->[1], $retval, $docref->[3], @args];
94bdecf9	202	}
94bdecf9	203	}
bc350081	204	else {
	205	warn "no docs for $func\n" unless $seenfuncs{$func};
	206	}
	207	}
94bdecf9	208
	209	for (sort keys %docfuncs) {
	210	# Have you used a full for apidoc or just a func name?
	211	# Have you used Ap instead of Am in the for apidoc?
	212	warn "Unable to place $_!\n";
	213	}
	214
7b73ff98	215	output('perlapi', <<'_EOB_', \%apidocs, <<'_EOE_');
94bdecf9	216	=head1 NAME
	217
	218	perlapi - autogenerated documentation for the perl public API
	219
	220	=head1 DESCRIPTION
d8c40edc	221	X<Perl API> X<API> X<api>
94bdecf9	222
	223	This file contains the documentation of the perl public API generated by
	224	embed.pl, specifically a listing of functions, macros, flags, and variables
	225	that may be used by extension writers. The interfaces of any functions that
	226	are not listed here are subject to change without notice. For this reason,
	227	blindly using functions listed in proto.h is to be avoided when writing
	228	extensions.
	229
	230	Note that all Perl API global variables must be referenced with the C<PL_>
	231	prefix. Some macros are provided for compatibility with the older,
	232	unadorned names, but this support may be disabled in a future release.
	233
2bbc8d55	234	Perl was originally written to handle US-ASCII only (that is characters
	235	whose ordinal numbers are in the range 0 - 127).
	236	And documentation and comments may still use the term ASCII, when
	237	sometimes in fact the entire range from 0 - 255 is meant.
	238
	239	Note that Perl can be compiled and run under EBCDIC (See L<perlebcdic>)
	240	or ASCII. Most of the documentation (and even comments in the code)
	241	ignore the EBCDIC possibility.
	242	For almost all purposes the differences are transparent.
	243	As an example, under EBCDIC,
	244	instead of UTF-8, UTF-EBCDIC is used to encode Unicode strings, and so
	245	whenever this documentation refers to C<utf8>
	246	(and variants of that name, including in function names),
	247	it also (essentially transparently) means C<UTF-EBCDIC>.
	248	But the ordinals of characters differ between ASCII, EBCDIC, and
	249	the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
	250	than in UTF-8.
	251
	252	Also, on some EBCDIC machines, functions that are documented as operating on
	253	US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all
	254	256 characters in the EBCDIC range, not just the subset corresponding to
	255	US-ASCII.
	256
	257	The listing below is alphabetical, case insensitive.
94bdecf9	258
	259	_EOB_
	260
94bdecf9	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
7b73ff98	281	output('perlintern', <<'END', \%gutsdocs, <<'END');
94bdecf9	282	=head1 NAME
	283
	284	perlintern - autogenerated documentation of purely B<internal>
	285	Perl functions
	286
	287	=head1 DESCRIPTION
d8c40edc	288	X<internal Perl functions> X<interpreter functions>
94bdecf9	289
	290	This file is the autogenerated documentation of functions in the
	291	Perl interpreter that are documented using Perl's internal documentation
	292	format but are not marked as part of the Perl API. In other words,
	293	B<they are not for use in extensions>!
	294
	295	END
	296
94bdecf9	297	=head1 AUTHORS
	298
	299	The autodocumentation system was originally added to the Perl core by
	300	Benjamin Stuhl. Documentation is by whoever was kind enough to
	301	document their functions.
	302
	303	=head1 SEE ALSO
	304
	305	perlguts(1), perlapi(1)
	306
	307	END