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


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

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 JH	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 NC	6	BEGIN {
36bb303b NC	7	push @INC, 'lib';
9ad884cb	8	require 'regen_lib.pl';
69e39a9a	9	}
a64c954a IZ	10
a64c954a IZ	11
94bdecf9	12	#
346f75ff	13	# See database of global and static function prototypes in embed.fnc
94bdecf9 JH	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 JH	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 JH	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 NC	57	unless (ref $filename) {
	58	close $F or die "Error closing $filename: $!";
	59	}
94bdecf9 JH	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 JH	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 JH	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 JH	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;
69e39a9a NC	143	# glob() picks up docs from extra .c or .h files that may be in unclean
	144	# development trees.
	145	my $MANIFEST = do {
	146	local ($/, *FH);
	147	open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
	148	<FH>;
	149	};
	150
	151	for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
94bdecf9 JH	152	open F, "< $file" or die "Cannot open $file for docs: $!\n";
	153	$curheader = "Functions in file $file\n";
	154	autodoc(\*F,$file);
	155	close F or die "Error closing $file: $!\n";
	156	}
	157
36bb303b	158	safer_unlink "pod/perlapi.pod";
94bdecf9 JH	159	open (DOC, ">pod/perlapi.pod") or
	160	die "Can't create pod/perlapi.pod: $!\n";
	161
	162	walk_table { # load documented functions into approriate hash
	163	if (@_ > 1) {
	164	my($flags, $retval, $func, @args) = @_;
	165	return "" unless $flags =~ /d/;
	166	$func =~ s/\t//g; $flags =~ s/p//; # clean up fields from embed.pl
	167	$retval =~ s/\t//;
78c9d763 DM	168	my $docref = delete $docfuncs{$func};
	169	if ($docref and @$docref) {
	170	if ($flags =~ /A/) {
	171	$docref->[0].="x" if $flags =~ /M/;
	172	$apidocs{$docref->[4]}{$func} =
	173	[$docref->[0] . 'A', $docref->[1], $retval,
	174	$docref->[3], @args];
	175	} else {
	176	$gutsdocs{$docref->[4]}{$func} =
	177	[$docref->[0], $docref->[1], $retval, $docref->[3], @args];
	178	}
	179	}
	180	else {
94bdecf9	181	warn "no docs for $func\n" unless $docref and @$docref;
94bdecf9 JH	182	}
	183	}
	184	return "";
	185	} \*DOC;
	186
	187	for (sort keys %docfuncs) {
	188	# Have you used a full for apidoc or just a func name?
	189	# Have you used Ap instead of Am in the for apidoc?
	190	warn "Unable to place $_!\n";
	191	}
	192
	193	print DOC <<'_EOB_';
	194	=head1 NAME
	195
	196	perlapi - autogenerated documentation for the perl public API
	197
	198	=head1 DESCRIPTION
	199
	200	This file contains the documentation of the perl public API generated by
	201	embed.pl, specifically a listing of functions, macros, flags, and variables
	202	that may be used by extension writers. The interfaces of any functions that
	203	are not listed here are subject to change without notice. For this reason,
	204	blindly using functions listed in proto.h is to be avoided when writing
	205	extensions.
	206
	207	Note that all Perl API global variables must be referenced with the C<PL_>
	208	prefix. Some macros are provided for compatibility with the older,
	209	unadorned names, but this support may be disabled in a future release.
	210
	211	The listing is alphabetical, case insensitive.
	212
	213	_EOB_
	214
	215	my $key;
6a477168 HS	216	# case insensitive sort, with fallback for determinacy
6a477168 HS	217	for $key (sort { uc($a) cmp uc($b) \|\| $a cmp $b } keys %apidocs) {
94bdecf9 JH	218	my $section = $apidocs{$key};
	219	print DOC "\n=head1 $key\n\n=over 8\n\n";
	220	for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
	221	docout(\*DOC, $key, $section->{$key});
	222	}
	223	print DOC "\n=back\n";
	224	}
	225
	226	print DOC <<'_EOE_';
	227
	228	=head1 AUTHORS
	229
	230	Until May 1997, this document was maintained by Jeff Okamoto
	231	<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
	232
	233	With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
	234	Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
	235	Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
	236	Stephen McCamant, and Gurusamy Sarathy.
	237
	238	API Listing originally by Dean Roehrich <roehrich@cray.com>.
	239
	240	Updated to be autogenerated from comments in the source by Benjamin Stuhl.
	241
	242	=head1 SEE ALSO
	243
	244	perlguts(1), perlxs(1), perlxstut(1), perlintern(1)
	245
	246	_EOE_
	247
	248
36bb303b	249	close(DOC) or die "Error closing pod/perlapi.pod: $!";
94bdecf9	250
36bb303b	251	safer_unlink "pod/perlintern.pod";
94bdecf9 JH	252	open(GUTS, ">pod/perlintern.pod") or
	253	die "Unable to create pod/perlintern.pod: $!\n";
	254	print GUTS <<'END';
	255	=head1 NAME
	256
	257	perlintern - autogenerated documentation of purely B<internal>
	258	Perl functions
	259
	260	=head1 DESCRIPTION
	261
	262	This file is the autogenerated documentation of functions in the
	263	Perl interpreter that are documented using Perl's internal documentation
	264	format but are not marked as part of the Perl API. In other words,
	265	B<they are not for use in extensions>!
	266
	267	END
	268
	269	for $key (sort { uc($a) cmp uc($b); } keys %gutsdocs) {
	270	my $section = $gutsdocs{$key};
	271	print GUTS "\n=head1 $key\n\n=over 8\n\n";
	272	for my $key (sort { uc($a) cmp uc($b); } keys %$section) {
	273	docout(\*GUTS, $key, $section->{$key});
	274	}
	275	print GUTS "\n=back\n";
	276	}
	277
	278	print GUTS <<'END';
	279
	280	=head1 AUTHORS
	281
	282	The autodocumentation system was originally added to the Perl core by
	283	Benjamin Stuhl. Documentation is by whoever was kind enough to
	284	document their functions.
	285
	286	=head1 SEE ALSO
	287
	288	perlguts(1), perlapi(1)
	289
	290	END
	291
36bb303b	292	close GUTS or die "Error closing pod/perlintern.pod: $!";