lirc/fix-remote-keys.pl

129 lines
2.6 KiB
Perl
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#!/usr/bin/perl -w
#
# This is a perl script to unify the key names in lircd config files.
#
# Going to use the KEY_* #defines (without KEY_ prefix)
# from #include <linux/input.h> for the key names.
#
# (c) 2003 Gerd Knorr <kraxel@suse.de>
#
use strict;
use POSIX;
use File::Find;
#############################################################################
# translation table
my %table = (
# volume keys
'vol(ume)?[-_]?(\+|up|plus)' => 'VOLUMEUP',
'vol(ume)?[-_]?(\-|down|dn|minus)' => 'VOLUMEDOWN',
# switch channels
'ch(annel|n|an)?[-_]?(\+|up|plus)' => 'CHANNELUP',
'ch(annel|n|an)?[-_]?(\-|down|dn|minus)' => 'CHANNELDOWN',
# dummy
'dummy' => 'dummy'
);
my %keys;
#############################################################################
# helpers
sub readfile {
my $filename = shift;
my $content;
open FILE, "< $filename" or die "open $filename: $!";
{ local $/; undef $/; $content = <FILE>; };
close FILE;
return $content;
}
sub writefile {
my $filename = shift;
my $content = shift;
open FILE, "> $filename" or die "open $filename: $!";
print FILE $content;
close FILE;
}
sub fix_key {
my $name = shift;
$name =~ s/´//g;
for my $regex (keys %table) {
$name =~ s/^$regex$/$table{$regex}/i;
}
$name = POSIX::toupper($name);
$keys{$name}++;
$name = "'$name'";
return $name;
}
sub replacer {
my $old = shift;
my $new = "";
my $codes = 0;
my $raw_codes = 0;
my ($orig,$name,$code);
foreach my $line (split /\n/,$old) {
if ($line =~ m/begin\s+codes/) {
$codes = 1;
} elsif ($line =~ m/end\s+codes/) {
$codes = 0;
} elsif ($line =~ m/begin\s+raw_codes/) {
$raw_codes = 1;
} elsif ($line =~ m/end\s+raw_codes/) {
$raw_codes = 0;
} elsif ($codes == 1 && $line =~ m/^\s*(\S+)\s+(\S+)\s*$/) {
$orig = $1;
$code = $2;
$name = fix_key($orig);
$line = sprintf("\t%-20s %-20s # %s",
$name,$code,$orig);
} elsif ($raw_codes == 1 && $line =~ m/^\s*name\s+(\S+)\s*$/) {
$orig = $1;
$name = fix_key($orig);
$line = sprintf("\tname %-20s # %s",
$name,$orig);
}
$new .= $line . "\n";
}
return $new;
}
sub wanted {
my $content;
return unless -f $_; # regular files
print "fixup $File::Find::name\n";
$content = readfile($_);
if ($content =~ m/begin\s+remote/s) {
# is a lircd config file
$content = replacer($content);
writefile($_,$content);
}
}
#############################################################################
# main
# handle files
my $dir = shift;
find(\&wanted, $dir);
# print key stats (for building %table ...).
exit;
foreach my $key (sort { $keys{$a} <=> $keys{$b} } keys %keys) {
printf("%3d %s\n",$keys{$key},$key);
}