129 lines
2.6 KiB
Perl
129 lines
2.6 KiB
Perl
|
#!/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/<2F>//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);
|
|||
|
|
}
|