[linux-2.6-block.git] / scripts / get_abi.pl

#!/usr/bin/perl

use strict;
use Pod::Usage;
use Getopt::Long;
use File::Find;
use Fcntl ':mode';

my $help;
my $man;
my $debug;

GetOptions(
	"debug|d+" => \$debug,
	'help|?' => \$help,
	man => \$man
) or pod2usage(2);

pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

pod2usage(2) if (scalar @ARGV != 1);

my ($prefix) = @ARGV;

require Data::Dumper if ($debug);

my %data;

#
# Displays an error message, printing file name and line
#
sub parse_error($$$$) {
	my ($file, $ln, $msg, $data) = @_;

	print STDERR "file $file#$ln: $msg at\n\t$data";
}

#
# Parse an ABI file, storing its contents at %data
#
sub parse_abi {
	my $file = $File::Find::name;

	my $mode = (stat($file))[2];
	return if ($mode & S_IFDIR);
	return if ($file =~ m,/README,);

	my $name = $file;
	$name =~ s,.*/,,;

	my $nametag = "File $name";
	$data{$nametag}->{what} = "File $name";
	$data{$nametag}->{type} = "File";
	$data{$nametag}->{file} = $name;
	$data{$nametag}->{is_file} = 1;

	my $type = $file;
	$type =~ s,.*/(.*)/.*,$1,;

	my $what;
	my $new_what;
	my $tag;
	my $ln;
	my $xrefs;
	my $space;
	my @labels;
	my $label;

	print STDERR "Opening $file\n" if ($debug > 1);
	open IN, $file;
	while(<IN>) {
		$ln++;
		if (m/^(\S+)(:\s*)(.*)/i) {
			my $new_tag = lc($1);
			my $sep = $2;
			my $content = $3;

			if (!($new_tag =~ m/(what|date|kernelversion|contact|description|users)/)) {
				if ($tag eq "description") {
					# New "tag" is actually part of
					# description. Don't consider it a tag
					$new_tag = "";
				} else {
					parse_error($file, $ln, "tag '$tag' is invalid", $_);
				}
			}

			if ($new_tag =~ m/what/) {
				$space = "";
				if ($tag =~ m/what/) {
					$what .= ", " . $content;
				} else {
					parse_error($file, $ln, "What '$what' doesn't have a description", "") if ($what && !$data{$what}->{description});

					$what = $content;
					$label = $content;
					$new_what = 1;
				}
				push @labels, [($content, $label)];
				$tag = $new_tag;

				push @{$data{$nametag}->{xrefs}}, [($content, $label)] if ($data{$nametag}->{what});
				next;
			}

			if ($new_tag) {
				$tag = $new_tag;

				if ($new_what) {
					@{$data{$what}->{label}} = @labels if ($data{$nametag}->{what});
					@labels = ();
					$label = "";
					$new_what = 0;

					$data{$what}->{type} = $type;
					$data{$what}->{file} = $name;
					print STDERR "\twhat: $what\n" if ($debug > 1);
				}

				if (!$what) {
					parse_error($file, $ln, "'What:' should come first:", $_);
					next;
				}
				if ($tag eq "description") {
					next if ($content =~ m/^\s*$/);
					if ($content =~ m/^(\s*)(.*)/) {
						my $new_content = $2;
						$space = $new_tag . $sep . $1;
						while ($space =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
						$space =~ s/./ /g;
						$data{$what}->{$tag} .= "$new_content\n";
					}
				} else {
					$data{$what}->{$tag} = $content;
				}
				next;
			}
		}

		# Store any contents before tags at the database
		if (!$tag && $data{$nametag}->{what}) {
			$data{$nametag}->{description} .= $_;
			next;
		}

		if ($tag eq "description") {
			if (!$data{$what}->{description}) {
				next if (m/^\s*\n/);
				if (m/^(\s*)(.*)/) {
					$space = $1;
					while ($space =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
					$data{$what}->{$tag} .= "$2\n";
				}
			} else {
				my $content = $_;
				if (m/^\s*\n/) {
					$data{$what}->{$tag} .= $content;
					next;
				}

				while ($content =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
				$space = "" if (!($content =~ s/^($space)//));

				# Compress spaces with tabs
				$content =~ s<^ {8}> <\t>;
				$content =~ s<^ {1,7}\t> <\t>;
				$content =~ s< {1,7}\t> <\t>;
				$data{$what}->{$tag} .= $content;
			}
			next;
		}
		if (m/^\s*(.*)/) {
			$data{$what}->{$tag} .= "\n$1";
			$data{$what}->{$tag} =~ s/\n+$//;
			next;
		}

		# Everything else is error
		parse_error($file, $ln, "Unexpected line:", $_);
	}
	$data{$nametag}->{description} =~ s/^\n+//;
	close IN;
}

# Outputs the output on ReST format
sub output_rest {
	foreach my $what (sort keys %data) {
		my $type = $data{$what}->{type};
		my $file = $data{$what}->{file};

		my $w = $what;
		$w =~ s/([\(\)\_\-\*\=\^\~\\])/\\$1/g;

		my $bar = $w;
		$bar =~ s/./-/g;

		foreach my $p (@{$data{$what}->{label}}) {
			my ($content, $label) = @{$p};
			$label = "abi_" . $label . " ";
			$label =~ tr/A-Z/a-z/;

			# Convert special chars to "_"
			$label =~s/([\x00-\x2f\x3a-\x40\x5b-\x60\x7b-\xff])/_/g;
			$label =~ s,_+,_,g;
			$label =~ s,_$,,;

			$data{$what}->{label} .= $label;

			printf ".. _%s:\n\n", $label;

			# only one label is enough
			last;
		}

		print "$w\n$bar\n\n";

		print "- defined on file $file (type: $type)\n\n" if ($type ne "File");

		my $desc = $data{$what}->{description};
		$desc =~ s/^\s+//;

		# Remove title markups from the description, as they won't work
		$desc =~ s/\n[\-\*\=\^\~]+\n/\n/g;

		if (!($desc =~ /^\s*$/)) {
			if ($desc =~ m/\:\n/ || $desc =~ m/\n[\t ]+/  || $desc =~ m/[\x00-\x08\x0b-\x1f\x7b-\xff]/) {
				# put everything inside a code block
				$desc =~ s/\n/\n /g;

				print "::\n\n";
				print " $desc\n\n";
			} else {
				# Escape any special chars from description
				$desc =~s/([\x00-\x08\x0b-\x1f\x21-\x2a\x2d\x2f\x3c-\x40\x5c\x5e-\x60\x7b-\xff])/\\$1/g;

				print "$desc\n\n";
			}
		} else {
			print "DESCRIPTION MISSING for $what\n\n" if (!$data{$what}->{is_file});
		}

		if ($data{$what}->{xrefs}) {
			printf "Has the following ABI:\n\n";

			foreach my $p(@{$data{$what}->{xrefs}}) {
				my ($content, $label) = @{$p};
				$label = "abi_" . $label . " ";
				$label =~ tr/A-Z/a-z/;

				# Convert special chars to "_"
				$label =~s/([\x00-\x2f\x3a-\x40\x5b-\x60\x7b-\xff])/_/g;
				$label =~ s,_+,_,g;
				$label =~ s,_$,,;

				# Escape special chars from content
				$content =~s/([\x00-\x1f\x21-\x2f\x3a-\x40\x7b-\xff])/\\$1/g;

				print "- :ref:`$content <$label>`\n\n";
			}
		}
	}
}

#
# Parses all ABI files located at $prefix dir
#
find({wanted =>\&parse_abi, no_chdir => 1}, $prefix);

print STDERR Data::Dumper->Dump([\%data], [qw(*data)]) if ($debug);

#
# Outputs an ReST file with the ABI contents
#
output_rest


__END__

=head1 NAME

abi_book.pl - parse the Linux ABI files and produce a ReST book.

=head1 SYNOPSIS

B<abi_book.pl> [--debug] <ABI_DIR>]

=head1 OPTIONS

=over 8

=item B<--debug>

Put the script in verbose mode, useful for debugging. Can be called multiple
times, to increase verbosity.

=item B<--help>

Prints a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=back

=head1 DESCRIPTION

Parse the Linux ABI files from ABI DIR (usually located at Documentation/ABI)
and produce a ReST book containing the Linux ABI.

=head1 BUGS

Report bugs to Mauro Carvalho Chehab <mchehab@s-opensource.com>

=head1 COPYRIGHT

Copyright (c) 2016 by Mauro Carvalho Chehab <mchehab@s-opensource.com>.

License GPLv2: GNU GPL version 2 <http://gnu.org/licenses/gpl.html>.

This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.

=cut
Commit	Line	Data
bbc249f2 MCC	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use Pod::Usage;
	5	use Getopt::Long;
	6	use File::Find;
	7	use Fcntl ':mode';
	8
	9	my $help;
	10	my $man;
	11	my $debug;
	12
	13	GetOptions(
	14	"debug\|d+" => \$debug,
	15	'help\|?' => \$help,
	16	man => \$man
	17	) or pod2usage(2);
	18
	19	pod2usage(1) if $help;
	20	pod2usage(-exitstatus => 0, -verbose => 2) if $man;
	21
	22	pod2usage(2) if (scalar @ARGV != 1);
	23
	24	my ($prefix) = @ARGV;
	25
	26	require Data::Dumper if ($debug);
	27
	28	my %data;
	29
	30	#
	31	# Displays an error message, printing file name and line
	32	#
	33	sub parse_error($$$$) {
	34	my ($file, $ln, $msg, $data) = @_;
	35
	36	print STDERR "file $file#$ln: $msg at\n\t$data";
	37	}
	38
	39	#
	40	# Parse an ABI file, storing its contents at %data
	41	#
	42	sub parse_abi {
	43	my $file = $File::Find::name;
	44
	45	my $mode = (stat($file))[2];
	46	return if ($mode & S_IFDIR);
	47	return if ($file =~ m,/README,);
	48
	49	my $name = $file;
	50	$name =~ s,.*/,,;
	51
d0ebaf51 MCC	52	my $nametag = "File $name";
	53	$data{$nametag}->{what} = "File $name";
	54	$data{$nametag}->{type} = "File";
	55	$data{$nametag}->{file} = $name;
	56	$data{$nametag}->{is_file} = 1;
	57
bbc249f2 MCC	58	my $type = $file;
	59	$type =~ s,./(.)/.*,$1,;
	60
	61	my $what;
	62	my $new_what;
	63	my $tag;
	64	my $ln;
6619c661	65	my $xrefs;
4e6a6234	66	my $space;
d0ebaf51 MCC	67	my @labels;
d0ebaf51 MCC	68	my $label;
bbc249f2 MCC	69
	70	print STDERR "Opening $file\n" if ($debug > 1);
	71	open IN, $file;
	72	while(<IN>) {
	73	$ln++;
4e6a6234	74	if (m/^(\S+)(:\s)(.)/i) {
bbc249f2	75	my $new_tag = lc($1);
4e6a6234 MCC	76	my $sep = $2;
4e6a6234 MCC	77	my $content = $3;
bbc249f2 MCC	78
	79	if (!($new_tag =~ m/(what\|date\|kernelversion\|contact\|description\|users)/)) {
	80	if ($tag eq "description") {
4e6a6234 MCC	81	# New "tag" is actually part of
	82	# description. Don't consider it a tag
	83	$new_tag = "";
bbc249f2 MCC	84	} else {
	85	parse_error($file, $ln, "tag '$tag' is invalid", $_);
	86	}
	87	}
	88
	89	if ($new_tag =~ m/what/) {
4e6a6234	90	$space = "";
bbc249f2 MCC	91	if ($tag =~ m/what/) {
	92	$what .= ", " . $content;
	93	} else {
4e6a6234 MCC	94	parse_error($file, $ln, "What '$what' doesn't have a description", "") if ($what && !$data{$what}->{description});
4e6a6234 MCC	95
bbc249f2	96	$what = $content;
d0ebaf51	97	$label = $content;
bbc249f2 MCC	98	$new_what = 1;
bbc249f2 MCC	99	}
d0ebaf51	100	push @labels, [($content, $label)];
bbc249f2	101	$tag = $new_tag;
6619c661	102
d0ebaf51	103	push @{$data{$nametag}->{xrefs}}, [($content, $label)] if ($data{$nametag}->{what});
bbc249f2 MCC	104	next;
	105	}
	106
4e6a6234 MCC	107	if ($new_tag) {
4e6a6234 MCC	108	$tag = $new_tag;
bbc249f2	109
4e6a6234	110	if ($new_what) {
d0ebaf51 MCC	111	@{$data{$what}->{label}} = @labels if ($data{$nametag}->{what});
	112	@labels = ();
	113	$label = "";
4e6a6234	114	$new_what = 0;
bbc249f2	115
4e6a6234 MCC	116	$data{$what}->{type} = $type;
	117	$data{$what}->{file} = $name;
	118	print STDERR "\twhat: $what\n" if ($debug > 1);
	119	}
bbc249f2	120
4e6a6234 MCC	121	if (!$what) {
	122	parse_error($file, $ln, "'What:' should come first:", $_);
	123	next;
	124	}
	125	if ($tag eq "description") {
	126	next if ($content =~ m/^\s*$/);
	127	if ($content =~ m/^(\s)(.)/) {
	128	my $new_content = $2;
	129	$space = $new_tag . $sep . $1;
	130	while ($space =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
	131	$space =~ s/./ /g;
	132	$data{$what}->{$tag} .= "$new_content\n";
	133	}
	134	} else {
	135	$data{$what}->{$tag} = $content;
	136	}
bbc249f2 MCC	137	next;
bbc249f2 MCC	138	}
bbc249f2 MCC	139	}
bbc249f2 MCC	140
4e6a6234	141	# Store any contents before tags at the database
d0ebaf51 MCC	142	if (!$tag && $data{$nametag}->{what}) {
d0ebaf51 MCC	143	$data{$nametag}->{description} .= $_;
6619c661 MCC	144	next;
6619c661 MCC	145	}
bbc249f2	146
4e6a6234 MCC	147	if ($tag eq "description") {
	148	if (!$data{$what}->{description}) {
	149	next if (m/^\s*\n/);
	150	if (m/^(\s)(.)/) {
	151	$space = $1;
	152	while ($space =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
	153	$data{$what}->{$tag} .= "$2\n";
	154	}
	155	} else {
	156	my $content = $_;
	157	if (m/^\s*\n/) {
	158	$data{$what}->{$tag} .= $content;
	159	next;
	160	}
	161
	162	while ($content =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
	163	$space = "" if (!($content =~ s/^($space)//));
	164
	165	# Compress spaces with tabs
	166	$content =~ s<^ {8}> <\t>;
	167	$content =~ s<^ {1,7}\t> <\t>;
	168	$content =~ s< {1,7}\t> <\t>;
	169	$data{$what}->{$tag} .= $content;
	170	}
	171	next;
	172	}
bbc249f2 MCC	173	if (m/^\s(.)/) {
	174	$data{$what}->{$tag} .= "\n$1";
	175	$data{$what}->{$tag} =~ s/\n+$//;
	176	next;
	177	}
	178
	179	# Everything else is error
	180	parse_error($file, $ln, "Unexpected line:", $_);
	181	}
d0ebaf51	182	$data{$nametag}->{description} =~ s/^\n+//;
bbc249f2 MCC	183	close IN;
	184	}
	185
	186	# Outputs the output on ReST format
	187	sub output_rest {
	188	foreach my $what (sort keys %data) {
	189	my $type = $data{$what}->{type};
	190	my $file = $data{$what}->{file};
	191
	192	my $w = $what;
	193	$w =~ s/([\(\)\_\-\*\=\^\~\\])/\\$1/g;
	194
4e6a6234 MCC	195	my $bar = $w;
	196	$bar =~ s/./-/g;
	197
d0ebaf51 MCC	198	foreach my $p (@{$data{$what}->{label}}) {
	199	my ($content, $label) = @{$p};
	200	$label = "abi_" . $label . " ";
	201	$label =~ tr/A-Z/a-z/;
	202
	203	# Convert special chars to "_"
	204	$label =~s/([\x00-\x2f\x3a-\x40\x5b-\x60\x7b-\xff])/_/g;
	205	$label =~ s,_+,_,g;
	206	$label =~ s,_$,,;
	207
	208	$data{$what}->{label} .= $label;
	209
	210	printf ".. _%s:\n\n", $label;
	211
	212	# only one label is enough
	213	last;
6619c661 MCC	214	}
6619c661 MCC	215
4e6a6234	216	print "$w\n$bar\n\n";
6619c661 MCC	217
6619c661 MCC	218	print "- defined on file $file (type: $type)\n\n" if ($type ne "File");
bbc249f2 MCC	219
	220	my $desc = $data{$what}->{description};
	221	$desc =~ s/^\s+//;
	222
	223	# Remove title markups from the description, as they won't work
	224	$desc =~ s/\n[\-\*\=\^\~]+\n/\n/g;
	225
4e6a6234 MCC	226	if (!($desc =~ /^\s*$/)) {
	227	if ($desc =~ m/\:\n/ \|\| $desc =~ m/\n[\t ]+/ \|\| $desc =~ m/[\x00-\x08\x0b-\x1f\x7b-\xff]/) {
	228	# put everything inside a code block
	229	$desc =~ s/\n/\n /g;
bbc249f2	230
4e6a6234 MCC	231	print "::\n\n";
	232	print " $desc\n\n";
	233	} else {
	234	# Escape any special chars from description
	235	$desc =~s/([\x00-\x08\x0b-\x1f\x21-\x2a\x2d\x2f\x3c-\x40\x5c\x5e-\x60\x7b-\xff])/\\$1/g;
bbc249f2	236
4e6a6234 MCC	237	print "$desc\n\n";
4e6a6234 MCC	238	}
bbc249f2	239	} else {
d0ebaf51	240	print "DESCRIPTION MISSING for $what\n\n" if (!$data{$what}->{is_file});
bbc249f2	241	}
6619c661	242
d0ebaf51 MCC	243	if ($data{$what}->{xrefs}) {
	244	printf "Has the following ABI:\n\n";
	245
	246	foreach my $p(@{$data{$what}->{xrefs}}) {
	247	my ($content, $label) = @{$p};
	248	$label = "abi_" . $label . " ";
	249	$label =~ tr/A-Z/a-z/;
	250
	251	# Convert special chars to "_"
	252	$label =~s/([\x00-\x2f\x3a-\x40\x5b-\x60\x7b-\xff])/_/g;
	253	$label =~ s,_+,_,g;
	254	$label =~ s,_$,,;
	255
	256	# Escape special chars from content
	257	$content =~s/([\x00-\x1f\x21-\x2f\x3a-\x40\x7b-\xff])/\\$1/g;
	258
	259	print "- :ref:`$content <$label>`\n\n";
	260	}
	261	}
bbc249f2 MCC	262	}
	263	}
	264
	265	#
	266	# Parses all ABI files located at $prefix dir
	267	#
	268	find({wanted =>\&parse_abi, no_chdir => 1}, $prefix);
	269
	270	print STDERR Data::Dumper->Dump([\%data], [qw(*data)]) if ($debug);
	271
	272	#
	273	# Outputs an ReST file with the ABI contents
	274	#
	275	output_rest
	276
	277
	278	__END__
	279
	280	=head1 NAME
	281
	282	abi_book.pl - parse the Linux ABI files and produce a ReST book.
	283
	284	=head1 SYNOPSIS
	285
	286	B<abi_book.pl> [--debug] <ABI_DIR>]
	287
	288	=head1 OPTIONS
	289
	290	=over 8
	291
	292	=item B<--debug>
	293
	294	Put the script in verbose mode, useful for debugging. Can be called multiple
	295	times, to increase verbosity.
	296
	297	=item B<--help>
	298
	299	Prints a brief help message and exits.
	300
	301	=item B<--man>
	302
	303	Prints the manual page and exits.
	304
	305	=back
	306
	307	=head1 DESCRIPTION
	308
	309	Parse the Linux ABI files from ABI DIR (usually located at Documentation/ABI)
	310	and produce a ReST book containing the Linux ABI.
	311
	312	=head1 BUGS
	313
	314	Report bugs to Mauro Carvalho Chehab <mchehab@s-opensource.com>
	315
	316	=head1 COPYRIGHT
	317
	318	Copyright (c) 2016 by Mauro Carvalho Chehab <mchehab@s-opensource.com>.
	319
	320	License GPLv2: GNU GPL version 2 <http://gnu.org/licenses/gpl.html>.
	321
	322	This is free software: you are free to change and redistribute it.
	323	There is NO WARRANTY, to the extent permitted by law.
	324
	325	=cut