InputCapsFromHeader.pm 3.54 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
package derobert::InputCapsFromHeader;
use 5.028;
use Moose;
with 'Dist::Zilla::Role::FileGatherer';

use namespace::autoclean;
use Dist::Zilla::File::InMemory;
use IPC::Run3 qw(run3);
use Text::Wrap qw(wrap);

sub gather_files {
	my ($self) = @_;

14 15 16
	my $code = <<~'HEADER';
		package Linux::Input::Capabilities::Constants;
		#ABSTRACT: Constants defining various input device capabilities.
17
		use strict;
18 19
		use Exporter qw(import);
		our @EXPORT_OK = ('%_REVERSE_TABLE');
20 21 22 23
		HEADER

	my $macros = _get_relevant_defines();

24
	$code .= "\n# \@EXPORT_OK setup:\n";
25
	$code .= _macros_to_export_ok($macros);
26 27

	$code .= "\n# Sub declarations (prototypes):\n";
28
	$code .= _macros_to_prototypes($macros);
29 30

	$code .= "\n# Sub definitions:\n";
31
	$code .= _macros_to_subs($macros);
32 33

	$code .= "\n# Reverse lookup table:\n";
34 35
	$code .= _macros_to_reverse($macros);

36
	$code .= <<~'FOOTER';
37 38 39 40
		1;
		
		=head1 DESCRIPTION
		
41
		This provides constants to use with L<Linux::Input::Capabilities>.
42 43 44 45 46 47
		
		=head1 SEE ALSO
		
		=over 4
		
		=item L<Linux::Input::Capabilities>
48 49

		This is where to find the documentation.
50 51 52 53 54 55
		
		=back
		FOOTER

	$self->add_file(
		Dist::Zilla::File::InMemory->new(
56
			name => 'lib/Linux/Input/Capabilities/Constants.pm',
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
			content => $code,
		)
	);

	return;
}

use Data::Dump qw(pp);
sub _get_relevant_defines {
	my %macros;

	run3(
		[qw(gcc -dM -E -)], \"#include <linux/input.h>\n",
		sub {
			my ($name, $type, $value) = $_[0] =~ m{^
				\#define \s+ ((ABS|EV|FF|KEY|BTN|LED|MSC|REL|SND|SW)_\S+)
				\s+ (\S+)
			}ax or return;

Anthony DeRobertis's avatar
Anthony DeRobertis committed
76 77 78 79
			# BTN and KEY use the same capabilities file (key); unify
			# them.
			$type = 'KEY' if $type eq 'BTN';

80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
			# oct handles various prefixes, not just octal. Basically
			# just like C.
			$value = oct($value) if $value =~ /^0/;
			$macros{$type}{$name} = $value;
		},
		undef);
	die "gcc preproccessor failed" if $?;

	return \%macros;
}

sub _macros_to_export_ok {
	my ($macros) = @_;
	local $_;

	my $res = qq|push \@EXPORT_OK, (\n|;
	local $Text::Wrap::huge = 'overflow';
97 98
	$res .= wrap("\t", "\t",
		join(q{, }, map(qq{"$_"}, sort map(keys %$_, values %$macros))));
99 100 101 102 103
	$res .= "\n);\n";

	return $res;
}

104 105 106 107
sub _macros_to_prototypes {
	my ($macros) = @_;
	local $_;

108
	join("", map(qq{sub $_();\n}, sort map(keys %$_, values %$macros)));
109 110
}

111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
sub _macros_to_subs {
	my ($macros) = @_;
	my $res;
	
	foreach my $type (values %$macros) {
		while (my ($name, $val) = each %$type) {
			$res .= qq{sub $name() { $val }\n};
		}
	}

	return $res;
}

sub _macros_to_reverse {
	my ($macros) = @_;

	my $res = "our %_REVERSE_TABLE = (\n";

	while (my ($type, $members) = each %$macros) {
		$res .= "\t'$type' => {\n";
		while (my ($name, $val) = each %$members) {
			$res .= "\t\t$name() => '$name',\n";
		}
		$res .= "\t},\n";
	}
	
	$res .= ");\n";

	return $res;
}

__END__

=head1 NAME

derobert:::InputCapsFromHeader - grabs macros from F<linux/input.h>

=head1 DESCRIPTION

This Dist::Zilla plugin automatically grabs a bunch of macros from
F<linux/input.h> and converts them to a form L<Linux::Input::Capabilities>
can use.

=head1 GENERATED CODE

156
Code is generated as F<lib/Linux/Input/Capabilities/Constants.pm>. It
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
consists of three parts:

=over 4

=item *

A C<push @EXPORT_OK, (...> statement to make it possible to export all
the generated constants.

=item *

A long list of constant subroutines. These are the converted macros; all
of them are exportable.

=item *

A data structure, C<%_REVERSE_TABLE>, which is used to look up the name
given a value.

=back

=head1 SEE ALSO

=over 4

=item L<Linux::Input::Capabilities>

184
The main interface to this mass of generated code.
185 186

=back