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

#!/usr/bin/perl -w

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