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


#
# 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: $!";
	binmode F;
	$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;
	}
	s/\s+$//;
	my @args;
	if (/^\s*(#|$)/) {
	    @args = $_;
	}
	else {
	    @args = split /\s*\|\s*/, $_;
	}
	s/\b(NN|NULLOK)\b\s+//g for @args;
	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";
binmode DOC;

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