[libvirt] [PATCH 1/3] doc: Add a perl script to generate keycodes mapping table files

[Guannan Ren]

This script helps generate keycode mapping table in files of
POD format. These files are used for producing manpage such as:

libvirt-keycode-linux.5
libvirt-keycode-xt.5
libvirt-keycode-xt_kbd.5
libvirt-keycode-xt_atset1.5
...
---
 tools/keymap-gen.pl | 202 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 202 insertions(+)
 create mode 100644 tools/keymap-gen.pl

diff --git a/tools/keymap-gen.pl b/tools/keymap-gen.pl
new file mode 100644
index 0000000..ac22b59
--- /dev/null
+++ b/tools/keymap-gen.pl
@@ -0,0 +1,202 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my %names = (
+    linux => [],
+    os_x => [],
+    win32 => [],
+    );
+
+my %namecolumns = (
+    linux => 0,
+    os_x => 2,
+    win32 => 10,
+    );
+
+my %mapcolumns = (
+    os_x => 3,
+    atset1 => 4,
+    atset2 => 5,
+    atset3 => 6,
+    xt => 7,
+    xt_kbd => 8,
+    usb => 9,
+    win32 => 11,
+    xwinxt => 12,
+    xkbdxt => 13,
+    );
+
+my @libvirtmaps = qw(linux xt atset1 atset2 atset3 os_x xt_kbd win32 usb rfb);
+my @basemaps = qw(linux os_x atset1 atset2 atset3 xt xt_kbd usb win32 xwinxt xkbdxt);
+my @derivedmaps = qw(xorgevdev xorgkbd xorgxquartz xorgxwin rfb);
+my @maps = (@basemaps, @derivedmaps);
+
+my %maps;
+
+foreach my $map (@maps) {
+    $maps{$map} = [];
+}
+
+sub help {
+    my $msg = shift;
+    print $msg;
+    print "\n";
+    exit (1);
+}
+
+if ($#ARGV != 0) {
+    help("syntax: $0 KEYMAPS \n");
+}
+
+my $keymaps = shift @ARGV;
+
+open CSV, $keymaps
+    or die "cannot read $keymaps: $!";
+
+# Discard column headings
+scalar <CSV>;
+
+my @row;
+while (<CSV>) {
+    chomp;
+    @row = split /,/;
+
+    my $linux = $row[1];
+
+    $linux = hex($linux) if $linux =~ /0x/;
+
+    my $codeset = $maps{linux};
+    $codeset->[$linux] = $linux;
+
+    foreach my $name (keys %namecolumns) {
+	my $col = $namecolumns{$name};
+	my $val = $row[$col];
+
+	$val = "" unless defined $val;
+	$names{$name}->[$linux] = $val;
+    }
+
+    foreach my $name (keys %mapcolumns) {
+	my $col = $mapcolumns{$name};
+	my $val = $row[$col];
+
+	next unless defined $val && $val ne "";
+	$val = hex($val) if $val =~ /0x/;
+
+	$codeset = $maps{$name};
+	$codeset->[$linux] = $val;
+    }
+
+    # XXX there are some special cases in kbd to handle
+    # Xorg KBD driver is the Xorg KBD XT codes offset by +8
+    # The XKBD XT codes are the same as normal XT codes
+    # for values <= 83, and completely made up for extended
+    # scancodes :-(
+    $codeset = $maps{xorgkbd};
+    if (defined $maps{xkbdxt}->[$linux]) {
+	$codeset->[$linux] = $maps{xkbdxt}->[$linux] + 8;
+    }
+
+    # Xorg evdev is simply Linux keycodes offset by +8
+    $codeset = $maps{xorgevdev};
+    $codeset->[$linux] = $linux + 8;
+
+    # Xorg XQuartz is simply OS-X keycodes offset by +8
+    $codeset = $maps{xorgxquartz};
+    if (defined $maps{os_x}->[$linux]) {
+	$codeset->[$linux] = $maps{os_x}->[$linux] + 8;
+    }
+
+    # RFB keycodes are XT kbd keycodes with a slightly
+    # different encoding of 0xe0 scan codes. RFB uses
+    # the high bit of the first byte, instead of the low
+    # bit of the second byte.
+    $codeset = $maps{rfb};
+    my $xtkbd = $maps{xtk_bd}->[$linux];
+    if (defined $xtkbd) {
+	$codeset->[$linux] = $xtkbd ? (($xtkbd & 0x100)>>1) | ($xtkbd & 0x7f) : 0;
+    }
+
+    # Xorg Cygwin is the Xorg Cygwin XT codes offset by +8
+    # The Cygwin XT codes are the same as normal XT codes
+    # for values <= 83, and completely made up for extended
+    # scancodes :-(
+    $codeset = $maps{xorgxwin};
+    if (defined $maps{xwinxt}->[$linux]) {
+	$codeset->[$linux] = $maps{xwinxt}->[$linux] + 8;
+    }
+}
+
+close CSV;
+
+sub podfile_producer {
+
+    my $dst = shift;
+    my $POD = shift;
+    my $srcmap = $maps{linux};
+    my $dstmap = $maps{$dst};
+
+    printf $POD "=head1 Name\n\n";
+    printf $POD "%s - linux codes mapping table\n\n", $dst;
+
+    printf $POD "=head1 DESCRIPTION\n\n";
+
+    if ($dst eq "linux") {
+        printf $POD "This is a B<linux> codeset table. The decimal numeric values
+in the first column are Linux Keycode. The symbolic names in the second column
+match the corresponding Linux key constant macro names.\n\n";
+
+    } else {
+        printf $POD "This is a B<linux> vs B<%s> codes mapping table. The decimal numeric values
+in the first column are Linux Keycode. The symbolic names in the second column
+match the corresponding Linux key constant macro names. The third column lists B<%s>
+decimal numeric code values mapping to B<linux> as well as its symbolic names which will
+be list in the fourth column if provided.\n\n", $dst, $dst;
+    }
+
+    printf $POD "=over 4\n\n";
+    printf $POD "=item B<linux(symbolic names)>  B<%s(symbolic names)>\n\n", $dst;
+    printf $POD "=back\n\n";
+
+    for (my $i = 0 ; $i <= $#{$srcmap} ; $i++) {
+        my $linux = $srcmap->[$i] || 0;
+        my $j = $dstmap->[$linux];
+        next unless $linux && $j;
+
+        my $srcname = $names{linux}->[$linux];
+        my $dstname = $names{$dst}->[$linux] if exists $names{$dst};
+
+        $srcname = "" unless $srcname;
+        $dstname = "" unless $dstname;
+        $srcname = " ($srcname)" if $srcname;
+        $dstname = " ($dstname)" if $dstname;
+
+        my $linuxcodeset = sprintf "%d%s", $i, $srcname;
+
+        if ($dst eq "linux") {
+            printf $POD "  %s\n", $linuxcodeset;
+        } else {
+            printf $POD "  %-30s%d%s\n", $linuxcodeset, $j, $dstname;
+        }
+    }
+
+    printf $POD "\n=head1 COPYRIGHT\n\n";
+    printf $POD "Copyright (C) 2012 Red Hat, Inc.\n\n";
+
+    printf $POD "=head1 SEE ALSO\n\n";
+    printf $POD "L<virsh(1)>, online instructions C<http://libvirt.org/locking.html>\n\n";
+
+    printf $POD "=cut\n";
+}
+
+foreach (@libvirtmaps) {
+    my $podfile = sprintf "libvirt-keycode-%s.in", $_;
+
+    open my $POD, "> $podfile"
+        or die "cannot write $podfile: $!";
+
+    podfile_producer($_, $POD);
+    close($POD);
+}
-- 
1.7.11.2