[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';
}	# glob() below requires File::Glob


#
# 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: $!";
	$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;
	}
	my @args;
	if (/^\s*(#|$)/) {
	    @args = $_;
	}
	else {
	    @args = split /\s*\|\s*/, $_;
	}
	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 $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;

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

my $file;
for $file (glob('*.c'), glob('*.h')) {
    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";

walk_table {	# load documented functions into approriate 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};
	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 $docref and @$docref;
	}
    }
    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";
}

print DOC <<'_EOB_';
=head1 NAME

perlapi - autogenerated documentation for the perl public API

=head1 DESCRIPTION

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";
    for my $key (sort { uc($a) cmp uc($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_


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";
print GUTS <<'END';
=head1 NAME

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

=head1 DESCRIPTION

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

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';
36bb303b	9	} # glob() below requires File::Glob
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: $!";
	36	$F = \*F;
	37	}
	38	print $F $leader if $leader;
	39	seek IN, 0, 0; # so we may restart
	40	while (<IN>) {
	41	chomp;
	42	next if /^:/;
78c9d763	43	while (s\|\\\s*$\|\|) {
94bdecf9	44	$_ .= <IN>;
	45	chomp;
	46	}
	47	my @args;
	48	if (/^\s*(#\|$)/) {
	49	@args = $_;
	50	}
	51	else {
	52	@args = split /\s\\|\s/, $_;
	53	}
	54	print $F $function->(@args);
	55	}
	56	print $F $trailer if $trailer;
36bb303b	57	unless (ref $filename) {
	58	close $F or die "Error closing $filename: $!";
	59	}
94bdecf9	60	}
	61
	62	my %apidocs;
	63	my %gutsdocs;
	64	my %docfuncs;
	65
	66	my $curheader = "Unknown section";
	67
	68	sub autodoc ($$) { # parse a file and extract documentation info
	69	my($fh,$file) = @_;
	70	my($in, $doc, $line);
	71	FUNC:
	72	while (defined($in = <$fh>)) {
	73	if ($in=~ /^=head1 (.*)/) {
	74	$curheader = $1;
	75	next FUNC;
	76	}
	77	$line++;
78c9d763	78	if ($in =~ /^=for\s+apidoc\s+(.?)\s\n/) {
94bdecf9	79	my $proto = $1;
	80	$proto = "\|\|$proto" unless $proto =~ /\\|/;
	81	my($flags, $ret, $name, @args) = split /\\|/, $proto;
	82	my $docs = "";
	83	DOC:
	84	while (defined($doc = <$fh>)) {
94bdecf9	85	$line++;
	86	last DOC if $doc =~ /^=\w+/;
	87	if ($doc =~ m:^\*/$:) {
	88	warn "=cut missing? $file:$line:$doc";;
	89	last DOC;
	90	}
	91	$docs .= $doc;
	92	}
	93	$docs = "\n$docs" if $docs and $docs !~ /^\n/;
	94	if ($flags =~ /m/) {
	95	if ($flags =~ /A/) {
	96	$apidocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
	97	}
	98	else {
	99	$gutsdocs{$curheader}{$name} = [$flags, $docs, $ret, $file, @args];
	100	}
	101	}
	102	else {
	103	$docfuncs{$name} = [$flags, $docs, $ret, $file, $curheader, @args];
	104	}
	105	if (defined $doc) {
e509e693	106	if ($doc =~ /^=(?:for\|head)/) {
94bdecf9	107	$in = $doc;
	108	redo FUNC;
	109	}
	110	} else {
	111	warn "$file:$line:$in";
	112	}
	113	}
	114	}
	115	}
	116
	117	sub docout ($$$) { # output the docs for one function
	118	my($fh, $name, $docref) = @_;
	119	my($flags, $docs, $ret, $file, @args) = @$docref;
	120
	121	$docs .= "NOTE: this function is experimental and may change or be
	122	removed without notice.\n\n" if $flags =~ /x/;
	123	$docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
	124	if $flags =~ /p/;
	125
	126	print $fh "=item $name\n$docs";
	127
	128	if ($flags =~ /U/) { # no usage
	129	# nothing
	130	} elsif ($flags =~ /s/) { # semicolon ("dTHR;")
	131	print $fh "\t\t$name;\n\n";
	132	} elsif ($flags =~ /n/) { # no args
	133	print $fh "\t$ret\t$name\n\n";
	134	} else { # full usage
	135	print $fh "\t$ret\t$name";
	136	print $fh "(" . join(", ", @args) . ")";
	137	print $fh "\n\n";
	138	}
	139	print $fh "=for hackers\nFound in file $file\n\n";
	140	}
	141
	142	my $file;
	143	for $file (glob('.c'), glob('.h')) {
	144	open F, "< $file" or die "Cannot open $file for docs: $!\n";
	145	$curheader = "Functions in file $file\n";
	146	autodoc(\*F,$file);
	147	close F or die "Error closing $file: $!\n";
	148	}
	149
36bb303b	150	safer_unlink "pod/perlapi.pod";
94bdecf9	151	open (DOC, ">pod/perlapi.pod") or
	152	die "Can't create pod/perlapi.pod: $!\n";
	153
	154	walk_table { # load documented functions into approriate hash
	155	if (@_ > 1) {
	156	my($flags, $retval, $func, @args) = @_;
	157	return "" unless $flags =~ /d/;
	158	$func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl
	159	$retval =~ s/\t//;
78c9d763	160	my $docref = delete $docfuncs{$func};
	161	if ($docref and @$docref) {
	162	if ($flags =~ /A/) {
	163	$docref->[0].="x" if $flags =~ /M/;
	164	$apidocs{$docref->[4]}{$func} =
	165	[$docref->[0] . 'A', $docref->[1], $retval,
	166	$docref->[3], @args];
	167	} else {
	168	$gutsdocs{$docref->[4]}{$func} =
	169	[$docref->[0], $docref->[1], $retval, $docref->[3], @args];
	170	}
	171	}
	172	else {
94bdecf9	173	warn "no docs for $func\n" unless $docref and @$docref;
94bdecf9	174	}
	175	}
	176	return "";
	177	} \*DOC;
	178
	179	for (sort keys %docfuncs) {
	180	# Have you used a full for apidoc or just a func name?
	181	# Have you used Ap instead of Am in the for apidoc?
	182	warn "Unable to place $_!\n";
	183	}
	184
	185	print DOC <<'_EOB_';
	186	=head1 NAME
	187
	188	perlapi - autogenerated documentation for the perl public API
	189
	190	=head1 DESCRIPTION
	191
	192	This file contains the documentation of the perl public API generated by
	193	embed.pl, specifically a listing of functions, macros, flags, and variables
	194	that may be used by extension writers. The interfaces of any functions that
	195	are not listed here are subject to change without notice. For this reason,
	196	blindly using functions listed in proto.h is to be avoided when writing
	197	extensions.
	198
	199	Note that all Perl API global variables must be referenced with the C<PL_>
	200	prefix. Some macros are provided for compatibility with the older,
	201	unadorned names, but this support may be disabled in a future release.
	202
	203	The listing is alphabetical, case insensitive.
	204
	205	_EOB_
	206
	207	my $key;
6a477168	208	# case insensitive sort, with fallback for determinacy
6a477168	209	for $key (sort { uc($a) cmp uc($b) \|\| $a cmp $b } keys %apidocs) {
94bdecf9	210	my $section = $apidocs{$key};
	211	print DOC "\n=head1 $key\n\n=over 8\n\n";
	212	for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
	213	docout(\*DOC, $key, $section->{$key});
	214	}
	215	print DOC "\n=back\n";
	216	}
	217
	218	print DOC <<'_EOE_';
	219
	220	=head1 AUTHORS
	221
	222	Until May 1997, this document was maintained by Jeff Okamoto
	223	<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
	224
	225	With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
	226	Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
	227	Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
	228	Stephen McCamant, and Gurusamy Sarathy.
	229
	230	API Listing originally by Dean Roehrich <roehrich@cray.com>.
	231
	232	Updated to be autogenerated from comments in the source by Benjamin Stuhl.
	233
	234	=head1 SEE ALSO
	235
	236	perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
	237
	238	_EOE_
	239
	240
36bb303b	241	close(DOC) or die "Error closing pod/perlapi.pod: $!";
94bdecf9	242
36bb303b	243	safer_unlink "pod/perlintern.pod";
94bdecf9	244	open(GUTS, ">pod/perlintern.pod") or
	245	die "Unable to create pod/perlintern.pod: $!\n";
	246	print GUTS <<'END';
	247	=head1 NAME
	248
	249	perlintern - autogenerated documentation of purely B<internal>
	250	Perl functions
	251
	252	=head1 DESCRIPTION
	253
	254	This file is the autogenerated documentation of functions in the
	255	Perl interpreter that are documented using Perl's internal documentation
	256	format but are not marked as part of the Perl API. In other words,
	257	B<they are not for use in extensions>!
	258
	259	END
	260
	261	for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
	262	my $section = $gutsdocs{$key};
	263	print GUTS "\n=head1 $key\n\n=over 8\n\n";
	264	for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
	265	docout(\*GUTS, $key, $section->{$key});
	266	}
	267	print GUTS "\n=back\n";
	268	}
	269
	270	print GUTS <<'END';
	271
	272	=head1 AUTHORS
	273
	274	The autodocumentation system was originally added to the Perl core by
	275	Benjamin Stuhl. Documentation is by whoever was kind enough to
	276	document their functions.
	277
	278	=head1 SEE ALSO
	279
	280	perlguts(1), perlapi(1)
	281
	282	END
	283
36bb303b	284	close GUTS or die "Error closing pod/perlintern.pod: $!";