Notices

#!/usr/bin/perl
#lirc daemon emulator for using irreco to remote control your mythfrontend by emulating a real lirc daemon but instead of transmitting infrared signals
#the button presses are mapped to system() commands as per instrucions in the configuration file
#this is my very first Perl script ever, so everything could probably be done much better, but hey, at least it works as expected.
#Mika Saarela emjayes@gmail.com 28.02.2008
#Thank you Arto Karppinen et al for creating such a great piece of software for Internet tablet users.
use IO::Socket;
use IO::Select;
use Sys::Hostname;
eval "require(Proc::Daemon)";
die "Proc::Daemon not installed \nrun:\nsudo apt-get install libproc-daemon-perl\nor:\ncpan install Proc::Daemon\nto install\n" if $@;
use Proc::Daemon;
my $host = hostname();
my @keys = ();
my @actions = ();
my $numkeys = ();
my $keynum = ();
if (grep /^-h|^--help/, @ARGV){{print "\nUsage: $0 [option]\n\t\t\t--nodaemon\tdo not daemonize\n\t\t\t--stop\t\tstop the running lircdemulator\n";}{exit}}
if (grep /^--stop/, @ARGV){{print "Stopping running lircd emulator\n";}{system("killall lircdemulator>/dev/null 2>&1")}}
if (! -e "$ENV{ HOME }/.lircdemulator"){
{print "Configuration file  $ENV{ HOME }/.lircdemulator does not exist, creating a sample configuration file.\n\nEdit it to match your needs and run again\n"};
{open(CREATECONFIG, "> $ENV{ HOME }/.lircdemulator") or die "Unable to write example configuration to  $ENV{ HOME }/.lircdemulator\n";}
{print CREATECONFIG "#The format of the configfile is:\n#keyname action\n#for example:\n#button_name echo <any command with parameters and redirection etc. that you can run from the command line>\n
#Configure the IPADDR if you do not wish to listen on all interfaces\nIPADDR=0.0.0.0\n#Configure the port you want to listen to. Do not use 8765 if you also have a real lirc daemon running\nPORT=9999\n
#here are some working samples if you have mythfrontend installed with Network Remote Control interface enabled.\nmyth_up echo key up|nc -q0 localhost 6546\nmyth_down echo key down|nc -q0 localhost 6546
myth_right echo key right|nc -q0 localhost 6546\nmyth_left echo key left|nc -q0 localhost 6546\nmyth_escape echo key escape|nc -q0 localhost 6546\nmyth_menu echo key m|nc -q0 localhost 6546
myth_volup echo key f11|nc -q0 localhost 6546\nmyth_voldown echo key f10|nc -q0 localhost 6546\neject eject\nclose_drive eject -t\n
#the whole line minus keyname is called as system(&) when corresponding key is pressed in irreco interface.
#the config file is read at start only, You will need to restart the emulator if the config file is modified";}
{close(CREATECONFIG);}
{die "lircd emulator not started.\n"};}

open(CONFIG, "< $ENV{ HOME }/.lircdemulator" ) or die "Unable to open configuration file\n"; #open the configuration file 
        while (<CONFIG>){
        if (grep /PORT/, $_ ) {{s/\s*//g;}{chomp ($port=substr($_,5))}{$_=""};}
        if (grep /IPADDR/, $_ ) {{s/\s*//g;}{chomp ($ipaddr=substr($_,7))}{$_=""};}
        s/^#.*//; #ignore comment lines
        s/^\s+//; #ignore leading blank
        chomp; #remove linefeeds
        unless ($_ =~ /^()$/) {push (@actions,"$_ &\n")}; #push valid commands to @actions appending & so the execution will return without delay
        s/\s*(\w+).*/$1/; #strip to the keyname
        unless ($_ =~ /^()$/) {$keynum = $keynum +1,$numkeys = push (@keys,"$keynum $_\n")}; #push valid keys to @keys
        };
close(CONFIG); #close the configuration file
if (! system("echo ping|nc -q0 $ipaddr $port>/dev/null 2>&1")){{print "Port $port already in use\n";}{exit}}  
print "lircd emulator listening on $ipaddr:$port\n";
if (! grep /^--nodaemon/, @ARGV) {Proc::Daemon::Init;} #daemonize the script if --nodaemon was not passed
while (forever){ #run until explicitly killed 
my $sock = new IO::Socket::INET( #create a network socket to listen to
LocalHost => $ipaddr, #listen on all interfaces, alter if needed
LocalPort => $port, #do not use 8765 if you have a real lir daemon running as well
Proto => 'tcp',
Listen => 1,
Reuse => 1,
);
die "Could not create Socket: $!\n" unless $sock; #die if the port or address is already used
my $new_sock = $sock->accept();
        while(<$new_sock>) {
                print "Client requested $_";
                if (/^LIST$/){ #the client requests the number and names of remotes available. We have just 1, named <your hostname>
                print $new_sock "BEGIN\nLIST\nSUCCESS\nDATA\n1\n$host\nEND\n"; #reply to the client
                }
                if (/^LIST $host$/){ #the client requests the available "buttons"
                        print $new_sock "BEGIN\nLIST $host\nSUCCESS\nDATA\n",$numkeys,"\n",@keys,"END\n"; #send the available buttons
                }
                if (/^SEND_ONCE $host\ /){ #client has pressed a button 
                        {$strip=(length ("SEND_ONCE $host "))}; #calculate the length of characters to be stipped
                        {$string = substr($_,0,$strip)=""}; #remove SEND_ONCE $host from $_ and save that to $string 
                        {@action = grep(/^$string*\b/, @actions)}; #get the line containing the button pressed from available actions
                        chomp $string; #remove linefeed from the string
                        {$key = $_}; #set the key to match the button pressed so we can use it in the reply
                        {$action = substr((join " ", @action),(length("$string")+1))}; #create a command string from the array
                        {print $new_sock  "BEGIN\n\SEND_ONCE ",$host," ",$key,"SUCCESS\nEND\n"}; #reply client  
                        system("$action"); #run the command 
                        chomp $action;
                        print "Running system(\"$action\")\n";
                }
        close($new_sock)}; #close the socket and start waiting for a new connection
};