Difference between revisions of "LircChannelChanger"

From MythTV Official Wiki
Jump to: navigation, search
(Significant updated to script to support fine grained locking)
(9 intermediate revisions by the same user not shown)
Line 4: Line 4:
 
|long=Lirc Channel Change script with extensive configuration options
 
|long=Lirc Channel Change script with extensive configuration options
 
|category=Channel Change Scripts
 
|category=Channel Change Scripts
|name=LircChannelChanger}}
+
|file=LircChannelChanger
 +
|name=LircChannelChanger
 +
|S25=yes
 +
|S251=yes
 +
|S252=yes
 +
|S253=yes
 +
|S26=yes
 +
}}
 +
 
 +
 
 +
'''LircChannelChanger''' is a script that performs channel changing via lirc.  It is designed to provide flexible configuration options to support many of the requirements of a channel changing script that uses lirc.
  
  
This is a script that performs channel changing via lirc.
+
The definitive source location for this script is located on [https://github.com/garybuhrmaster/LircChannelChanger github]
  
This script is designed to provide flexible configuration options to support
+
 
many (perhaps most) of the requirements of a channel changing script that uses
+
The script:
lirc.
 
  
 
{{Code box|LircChannelChanger|
 
{{Code box|LircChannelChanger|
Line 18: Line 27:
  
 
#
 
#
# LircChannelChanger
+
# LircChannelChanger - Version 0.4 - 2012/08/08
 
#
 
#
  
 
#
 
#
# Copyright (c) 2009-2011 Gary Buhrmaster <gary.buhrmaster@gmail.com>
+
# Copyright (c) 2009-2012 Gary Buhrmaster <gary.buhrmaster@gmail.com>
 
#
 
#
# Redistribution and use in source and binary forms, with or without
+
# Licensed under the Apache License, Version 2.0 (the "License");
# modification, are permitted provided that the following conditions
+
# you may not use this file except in compliance with the License.
# are met:
+
# You may obtain a copy of the License at
 
#
 
#
# * Redistributions of source code must retain the above copyright
+
#     http://www.apache.org/licenses/LICENSE-2.0
#    notice, this list of conditions and the following disclaimer.
 
 
#
 
#
# * Redistributions in binary form must reproduce the above
+
# Unless required by applicable law or agreed to in writing, software
#    copyright notice, this list of conditions and the following
+
# distributed under the License is distributed on an "AS IS" BASIS,
#    disclaimer in the documentation and/or other materials
+
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   provided with the distribution.
+
# See the License for the specific language governing permissions and
#
+
# limitations under the License.
# THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS 'AS IS' AND ANY
 
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 
# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
 
# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
 
# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
 
# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 
#
 
#
  
Line 72: Line 68:
 
use Time::HiRes qw (sleep);
 
use Time::HiRes qw (sleep);
 
use FindBin qw($Bin $Script);
 
use FindBin qw($Bin $Script);
 +
use File::Basename;
 +
use File::Path qw(make_path);
  
 
#
 
#
# lockType can be either semaphore or file or none.
+
# locktype can be either semaphore or file or none.
 
# semaphore only tested for linux (which has
 
# semaphore only tested for linux (which has
 
# semaphore cleanup protections).  None is not
 
# semaphore cleanup protections).  None is not
Line 80: Line 78:
 
# lirc is going to eventually cause confusion).
 
# lirc is going to eventually cause confusion).
 
#
 
#
my $lockType     = 'semaphore';
+
my $locktype     = 'semaphore';
 
+
my $lockwait      = 0.5;            # Time to wait if locking fails
my $lockFile     = '/tmp/LircChannelChanger.lockfile';
+
my $lockattempts  = 60;              # Number of attempts to obtain lock
 +
my $lockfile     = '/tmp/LircChannelChanger.lock';
 
my $lockFH;
 
my $lockFH;
my $lockSemKey   = 727522346;      # "Random" value for key
+
my $locksemkey   = 727522346;      # "Random" value for key
my $lockSem;
+
my $locksem;
 +
my $lockperm      = 0777;            # Default lock file/semaphore permissions
 +
my $lockfinegrain = 0;              # Fine Grained locking
 +
my $lockobtained  = 0;              # Track locking (for last gasp release)
  
 
my @transmitters;                    # Transmitters to send on
 
my @transmitters;                    # Transmitters to send on
Line 94: Line 96:
 
my $address;                        # lirc --address value
 
my $address;                        # lirc --address value
 
my $delay;                          # Delay after keys (for all)
 
my $delay;                          # Delay after keys (for all)
my $tdelay;                         # Delay after set_transmitters
+
my $tdelay       = 0;               # Delay after set_transmitters
 
my $bdelay;                          # Delay after before keys
 
my $bdelay;                          # Delay after before keys
 
my $adelay;                          # Delay after after keys
 
my $adelay;                          # Delay after after keys
Line 102: Line 104:
 
my $edelay        = 0;              # Delay before exit (before lock release)
 
my $edelay        = 0;              # Delay before exit (before lock release)
 
my $delayaccum    = 0;              # Delay accumulated
 
my $delayaccum    = 0;              # Delay accumulated
my $before;                          # Keys to send before channel
+
my @before;                          # Keys to send before channel
my $after;                          # Keys to send after channel
+
my @after;                          # Keys to send after channel
 
my $digitprefix;                    # Digit Keyname prefix (sometimes key_)
 
my $digitprefix;                    # Digit Keyname prefix (sometimes key_)
 
my $digitnames;                      # Use digit names (i.e. 1 -> One)
 
my $digitnames;                      # Use digit names (i.e. 1 -> One)
my $options      = '';              # Constructed options
+
my $irsendoptions = '';              # Constructed options for irsend
 
my $debug        = 0;              # Debug messages
 
my $debug        = 0;              # Debug messages
 
my $remote;                          # Remote name
 
my $remote;                          # Remote name
 
my $channeldigits;                  # Number of channel digits
 
my $channeldigits;                  # Number of channel digits
 
my $channeltransform;                # Channel number transform routine
 
my $channeltransform;                # Channel number transform routine
 +
my @precmds;                        # Pre lirc commands
 +
my @postcmds;                        # Post lirc commands
 
my $help          = 0;              # Help?
 
my $help          = 0;              # Help?
 
my $irsend        = 'irsend';        # Lirc irsend program
 
my $irsend        = 'irsend';        # Lirc irsend program
 +
my $irsendxmitter = 0;              # Set transmitter sent
  
 
my %digitname;
 
my %digitname;
Line 125: Line 130:
 
   $digitname{8}  = 'Eight';
 
   $digitname{8}  = 'Eight';
 
   $digitname{9}  = 'Nine';
 
   $digitname{9}  = 'Nine';
 +
 +
#
 +
# END block for freeing lock due to unusual exiting
 +
#
 +
# This *should* not be needed, since locks should be
 +
# properly released at exit.  But better safe ....
 +
#
 +
END
 +
  {
 +
    if ($lockobtained != 0)
 +
      {
 +
        printf STDERR "END block invoked to free locks\n" if($debug);
 +
        if (!lockFree())
 +
          {
 +
            print "Unable to free lock\n";
 +
          }
 +
        else
 +
          {
 +
            printf STDERR "Lock freed\n" if($debug);
 +
          }
 +
      }
 +
    $lockobtained = 0;
 +
  }
 +
 +
#
 +
# Try to insure that signals causes lock freeing
 +
#
 +
# Again, *should* not be needed, since process termination
 +
# is expected to clean up correctly.  But better safe....
 +
#
 +
$SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub { my $sig = shift; die "\nSIG$sig received: $!\n"};
  
 
#
 
#
 
# Use GetOptions to process the command line options
 
# Use GetOptions to process the command line options
 
#
 
#
if (!GetOptions ( "device=s"                 => \$device,
+
if (!GetOptions ( "device=s"                     => \$device,
                   "address=s"               => \$address,
+
                   "address=s"                   => \$address,
                   "delay=f"                 => \$delay,
+
                   "delay=f"                     => \$delay,
                   "tdelay=f"                 => \$tdelay,
+
                   "tdelay=f"                     => \$tdelay,
                   "bdelay=f"                 => \$bdelay,
+
                   "bdelay=f"                     => \$bdelay,
                   "adelay=f"                 => \$adelay,
+
                   "adelay=f"                     => \$adelay,
                   "ddelay=f"                 => \$ddelay,
+
                   "ddelay=f"                     => \$ddelay,
                   "rdelay=f"                 => \$rdelay,
+
                   "rdelay=f"                     => \$rdelay,
                   "idelay=f"                 => \$idelay,
+
                   "idelay=f"                     => \$idelay,
                   "edelay=f"                 => \$edelay,
+
                   "edelay=f"                     => \$edelay,
                   "xmitters|transmitters=i" => \@transmitters,
+
                   "xmitter|transmitter=i"       => \@transmitters,
                   "beforekeys=s"             => \$before,
+
                   "beforekeys=s"                 => sub { push @before, split(' ', (@_[1]))},
                   "afterkeys=s"             => \$after,
+
                   "afterkeys=s"                 => sub { push @after, split(' ', (@_[1]))},
                   "digitprefix=s"           => \$digitprefix,
+
                   "digitprefix=s"               => \$digitprefix,
                   "digitnames!"             => \$digitnames,
+
                   "digitnames!"                 => \$digitnames,
                   "channeldigits=i"         => \$channeldigits,
+
                   "channeldigits=i"             => \$channeldigits,
                   "channeltransform=s"       => \$channeltransform,
+
                   "channeltransform=s"           => \$channeltransform,
                   "remote=s"                 => \$remote,
+
                   "remote=s"                     => \$remote,
                   "cf|configfilename=s"     => sub { processConfig(@_[1]) },
+
                   "cf|configfilename=s"         => sub { processConfig(@_[1]) },
                   "locktype=s"               => \$lockType,
+
                   "locktype=s"                   => \$locktype,
                   "lockfilename=s"           => \$lockFile,
+
                   "lockfilename=s"               => \$lockfile,
  "lockkey=i"               => \$lockSemKey,
+
  "lockkey=o"                    => \$locksemkey,
                   "irsend=s"                 => \$irsend,
+
                  "lockperm=o"                  => \$lockperm,
  "help!"                   => \$help,
+
                  "lockfinegrained!"             => \$lockfinegrain,
                   "debug!"                   => \$debug))
+
                  "precmd|precommand=s"          => \@precmds,
 +
                  "postcmd|postcommand=s"        => \@postcmds,
 +
                   "irsend=s"                     => \$irsend,
 +
  "help!"                       => \$help,
 +
                   "debug!"                       => \$debug))
 
   {
 
   {
 
     exit 1;
 
     exit 1;
Line 171: Line 211:
  
 
     Options:
 
     Options:
             --help                         Print help
+
             --help                 Print help.
             --debug                         Print additional debugging info
+
             --debug                 Print additional debugging info.
             --configfilename=               Read configuration options from file
+
             --configfilename=       Read configuration options from a
                                            (alt name is cf) default is none.
+
                                    file (alt name is cf). Default i
                                            *usually* the configfilename option
+
                                    no file.  *Usually* this options
                                            should be specified first (so that
+
                                    should be specified first (so that
                                            one can override any specifications).
+
                                    overrides can be specified).
             --remote=                       Remote name for irsend (Reqd)
+
             --remote=               Remote name for irsend (Reqd).
             --transmitter=                 Transmitter to set (multiple allowed).
+
             --transmitter=         Transmitter to set (multiple allowed)    
                                            default is none specified.
+
                                    Default is none specified.
             --beforekeys=                   Keys to send before channel numbers.
+
             --beforekeys=           Keys to send before channel numbers.
                                            specified as a string of keys ("exit exit")
+
                                    Multiple allowed, or can be
                                            default is none.
+
                                    specified as a string of keys  
             --afterkeys=                   Keys to send after channel numbers.
+
                                    (ex: "exit exit").  Default is none.
                                            specified as a string of keys ("enter enter")
+
             --afterkeys=           Keys to send after channel numbers.
                                            default is none.
+
                                    Multiple allowed, or can be
             --delay=                       Delay after key sends (can be fractional).
+
                                    specified as a string of keys
                                            Global settingdefault is no delay.
+
                                    (ex: "enter end").  Default is none.
             --tdelay=                       Delay after set_transmitter (can be fractional).
+
             --delay=               Delay after key sends (can be  
                                            default is delay value.
+
                                    fractional).  Default is 0.
             --bdelay=                       Delay after each before key (can be fractional).
+
             --tdelay=               Delay after set_transmitter (can
                                            default is delay value.
+
                                    be fractional). Default is 0.
             --adelay=                       Delay after each after key (can be fractional).
+
             --bdelay=               Delay after each before key
                                            default is delay value.
+
                                    (can be fractional).
             --ddelay=                       Delay after each digit key (can be fractional).
+
                                    Default is delay value.
                                            default is delay value.
+
             --adelay=               Delay after each after key
             --rdelay=                       Delay between repeated keys (can be fractional)
+
                                    (can be fractional).
                                            if needed by receiver to discriminate between
+
                                    Default is delay value.
                                            two identical key presses (compensate for receiver
+
             --ddelay=               Delay after each digit key  
                                            bounce compensation detection).
+
                                    (can be fractional).
                                            default is 0.
+
                                    Default is delay value.
             --idelay=                       Delay after initialization (and acquiring lock)
+
             --rdelay=               Delay between repeated keys  
             --edelay=                       Delay before exit (and releasing lock)
+
                                    (can be fractional)
             --device=                       --device=<s> for irsend.
+
                                    if needed by receiver to
                                            default is irsend default.
+
                                    discriminate between two identical
             --address=                     --address=<s> for irsend.
+
                                    key presses (compensate for receiver
                                            default is irsend default.
+
                                    bounce compensation detection).
             --channeldigits=               Some STBs will change the channel
+
                                    Default is 0.
                                            faster if the exact number of
+
             --idelay=               Delay after initialization (and  
                                            digits are sent with leading 0s.
+
                                    acquiring lock).  Default is 0.
                                            default is none.
+
             --edelay=               Delay before exit (and releasing
             --channeltransform=             Channel digit transform routine.
+
                                    lock).  Default is 0.
                                            Mythtv allows one to send a string
+
             --device=               --device=<s> for irsend.
                                            for the channel number.  This
+
                                    Default is irsend default.
                                            routine would transform the string
+
             --address=             --address=<s> for irsend.
                                            into keys for irsend.
+
                                    Default is irsend default.
             --digitprefix=                 Some remotes have now renamed and
+
             --channeldigits=       Some STBs will change the channel
                                            prefixed the channel key names with
+
                                    faster if the exact number of
                                            (usually) KEY_.  Specify
+
                                    digits are sent with leading 0s.
                                            --digitprefix=KEY_ for
+
                                    Default is none.
                                            those.  NOTE: This *only* applies
+
             --channeltransform=     Channel digit transform routine.
                                            to the channel digits (i.e.
+
                                    Mythtv allows one to send a string
                                            '0' is changed to 'key_0').
+
                                    for the channel number.  This
                                            default is no prefix.
+
                                    routine would transform the string
             --digitnames                   Convert digits to names (i.e. 1 -> One).
+
                                    into keys for irsend.
                                            default is no.
+
             --digitprefix=         Some remotes have now renamed and
             --locktype=                     'none', 'file', or 'semaphore' (the default)
+
                                    prefixed the channel key names with
                                            specifies the type of locking to perform.
+
                                    (usually) KEY_.  Specify
             --lockfile=                     The lockfile name for locktype 'file'.
+
                                    --digitprefix=KEY_ for
                                            default '/tmp/ChannelChanger.lockfile'.
+
                                    those.  NOTE: This *only* applies
             --lockkey=                     The semaphore number for locktype 'semaphore'.
+
                                    to the channel digits (i.e.
                                            default 727522346 ("arbitrary" value).
+
                                    '0' would be changed to 'KEY_0').
             --irsend=                       The lirc irsend executable binary.
+
                                    Default is no prefix.
                                            default is 'irsend' which will search PATH
+
             --digitnames           Convert digits to names  
 +
                                    (i.e. 1 -> One). Default is no
 +
                                    conversion.
 +
             --locktype=             'none', 'file', or 'semaphore' and
 +
                                    specifies the type of locking to
 +
                                    perform.  Default is 'semaphore'.
 +
             --lockfilename=         The lockfile name for locktype
 +
                                    'file'. The default is
 +
                                    '/tmp/LircChannelChanger.lock'.
 +
             --lockkey=             The semaphore value for locktype
 +
                                    'semaphore'. Default 727522346
 +
                                    (an "arbitrary" value).
 +
             --lockperm=            The lockfile/semaphore permissions.
 +
                                    Default is 0777.
 +
            --lockfinegrained      Implement a fine grained locking
 +
                                    process where rather than locking
 +
                                    over the entire execution, the lock
 +
                                    is only obtained during the lirc
 +
                                    activities (results in numerous
 +
                                    lock/unlock activities), allowing,
 +
                                    in theory, greater parallelism of
 +
                                    channel tuning.  Except in the
 +
                                    case of (extremely) long delay
 +
                                    values, this is usually not
 +
                                    necessary, and is not recommended
 +
                                    (due to increased overheads, and
 +
                                    the possibility of additional lock
 +
                                    contention).
 +
            --precommand=          System commands (multiple allowed),
 +
                                    usually quoted, to issue before
 +
                                    locking and irsend commands.
 +
                                    Ex: "power_up_stb".
 +
            --postcommand=         System commands (multiple allowed),
 +
                                    usually quoted, to issue after lock
 +
                                    release and before returning to
 +
                                    caller.  Ex: "/bin/sleep 2".
 +
                                    (might be useful where something
 +
                                    like HDPVR needs time to sync with
 +
                                    new source type).
 +
            --irsend=              The lirc irsend executable binary.
 +
                                    Default is 'irsend' which will
 +
                                    search PATH.
  
 
       Note that option names can be abbreviated to the shortest unique name,
 
       Note that option names can be abbreviated to the shortest unique name,
Line 317: Line 398:
 
       }
 
       }
 
   }
 
   }
if (("$lockType" ne 'none') && ("$lockType" ne 'semaphore') && ("$lockType" ne 'file'))
+
if (("$locktype" ne 'none') && ("$locktype" ne 'semaphore') && ("$locktype" ne 'file'))
 
   {
 
   {
 
     print "The locktype must be none, file, or semaphore\n";
 
     print "The locktype must be none, file, or semaphore\n";
 
     exit 1;
 
     exit 1;
 
   }
 
   }
if (defined($lockSemKey) && ($lockSemKey < 0))
+
if (defined($locksemkey) && ($locksemkey < 0))
 
   {
 
   {
 
     print "The lockkey value must be positive\n";
 
     print "The lockkey value must be positive\n";
Line 354: Line 435:
 
#
 
#
 
$delay = 0 if (!defined($delay));
 
$delay = 0 if (!defined($delay));
$tdelay = $delay if (!defined($tdelay));
 
 
$bdelay = $delay if (!defined($bdelay));
 
$bdelay = $delay if (!defined($bdelay));
 
$adelay = $delay if (!defined($adelay));
 
$adelay = $delay if (!defined($adelay));
Line 362: Line 442:
 
# Build up irsend options string
 
# Build up irsend options string
 
#
 
#
$options .= " --address=$address" if (defined($address) && ("$address" ne ''));
+
$irsendoptions .= " --address=$address" if (defined($address) && ("$address" ne ''));
$options .= " --device=$device" if (defined($device) && ("$device" ne ''));
+
$irsendoptions .= " --device=$device" if (defined($device) && ("$device" ne ''));
  
 
#
 
#
# Try to prevent multiple processes using the IR transciever
+
# Create our locks early (early exit if we can not do so)
 
#
 
#
if (!lockGet())
+
lockCreate();
  {
 
    print "Unable to aquire lock on $lockFile\n";
 
    exit 1;
 
  }
 
  
 
#
 
#
# If requested, sleep at initialization
+
# Process pre commands (issued before ir locking)
 
#
 
#
if ($idelay != 0)
+
foreach (@precmds)
 
   {
 
   {
     print STDERR "sleeping $idelay after lockGet and before lirc operations\n" if($debug);
+
     cmd("$_");
    sleep($idelay);
 
 
   }
 
   }
  
 
#
 
#
# If transmitters specified, set them
+
# Try to prevent multiple processes using the IR transciever
 +
# by obtaining a lock (if not doing fined grained locking)
 
#
 
#
if (scalar(@transmitters) > 0)
+
if ($lockfinegrain == 0)
 
   {
 
   {
     my $emitters = join(' ', @transmitters);
+
     if (!lockGet())
    print STDERR "Issuing $irsend $options SET_TRANSMITTERS $emitters\n" if ($debug);
 
    system "$irsend $options SET_TRANSMITTERS $emitters";
 
    if ($? == 0)
 
 
       {
 
       {
         print STDERR "$irsend child exited with value $?\n" if ($debug);
+
         print "Unable to aquire lock\n";
      }
+
         exit 1;
    elsif ($? == -1)
 
      {
 
        print STDERR "failed to execute $irsend: $!\n";
 
      }
 
    elsif ($? & 127)
 
      {
 
         printf STDERR "$irsend child died with signal %d, %s coredump\n",
 
            ($? & 127),  ($? & 128) ? 'with' : 'without';
 
 
       }
 
       }
 
     else
 
     else
 
       {
 
       {
         printf STDERR "$irsend child exited with value %d\n", $? >> 8;
+
         printf STDERR "Lock acquired\n" if($debug);
      }
 
    if ($tdelay != 0)
 
      {
 
        print STDERR "adding $tdelay to delay accumulator after set_transmitters\n" if ($debug);
 
        $delayaccum += $tdelay
 
 
       }
 
       }
 
   }
 
   }
 +
 +
#
 +
# If requested, sleep at initialization
 +
#
 +
delayAccumulate($idelay, "due to initialization");
  
 
#
 
#
 
# Send the before keys, if any specified
 
# Send the before keys, if any specified
 
#
 
#
if (defined($before) && ("$before" ne ''))
+
foreach $key (@before)
 
   {
 
   {
     foreach $key (split(/ /,$before))
+
     delayAccumulate($rdelay, "due to repeated key") if ("$key" eq "$prevkey");
      {
+
    delaySleep();
        if (($rdelay != 0) && ("$key" eq "$prevkey"))
+
    irsend("SEND_ONCE $remote $key");
          {
+
    $prevkey = "$key";
            print STDERR "adding $rdelay to delay accumulator due to repeated key\n" if ($debug);
+
    delayAccumulate($bdelay, "after before key");
            $delayaccum += $rdelay;
 
          }
 
        if ($delayaccum != 0)
 
          {
 
            print STDERR "sleeping for the accumulated delay $delayaccum\n" if($debug);
 
            sleep ($delayaccum);
 
            $delayaccum = 0;
 
          }
 
        print STDERR "Issuing $irsend $options SEND_ONCE $remote $key\n" if($debug);
 
        system "$irsend $options SEND_ONCE $remote $key";
 
        if ($? == 0)
 
          {
 
            print STDERR "$irsend child exited with value $?\n" if ($debug);
 
          }
 
        elsif ($? == -1)
 
          {
 
            print STDERR "failed to execute $irsend: $!\n";
 
          }
 
        elsif ($? & 127)
 
          {
 
            printf STDERR "$irsend child died with signal %d, %s coredump\n",
 
                ($? & 127),  ($? & 128) ? 'with' : 'without';
 
          }
 
        else
 
          {
 
            printf STDERR "$irsend child exited with value %d\n", $? >> 8;
 
          }
 
        $prevkey = "$key";
 
        if ($bdelay != 0)
 
          {
 
            print STDERR "adding $bdelay to delay accumulator after before key\n" if($debug);
 
            $delayaccum += $bdelay;
 
          }
 
      }
 
 
   }
 
   }
  
Line 505: Line 536:
 
               }
 
               }
 
             $digit = "$digitprefix" . $digit if (defined($digitprefix));
 
             $digit = "$digitprefix" . $digit if (defined($digitprefix));
             if (($rdelay != 0) && ("$digit" eq "$prevkey"))
+
             delayAccumulate($rdelay, "due to repeated key") if ("$digit" eq "$prevkey");
              {
+
            delaySleep();
                print STDERR "adding $rdelay to delay accumulator due to repeated key\n" if ($debug);
+
             irsend("SEND_ONCE $remote $digit");
                $delayaccum += $rdelay;
 
              }
 
            if ($delayaccum != 0)
 
              {
 
                print STDERR "sleeping for the accumulated delay $delayaccum\n" if($debug);
 
                sleep ($delayaccum);
 
                $delayaccum = 0;
 
              }
 
             print STDERR "Issuing $irsend $options SEND_ONCE $remote $digit\n" if ($debug);
 
            system "$irsend $options SEND_ONCE $remote $digit";
 
            if ($? == 0)
 
              {
 
                print STDERR "$irsend child exited with value $?\n" if ($debug);
 
              }
 
            elsif ($? == -1)
 
              {
 
                print STDERR "failed to execute $irsend: $!\n";
 
              }
 
            elsif ($? & 127)
 
              {
 
                printf STDERR "$irsend child died with signal %d, %s coredump\n",
 
                    ($? & 127),  ($? & 128) ? 'with' : 'without';
 
              }
 
            else
 
              {
 
                printf STDERR "$irsend child exited with value %d\n", $? >> 8;
 
              }
 
 
             $prevkey = "$digit";
 
             $prevkey = "$digit";
             if ($ddelay != 0)
+
             delayAccumulate($ddelay, "after digit key");
              {
 
                print STDERR "adding $ddelay to delay accumulator after digit key\n" if($debug);
 
                $delayaccum += $ddelay;
 
              }
 
 
           }
 
           }
 
       }
 
       }
 
     else
 
     else
 
       {
 
       {
         if (($rdelay != 0) && ("$key" eq "$prevkey"))
+
         delayAccumulate($rdelay, "due to repeated key") if ("$key" eq "$prevkey");
          {
+
        delaySleep();
            print STDERR "adding $rdelay to delay accumulator due to repeated key\n" if ($debug);
+
         irsend("SEND_ONCE $remote $key");
            $delayaccum += $rdelay;
 
          }
 
        if ($delayaccum != 0)
 
          {
 
            print STDERR "sleeping for the accumulated delay $delayaccum\n" if($debug);
 
            sleep ($delayaccum);
 
            $delayaccum = 0;
 
          }
 
         print STDERR "Issuing $irsend $options SEND_ONCE $remote $key\n" if($debug);
 
        system "$irsend $options SEND_ONCE $remote $key";
 
        if ($? == 0)
 
          {
 
            print STDERR "$irsend child exited with value $?\n" if ($debug);
 
          }
 
        elsif ($? == -1)
 
          {
 
            print STDERR "failed to execute $irsend: $!\n";
 
          }
 
        elsif ($? & 127)
 
          {
 
            printf STDERR "$irsend child died with signal %d, %s coredump\n",
 
                ($? & 127),  ($? & 128) ? 'with' : 'without';
 
          }
 
        else
 
          {
 
            printf STDERR "$irsend child exited with value %d\n", $? >> 8;
 
          }
 
 
         $prevkey = "$key";
 
         $prevkey = "$key";
         if ($ddelay != 0)
+
         delayAccumulate($ddelay, "after digit key");
          {
 
            print STDERR "adding $ddelay to delay accumulator after digit key\n" if($debug);
 
            $delayaccum += $ddelay;
 
          }
 
 
       }
 
       }
 
   }
 
   }
Line 587: Line 556:
 
# Send the after keys, if any specified
 
# Send the after keys, if any specified
 
#
 
#
if (defined($after) && ("$after" ne ''))
+
foreach $key (@after)
 +
  {
 +
    delayAccumulate($rdelay, "due to repeated key") if ("$key" eq "$prevkey");
 +
    delaySleep();
 +
    irsend("SEND_ONCE $remote $key");
 +
    $prevkey = "$key";
 +
    delayAccumulate($adelay, "after after key");
 +
  }
 +
 
 +
#
 +
# If requested, sleep before exiting (but zero accumulator)
 +
#
 +
if ($delayaccum != 0)
 
   {
 
   {
     foreach $key (split(/ /,$after))
+
     printf STDERR "zeroing delay accumulator after lirc commands\n" if ($debug);
      {
+
    $delayaccum = 0;
        if (($rdelay != 0) && ("$key" eq "$prevkey"))
 
          {
 
            print STDERR "adding $rdelay to delay accumulator due to repeated key\n" if ($debug);
 
            $delayaccum += $rdelay;
 
          }
 
        if ($delayaccum != 0)
 
          {
 
            print STDERR "sleeping for the accumulated delay $delayaccum\n" if($debug);
 
            sleep ($delayaccum);
 
            $delayaccum = 0;
 
          }
 
        print STDERR "Issuing $irsend $options SEND_ONCE $remote $key\n" if($debug);
 
        system "$irsend $options SEND_ONCE $remote $key";
 
        if ($? == 0)
 
          {
 
            print STDERR "$irsend child exited with value $?\n" if ($debug);
 
          }
 
        elsif ($? == -1)
 
          {
 
            print STDERR "failed to execute $irsend: $!\n";
 
          }
 
        elsif ($? & 127)
 
          {
 
            printf STDERR "$irsend child died with signal %d, %s coredump\n",
 
                ($? & 127),  ($? & 128) ? 'with' : 'without';
 
          }
 
        else
 
          {
 
            printf STDERR "$irsend child exited with value %d\n", $? >> 8;
 
          }
 
        $prevkey = "$key";
 
        if ($adelay != 0)
 
          {
 
            print STDERR "adding $adelay to delay accumulator after after key\n" if($debug);
 
            $delayaccum += $adelay;
 
          }
 
      }
 
 
   }
 
   }
 +
delayAccumulate($edelay, "due to exit");
 +
delaySleep();
  
 
#
 
#
# If requested, sleep before exiting
+
# IR operations complete, release the lock (if not fine grained locking)
 
#
 
#
if ($edelay != 0)
+
if ($lockfinegrain == 0)
 
   {
 
   {
     print STDERR "sleeping $edelay before lockFree and exit\n" if($debug);
+
     if (!lockFree())
    sleep($edelay);
+
      {
 +
        print "Unable to free lock\n";
 +
        exit 1;
 +
      }
 +
    else
 +
      {
 +
        printf STDERR "Lock freed\n" if($debug);
 +
      }
 
   }
 
   }
  
 
#
 
#
# IR operations complete, release the lock
+
# Process post commands (issued after ir unlocking)
 
#
 
#
lockFree();
+
foreach (@postcmds)
 +
  {
 +
    cmd("$_");
 +
  }
  
 
#
 
#
Line 650: Line 606:
  
  
 +
 +
#
 +
# lockCreate
 +
#
 +
sub lockCreate
 +
  {
 +
    printf STDERR "lockCreate for lock type $locktype\n" if ($debug);
 +
    return 1 if ("$locktype" eq 'none');
 +
    if ("$locktype" eq 'semaphore')
 +
      {
 +
        printf STDERR "Creating lock semaphore %i (0x%x)\n", ($locksemkey, $locksemkey) if ($debug);
 +
        $locksem = IPC::Semaphore->new($locksemkey, 3, ($lockperm & 0666) | S_IRUSR | S_IWUSR | IPC_CREAT);
 +
        if (!defined($locksem))
 +
          {
 +
            printf "Unable to create lock semaphore %i (0x%x): $!\n", ($locksemkey, $locksemkey);
 +
            exit 1;
 +
          }
 +
        return 1;
 +
      }
 +
    else
 +
      {
 +
        my ($fname, $dir) = fileparse("$lockfile");
 +
        if ("$fname" eq '')
 +
          {
 +
            print "Specified lockfile $lockfile is a path only\n";
 +
            exit 1;
 +
          }
 +
        my $umask;
 +
        my $err;
 +
        $umask=umask();
 +
        umask(0);
 +
        print STDERR "Creating lockfile directory $dir\n" if ($debug);
 +
        make_path("$dir", {verbose => 0, mode => $lockperm, error => \$err});
 +
        umask($umask);
 +
        if (@$err)
 +
          {
 +
            for my $diag (@$err)
 +
              {
 +
                my ($file, $message) = %$diag;
 +
                if ($file eq '')
 +
                  {
 +
                    print "Error while attempting to create directory $dir: $message\n";
 +
                  }
 +
                else
 +
                  {
 +
                    print "Error while attempting to create directory $file: $message\n";
 +
                  }
 +
              }
 +
            exit 1;
 +
          }
 +
        $umask=umask();
 +
        umask(0);
 +
        print STDERR "Creating lockfile $lockfile\n" if ($debug);
 +
        if (!(sysopen($lockFH, "$lockfile", (O_CREAT | O_RDWR | O_LARGEFILE) , $lockperm)))
 +
          {
 +
            print "Unable to create lockfile $lockfile: $!\n";
 +
            umask($umask);
 +
            exit 1;
 +
          }
 +
        umask($umask);
 +
        close($lockFH);
 +
        return 1;
 +
      }
 +
  }
  
 
#
 
#
Line 656: Line 676:
 
sub lockGet
 
sub lockGet
 
   {
 
   {
     return 1 if ("$lockType" eq 'none');
+
    printf STDERR "lockGet for lock type $locktype\n" if ($debug);
     if ("$lockType" eq 'semaphore')
+
     return 1 if ("$locktype" eq 'none');
 +
     if ("$locktype" eq 'semaphore')
 
       {
 
       {
        $lockSem = IPC::Semaphore->new($lockSemKey, 3, S_IRUSR | S_IWUSR | IPC_CREAT);
 
 
         my $i;
 
         my $i;
         for ($i=0; $i<30; $i++)
+
         for ($i=0; $i<$lockattempts; $i++)
 
           {
 
           {
 
             # Use IPC::Shareable / IPC::ShareLite semaphore protocol
 
             # Use IPC::Shareable / IPC::ShareLite semaphore protocol
             return 1 if ($lockSem->op(1, 0, IPC_NOWAIT,                  # Check for no readers
+
             if ($locksem->op(1, 0, IPC_NOWAIT,                  # Check for no readers
                                      2, 0, IPC_NOWAIT,                  # Check for no writers
+
                            2, 0, IPC_NOWAIT,                  # Check for no writers
                                      2, 1, (SEM_UNDO | IPC_NOWAIT)))# Acquire write lock
+
                            2, 1, (SEM_UNDO | IPC_NOWAIT)))   # Acquire write lock
 +
              {
 +
                $lockobtained = 1;
 +
                return 1;
 +
              }
 
             print STDERR "Waiting for lock....\n" if ($debug);
 
             print STDERR "Waiting for lock....\n" if ($debug);
             sleep 1;
+
             sleep($lockwait);
 
           }
 
           }
 
         return 0;
 
         return 0;
Line 674: Line 698:
 
     else
 
     else
 
       {
 
       {
        mkdir(dirname("$lockFile")) if (! -d dirname("$lockFile"));
+
         if (open($lockFH, "+<$lockfile"))
         if (open($lockFH, ">$lockFile"))
 
 
           {
 
           {
 
             my $i;
 
             my $i;
             for ($i=0; $i<30; $i++)
+
             for ($i=0; $i<$lockattempts; $i++)
 
               {
 
               {
                 return 1 if (flock($lockFH, LOCK_EX | LOCK_NB));
+
                 if (flock($lockFH, LOCK_EX | LOCK_NB))
 +
                  {
 +
                    $lockobtained = 1;
 +
                    return 1;
 +
                  }
 
                 print STDERR "Waiting for lock.....\n" if ($debug);
 
                 print STDERR "Waiting for lock.....\n" if ($debug);
                 sleep 1;
+
                 sleep($lockwait);
 
               }
 
               }
 +
            return 0;
 
           }
 
           }
 +
        print STDERR "Unable to open lockfile $lockfile: $!\n" if ($debug);
 
         return 0;
 
         return 0;
 
       }
 
       }
Line 694: Line 723:
 
sub lockFree
 
sub lockFree
 
   {
 
   {
     return 1 if ("$lockType" eq 'none');
+
    printf STDERR "lockFree for lock type $locktype\n" if ($debug);
     if ("$lockType" eq 'semaphore')
+
     return 1 if ("$locktype" eq 'none');
 +
     if ("$locktype" eq 'semaphore')
 
       {
 
       {
         $lockSem->op(2, -1, (SEM_UNDO | IPC_NOWAIT));
+
         $locksem->op(2, -1, (SEM_UNDO | IPC_NOWAIT));
 +
        $lockobtained = 0;
 
         return 1;
 
         return 1;
 
       }
 
       }
Line 706: Line 737:
 
             flock($lockFH, LOCK_UN);
 
             flock($lockFH, LOCK_UN);
 
             close($lockFH);
 
             close($lockFH);
 +
            undef $lockFH;
 
           }
 
           }
 +
        $lockobtained = 0;
 
         return 1;
 
         return 1;
 
       }
 
       }
 +
  }
 +
 +
#
 +
# cmd
 +
#
 +
sub cmd
 +
  {
 +
    my $cmd = shift;
 +
    print STDERR "Issuing system command: $cmd\n" if ($debug);
 +
    system("$cmd");
 +
    if ($? == 0)
 +
      {
 +
        print STDERR "  child exited with value $?\n" if ($debug);
 +
      }
 +
    elsif ($? == -1)
 +
      {
 +
        print STDERR "  failed to execute $cmd: $!\n";
 +
      }
 +
    elsif ($? & 127)
 +
      {
 +
        printf STDERR "  child died with signal %d, %s coredump\n",
 +
            ($? & 127),  ($? & 128) ? 'with' : 'without';
 +
      }
 +
    else
 +
      {
 +
        printf STDERR "  child exited with value %d\n", $? >> 8;
 +
      }
 +
    return $?;
 +
}
 +
 +
#
 +
# irsend
 +
#
 +
sub irsend
 +
  {
 +
    my $ircmd = shift;
 +
    my $rc = 0;
 +
    delaySleep();
 +
    # Are we doing fine grained locking?
 +
    if ($lockfinegrain != 0)
 +
      {
 +
        # Fine grained locking, we need to acquire the lock,
 +
        # (re)issue the SET_TRANSMITTERS, issue the irsend
 +
        # command, and then release the lock.
 +
 +
        if (!lockGet())
 +
          {
 +
            print "Unable to aquire lock\n";
 +
            exit 1;
 +
          }
 +
        else
 +
          {
 +
            printf STDERR "Lock acquired\n" if($debug);
 +
          }
 +
 +
        if (scalar(@transmitters) > 0)
 +
          {
 +
            my $emitters = join(' ', @transmitters);
 +
            cmd("$irsend $irsendoptions SET_TRANSMITTERS $emitters");
 +
            delayAccumulate($tdelay, "after set_transmitters");
 +
          }
 +
 +
        delaySleep();
 +
        $rc = cmd("$irsend $irsendoptions $ircmd");
 +
 +
        if (!lockFree())
 +
          {
 +
            print "Unable to free lock\n";
 +
            exit 1;
 +
          }
 +
        else
 +
          {
 +
            printf STDERR "Lock freed\n" if($debug);
 +
          }
 +
 +
      }
 +
    else
 +
      {
 +
        # No fine grained locking.  Just issue the irsend
 +
        if (($irsendxmitter == 0) && (scalar(@transmitters) > 0))
 +
          {
 +
            # Issue set transmitters if we have not yet done so
 +
            my $emitters = join(' ', @transmitters);
 +
            delaySleep();
 +
            cmd("$irsend $irsendoptions SET_TRANSMITTERS $emitters");
 +
            delayAccumulate($tdelay, "after set_transmitters");
 +
            $irsendxmitter = 1;
 +
          }
 +
        delaySleep();
 +
        $rc = cmd("$irsend $irsendoptions $ircmd");
 +
      }
 +
    return $rc;
 +
  }
 +
 +
#
 +
# delaySleep - sleep for the accumulated delay (if any)
 +
#
 +
sub delaySleep
 +
  {
 +
    return 0 if ($delayaccum == 0);
 +
    print STDERR "sleeping for the accumulated delay $delayaccum\n" if($debug);
 +
    sleep($delayaccum);
 +
    $delayaccum = 0;
 +
  }
 +
 +
#
 +
# delayAccumulate - Add in additional delay
 +
#
 +
sub delayAccumulate
 +
  {
 +
    my $delay = shift;
 +
    my $reason = shift;
 +
    return 0 if ($delay == 0);
 +
    print STDERR "adding $delay to delay accumulator: $reason\n" if ($debug);
 +
    $delayaccum += $delay;
 +
    return $delay;
 
   }
 
   }
  
Line 725: Line 874:
 
       {
 
       {
 
         my $options = '';
 
         my $options = '';
 +
        printf STDERR "Opening configuration file $cf\n" if ($debug);
 
         if (open(FH,"<$cf"))
 
         if (open(FH,"<$cf"))
 
           {
 
           {
Line 744: Line 894:
 
           {
 
           {
 
             if (!GetOptionsFromString($options,
 
             if (!GetOptionsFromString($options,
                   "device=s"                 => \$device,
+
                   "device=s"                     => \$device,
                   "address=s"               => \$address,
+
                   "address=s"                   => \$address,
                   "delay=f"                 => \$delay,
+
                   "delay=f"                     => \$delay,
                   "tdelay=f"                 => \$tdelay,
+
                   "tdelay=f"                     => \$tdelay,
                   "bdelay=f"                 => \$bdelay,
+
                   "bdelay=f"                     => \$bdelay,
                   "adelay=f"                 => \$adelay,
+
                   "adelay=f"                     => \$adelay,
                   "ddelay=f"                 => \$ddelay,
+
                   "ddelay=f"                     => \$ddelay,
                   "rdelay=f"                 => \$rdelay,
+
                   "rdelay=f"                     => \$rdelay,
                   "idelay=f"                 => \$idelay,
+
                   "idelay=f"                     => \$idelay,
                   "edelay=f"                 => \$edelay,
+
                   "edelay=f"                     => \$edelay,
                   "xmitters|transmitters=i" => \@transmitters,
+
                   "xmitter|transmitter=i"       => \@transmitters,
                   "beforekeys=s"             => \$before,
+
                   "beforekeys=s"                 => sub { push @before, split(' ', (@_[1]))},
                   "afterkeys=s"             => \$after,
+
                   "afterkeys=s"                 => sub { push @after, split(' ', (@_[1]))},
                   "digitprefix=s"           => \$digitprefix,
+
                   "digitprefix=s"               => \$digitprefix,
                   "digitnames!"             => \$digitnames,
+
                   "digitnames!"                 => \$digitnames,
                   "channeldigits=i"         => \$channeldigits,
+
                   "channeldigits=i"             => \$channeldigits,
                   "channeltransform=s"       => \$channeltransform,
+
                   "channeltransform=s"           => \$channeltransform,
                   "remote=s"                 => \$remote,
+
                   "remote=s"                     => \$remote,
                   "locktype=s"               => \$lockType,
+
                  "cf|configfilename=s"          => sub { processConfig(@_[1]) },
                   "lockfilename=s"           => \$lockFile,
+
                   "locktype=s"                   => \$locktype,
                   "lockkey=i"               => \$lockSemKey,
+
                   "lockfilename=s"               => \$lockfile,
                   "irsend=s"                 => \$irsend,
+
                   "lockkey=o"                    => \$locksemkey,
                   "debug!"                   => \$debug))
+
                  "lockperm=o"                  => \$lockperm,
 +
                  "lockfinegrained!"             => \$lockfinegrain,
 +
                  "precmd|precommand=s"          => \@precmds,
 +
                  "postcmd|postcommand=s"        => \@postcmds,
 +
                   "irsend=s"                     => \$irsend,
 +
                   "debug!"                       => \$debug))
 
               {
 
               {
 
                 exit 1;
 
                 exit 1;
Line 782: Line 937:
 
}}
 
}}
  
{{Code box|Configuration file example - Comcast Motorola/Pace DTA|
+
 
 +
 
 +
 
 +
An example configuration file for a Comcast Motorola/Pace DTA:
 +
 
 +
{{Code box|LircChannelChanger-DTA|
 
<pre>
 
<pre>
 
#
 
#
Line 793: Line 953:
 
#
 
#
 
# The main reason for supporting a configfile is
 
# The main reason for supporting a configfile is
# that the command line for the ChannelChanger script
+
# that the command line for the LircChannelChanger script
 
# could exceed the 128 character (database) size limits
 
# could exceed the 128 character (database) size limits
 
# if many options were specified (and fully typed out).
 
# if many options were specified (and fully typed out).
Line 812: Line 972:
 
</pre>
 
</pre>
 
}}
 
}}
 +
 +
 +
 +
 +
An example definition in mythtv to invoke the script using the example configuration file:
 +
 +
 +
  /home/mythtv/bin/LircChannelChanger --cf=/home/mythtv/etc/LircChannelChanger-DTA --xmitter 1
 +
 +
  
 
[[Category:Channel Change Scripts]]
 
[[Category:Channel Change Scripts]]

Revision as of 18:47, 12 October 2012


Author Gary Buhrmaster
Description Lirc Channel Change script with extensive configuration options
Supports Version25.png  Version251.png Version252.png Version26.png 



LircChannelChanger is a script that performs channel changing via lirc. It is designed to provide flexible configuration options to support many of the requirements of a channel changing script that uses lirc.


The definitive source location for this script is located on github


The script:


Script.png LircChannelChanger

#!/usr/bin/perl

#
# LircChannelChanger - Version 0.4 - 2012/08/08
#

#
# Copyright (c) 2009-2012 Gary Buhrmaster <gary.buhrmaster@gmail.com>
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#

#
# Channel Changing script for mythtv and lirc
#
# There are a lot of channel changing scripts for mythtv and lirc,
# this one differs in its ability to support more flexible options
# from the command line, allowing one script to do the work of many.
# It also supports locking, to insure that only one channel changer
# is being run at once (this is important with multiple tuners and
# with multiple programs independently running/changing channels
# since irsend "SET_TRANSMITTERS" is global).
# 

#
# Our perl dependencies
#
use strict;
use Fcntl qw(:DEFAULT :flock);
use IPC::SysV qw(SEM_UNDO IPC_PRIVATE IPC_NOWAIT S_IRUSR S_IWUSR IPC_CREAT);
use IPC::Semaphore;
use Getopt::Long qw(GetOptions GetOptionsFromString);
use Time::HiRes qw (sleep);
use FindBin qw($Bin $Script);
use File::Basename;
use File::Path qw(make_path);

#
# locktype can be either semaphore or file or none.
# semaphore only tested for linux (which has
# semaphore cleanup protections).  None is not
# recommended (since running multiple apps using
# lirc is going to eventually cause confusion).
#
my $locktype      = 'semaphore';
my $lockwait      = 0.5;             # Time to wait if locking fails
my $lockattempts  = 60;              # Number of attempts to obtain lock
my $lockfile      = '/tmp/LircChannelChanger.lock';
my $lockFH;
my $locksemkey    = 727522346;       # "Random" value for key
my $locksem;
my $lockperm      = 0777;            # Default lock file/semaphore permissions
my $lockfinegrain = 0;               # Fine Grained locking
my $lockobtained  = 0;               # Track locking (for last gasp release)

my @transmitters;                    # Transmitters to send on
my $key;                             # General key variable
my @FREQID;                          # The (possibly transformed) freqid string
my $prevkey       = '';              # Previously issued key
my $device;                          # lirc --device value
my $address;                         # lirc --address value
my $delay;                           # Delay after keys (for all)
my $tdelay        = 0;               # Delay after set_transmitters
my $bdelay;                          # Delay after before keys
my $adelay;                          # Delay after after keys
my $ddelay;                          # Delay after digit keys
my $rdelay        = 0;               # Delay between repeated keys
my $idelay        = 0;               # Delay after initialization (after lock)
my $edelay        = 0;               # Delay before exit (before lock release)
my $delayaccum    = 0;               # Delay accumulated
my @before;                          # Keys to send before channel
my @after;                           # Keys to send after channel
my $digitprefix;                     # Digit Keyname prefix (sometimes key_)
my $digitnames;                      # Use digit names (i.e. 1 -> One)
my $irsendoptions = '';              # Constructed options for irsend
my $debug         = 0;               # Debug messages
my $remote;                          # Remote name
my $channeldigits;                   # Number of channel digits
my $channeltransform;                # Channel number transform routine
my @precmds;                         # Pre lirc commands
my @postcmds;                        # Post lirc commands
my $help          = 0;               # Help?
my $irsend        = 'irsend';        # Lirc irsend program
my $irsendxmitter = 0;               # Set transmitter sent

my %digitname;
   $digitname{0}  = 'Zero'; 
   $digitname{1}  = 'One';
   $digitname{2}  = 'Two';
   $digitname{3}  = 'Three';
   $digitname{4}  = 'Four';
   $digitname{5}  = 'Five';
   $digitname{6}  = 'Six';
   $digitname{7}  = 'Seven';
   $digitname{8}  = 'Eight';
   $digitname{9}  = 'Nine';

#
# END block for freeing lock due to unusual exiting
#
# This *should* not be needed, since locks should be
# properly released at exit.  But better safe ....
#
END
  {
    if ($lockobtained != 0)
      {
        printf STDERR "END block invoked to free locks\n" if($debug);
        if (!lockFree())
          {
            print "Unable to free lock\n";
          }
        else
          {
            printf STDERR "Lock freed\n" if($debug);
          }
      }
    $lockobtained = 0;
  }

#
# Try to insure that signals causes lock freeing
#
# Again, *should* not be needed, since process termination
# is expected to clean up correctly.  But better safe....
#
$SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub { my $sig = shift; die "\nSIG$sig received: $!\n"}; 

#
# Use GetOptions to process the command line options
#
if (!GetOptions ( "device=s"                     => \$device,
                  "address=s"                    => \$address,
                  "delay=f"                      => \$delay,
                  "tdelay=f"                     => \$tdelay,
                  "bdelay=f"                     => \$bdelay,
                  "adelay=f"                     => \$adelay,
                  "ddelay=f"                     => \$ddelay,
                  "rdelay=f"                     => \$rdelay,
                  "idelay=f"                     => \$idelay,
                  "edelay=f"                     => \$edelay,
                  "xmitter|transmitter=i"        => \@transmitters,
                  "beforekeys=s"                 => sub { push @before, split(' ', (@_[1]))},
                  "afterkeys=s"                  => sub { push @after, split(' ', (@_[1]))},
                  "digitprefix=s"                => \$digitprefix,
                  "digitnames!"                  => \$digitnames,
                  "channeldigits=i"              => \$channeldigits,
                  "channeltransform=s"           => \$channeltransform,
                  "remote=s"                     => \$remote,
                  "cf|configfilename=s"          => sub { processConfig(@_[1]) },
                  "locktype=s"                   => \$locktype,
                  "lockfilename=s"               => \$lockfile,
		  "lockkey=o"                    => \$locksemkey,
                  "lockperm=o"                   => \$lockperm,
                  "lockfinegrained!"             => \$lockfinegrain,
                  "precmd|precommand=s"          => \@precmds,
                  "postcmd|postcommand=s"        => \@postcmds,
                  "irsend=s"                     => \$irsend,
		  "help!"                        => \$help,
                  "debug!"                       => \$debug))
  {
    exit 1;
  }

#
# print out script usage for "help" argument or incorrect usage of command
#
if ($help)
  {
    my $usage = <<ECHO;

$Script:
    Script to perform channel changing for mythtv using lirc

    Usage: $Script <options> nnn

    Options:
            --help                  Print help.
            --debug                 Print additional debugging info.
            --configfilename=       Read configuration options from a
                                    file (alt name is cf).  Default i
                                    no file.  *Usually* this options
                                    should be specified first (so that
                                    overrides can be specified).
            --remote=               Remote name for irsend (Reqd).
            --transmitter=          Transmitter to set (multiple allowed)     
                                    Default is none specified.
            --beforekeys=           Keys to send before channel numbers.
                                    Multiple allowed, or can be
                                    specified as a string of keys 
                                    (ex: "exit exit").  Default is none.
            --afterkeys=            Keys to send after channel numbers.
                                    Multiple allowed, or can be
                                    specified as a string of keys
                                    (ex: "enter end").  Default is none.
            --delay=                Delay after key sends (can be 
                                    fractional).  Default is 0.
            --tdelay=               Delay after set_transmitter (can
                                    be fractional).  Default is 0.
            --bdelay=               Delay after each before key
                                    (can be fractional).
                                    Default is delay value.
            --adelay=               Delay after each after key
                                    (can be fractional).
                                    Default is delay value.
            --ddelay=               Delay after each digit key 
                                    (can be fractional).
                                    Default is delay value.
            --rdelay=               Delay between repeated keys 
                                    (can be fractional)
                                    if needed by receiver to
                                    discriminate between two identical
                                    key presses (compensate for receiver
                                    bounce compensation detection).
                                    Default is 0.
            --idelay=               Delay after initialization (and 
                                    acquiring lock).  Default is 0.
            --edelay=               Delay before exit (and releasing
                                    lock).  Default is 0.
            --device=               --device=<s> for irsend.
                                    Default is irsend default.
            --address=              --address=<s> for irsend.
                                    Default is irsend default.
            --channeldigits=        Some STBs will change the channel
                                    faster if the exact number of
                                    digits are sent with leading 0s.
                                    Default is none.
            --channeltransform=     Channel digit transform routine.
                                    Mythtv allows one to send a string
                                    for the channel number.  This
                                    routine would transform the string
                                    into keys for irsend.
            --digitprefix=          Some remotes have now renamed and
                                    prefixed the channel key names with
                                    (usually) KEY_.  Specify
                                    --digitprefix=KEY_ for
                                    those.  NOTE: This *only* applies
                                    to the channel digits (i.e.
                                    '0' would be changed to 'KEY_0').
                                    Default is no prefix.
            --digitnames            Convert digits to names 
                                    (i.e. 1 -> One).  Default is no
                                    conversion.
            --locktype=             'none', 'file', or 'semaphore' and
                                    specifies the type of locking to
                                    perform.  Default is 'semaphore'.
            --lockfilename=         The lockfile name for locktype
                                    'file'.  The default is
                                    '/tmp/LircChannelChanger.lock'.
            --lockkey=              The semaphore value for locktype
                                    'semaphore'.  Default 727522346 
                                    (an "arbitrary" value).
            --lockperm=             The lockfile/semaphore permissions.
                                    Default is 0777.
            --lockfinegrained       Implement a fine grained locking
                                    process where rather than locking
                                    over the entire execution, the lock
                                    is only obtained during the lirc
                                    activities (results in numerous
                                    lock/unlock activities), allowing,
                                    in theory, greater parallelism of
                                    channel tuning.  Except in the
                                    case of (extremely) long delay
                                    values, this is usually not
                                    necessary, and is not recommended
                                    (due to increased overheads, and
                                    the possibility of additional lock
                                    contention).
            --precommand=           System commands (multiple allowed), 
                                    usually quoted, to issue before
                                    locking and irsend commands.
                                    Ex: "power_up_stb".
            --postcommand=          System commands (multiple allowed),
                                    usually quoted, to issue after lock
                                    release and before returning to
                                    caller.  Ex: "/bin/sleep 2".
                                    (might be useful where something
                                    like HDPVR needs time to sync with
                                    new source type).
            --irsend=               The lirc irsend executable binary.
                                    Default is 'irsend' which will
                                    search PATH.

       Note that option names can be abbreviated to the shortest unique name,
       so, for example locktype can be shortened to lockt, since that is the
       shortest unique value.

ECHO
    print $usage;
    exit 1;     
  }

#
# Do some option validation
#

#
# The one mandatory option is "remote"
#
if ((!defined($remote)) || ("$remote" eq ''))
  {
    print "A remote name must be specified\n";
    exit 1;
  }

#
# Do some sanity checking of any other options specified
#
if (defined($delay) && ($delay < 0))
  {
    print "The delay value must be positive\n";
    exit 1;
  }
if (defined($tdelay) && ($tdelay < 0))
  {
    print "The tdelay value must be positive\n";
    exit 1;
  }
if (defined($bdelay) && ($bdelay < 0))
  {
    print "The bdelay value must be positive\n";
    exit 1;
  }
if (defined($adelay) && ($adelay < 0))
  {
    print "The adelay value must be positive\n";
    exit 1;
  }
if (defined($ddelay) && ($ddelay < 0))
  {
    print "The ddelay value must be positive\n";
    exit 1;
  }
if (defined($rdelay) && ($rdelay < 0))
  {
    print "The rdelay value must be positive\n";
    exit 1;
  }
if (defined($idelay) && ($idelay < 0))
  {
    print "The idelay value must be positive\n";
    exit 1;
  }
if (defined($edelay) && ($edelay < 0))
  {
    print "The edelay value must be positive\n";
    exit 1;
  }
if (defined($channeldigits) && (($channeldigits < 0) || ($channeldigits > 10)))
  {
    print "The channeldigits value must be positive and no greater than 10\n";
    exit 1;
  }
if (scalar(@transmitters) > 0)
  {
    foreach (@transmitters)
      {
        if (("$_" !~ /^\d+$/) || ($_ < 1) || ($_ > 32))
          {
            print "The transmitter value must be an integer between 1 and 32 (inclusive)\n";
            exit 1;
          }
      }
  }
if (("$locktype" ne 'none') && ("$locktype" ne 'semaphore') && ("$locktype" ne 'file'))
  {
    print "The locktype must be none, file, or semaphore\n";
    exit 1;
  }
if (defined($locksemkey) && ($locksemkey < 0))
  {
    print "The lockkey value must be positive\n";
    exit 1;
  }
if (defined($channeltransform))
  {
    if (! -e "$channeltransform")
      {
        print "The channeltransform program was not found (not in PATH?) \n";
        exit 1;
      }
    if (! -x "$channeltransform")
      {
        print "The channeltransform program must be executable\n";
        exit 1;
      }
  }

#
# Make sure debugging output makes it out
#
if ($debug)
  {
    select(STDERR); $| = 1;             # make unbuffered
    select(STDOUT); $| = 1;             # make unbuffered
  }

#
# Simplify delay checks later
#
$delay = 0 if (!defined($delay));
$bdelay = $delay if (!defined($bdelay));
$adelay = $delay if (!defined($adelay));
$ddelay = $delay if (!defined($ddelay));

#
# Build up irsend options string
#
$irsendoptions .= " --address=$address" if (defined($address) && ("$address" ne ''));
$irsendoptions .= " --device=$device" if (defined($device) && ("$device" ne ''));

#
# Create our locks early (early exit if we can not do so)
#
lockCreate();

#
# Process pre commands (issued before ir locking)
#
foreach (@precmds)
  {
    cmd("$_");
  }

#
# Try to prevent multiple processes using the IR transciever
# by obtaining a lock (if not doing fined grained locking)
#
if ($lockfinegrain == 0)
  {
    if (!lockGet())
      {
        print "Unable to aquire lock\n";
        exit 1;
      }
    else
      {
        printf STDERR "Lock acquired\n" if($debug);
      }
  }

#
# If requested, sleep at initialization
#
delayAccumulate($idelay, "due to initialization");

#
# Send the before keys, if any specified
#
foreach $key (@before)
  {
    delayAccumulate($rdelay, "due to repeated key") if ("$key" eq "$prevkey");
    delaySleep();
    irsend("SEND_ONCE $remote $key");
    $prevkey = "$key";
    delayAccumulate($bdelay, "after before key");
  }

#
# What remains is the channel number,
# although technically it is the "freqid"
# column, which may need to be transformed
# by an external script (if channeltransform
# is specified).  While not normally required,
# we support the capability for those special
# cases (and there are always special cases).
#
@FREQID = @ARGV;
if (defined($channeltransform))
  {
    my $a = join(' ', @FREQID);
    my $t = `$channeltransform $a`;
    chomp($t);
    print STDERR "transformed freqid $a into $t\n" if($debug);
    @FREQID = split(/ /,"$t");
  }

#
# What remains should be the channel number
# If the "token" appears to be an integer,
# we will treat it as a channel number,
# otherwise, just send along the key(s)
#
foreach $key (@FREQID)
  {
    if ($key =~ /^\d+$/)
      {
        my $digit;
        if (defined($channeldigits) && (($channeldigits > 0) && ($channeldigits > length($key))))
          {
            $key = substr('0000000000' . $key, (-$channeldigits));
          }
        foreach $digit (split(//,$key))
          {
            if (defined($digitnames) && ($digitnames))
              {
                if (defined($digitname{$digit}))
                  {
                    $digit = $digitname{$digit};
                  }
              }
            $digit = "$digitprefix" . $digit if (defined($digitprefix));
            delayAccumulate($rdelay, "due to repeated key") if ("$digit" eq "$prevkey");
            delaySleep();
            irsend("SEND_ONCE $remote $digit");
            $prevkey = "$digit";
            delayAccumulate($ddelay, "after digit key");
          }
      }
    else
      {
        delayAccumulate($rdelay, "due to repeated key") if ("$key" eq "$prevkey");
        delaySleep();
        irsend("SEND_ONCE $remote $key");
        $prevkey = "$key";
        delayAccumulate($ddelay, "after digit key");
      }
  }

#
# Send the after keys, if any specified
#
foreach $key (@after)
  {
    delayAccumulate($rdelay, "due to repeated key") if ("$key" eq "$prevkey");
    delaySleep();
    irsend("SEND_ONCE $remote $key");
    $prevkey = "$key";
    delayAccumulate($adelay, "after after key");
  }

#
# If requested, sleep before exiting (but zero accumulator)
#
if ($delayaccum != 0)
  {
    printf STDERR "zeroing delay accumulator after lirc commands\n" if ($debug);
    $delayaccum = 0;
  }
delayAccumulate($edelay, "due to exit");
delaySleep();

#
# IR operations complete, release the lock (if not fine grained locking)
#
if ($lockfinegrain == 0)
  {
    if (!lockFree())
      {
        print "Unable to free lock\n";
        exit 1;
      }
    else
      {
        printf STDERR "Lock freed\n" if($debug);
      }
  }

#
# Process post commands (issued after ir unlocking)
#
foreach (@postcmds)
  {
    cmd("$_");
  }

#
# Nothing more to do here.
#
exit 0;



#
# lockCreate
#
sub lockCreate
  {
    printf STDERR "lockCreate for lock type $locktype\n" if ($debug);
    return 1 if ("$locktype" eq 'none');
    if ("$locktype" eq 'semaphore')
      {
        printf STDERR "Creating lock semaphore %i (0x%x)\n", ($locksemkey, $locksemkey) if ($debug);
        $locksem = IPC::Semaphore->new($locksemkey, 3, ($lockperm & 0666) | S_IRUSR | S_IWUSR | IPC_CREAT);
        if (!defined($locksem))
          {
            printf "Unable to create lock semaphore %i (0x%x): $!\n", ($locksemkey, $locksemkey);
            exit 1;
          }
        return 1;
      }
    else
      {
        my ($fname, $dir) = fileparse("$lockfile");
        if ("$fname" eq '')
          {
            print "Specified lockfile $lockfile is a path only\n";
            exit 1;
          }
        my $umask;
        my $err;
        $umask=umask();
        umask(0);
        print STDERR "Creating lockfile directory $dir\n" if ($debug);
        make_path("$dir", {verbose => 0, mode => $lockperm, error => \$err});
        umask($umask);
        if (@$err)
          {
            for my $diag (@$err)
              {
                my ($file, $message) = %$diag;
                if ($file eq '')
                  {
                    print "Error while attempting to create directory $dir: $message\n";
                  }
                else
                  {
                    print "Error while attempting to create directory $file: $message\n";
                  }
              }
            exit 1;
          }
        $umask=umask();
        umask(0);
        print STDERR "Creating lockfile $lockfile\n" if ($debug);
        if (!(sysopen($lockFH, "$lockfile", (O_CREAT | O_RDWR | O_LARGEFILE) , $lockperm)))
          {
            print "Unable to create lockfile $lockfile: $!\n";
            umask($umask);
            exit 1;
          }
        umask($umask);
        close($lockFH);
        return 1;
      }
  }

#
# lockGet
#
sub lockGet
  {
    printf STDERR "lockGet for lock type $locktype\n" if ($debug);
    return 1 if ("$locktype" eq 'none');
    if ("$locktype" eq 'semaphore')
      {
        my $i;
        for ($i=0; $i<$lockattempts; $i++)
          {
            # Use IPC::Shareable / IPC::ShareLite semaphore protocol
            if ($locksem->op(1, 0, IPC_NOWAIT,                  # Check for no readers
                             2, 0, IPC_NOWAIT,                  # Check for no writers
                             2, 1, (SEM_UNDO | IPC_NOWAIT)))    # Acquire write lock
              {
                $lockobtained = 1;
                return 1;
              }
            print STDERR "Waiting for lock....\n" if ($debug);
            sleep($lockwait);
          }
        return 0;
      }
    else
      {
        if (open($lockFH, "+<$lockfile"))
          {
            my $i;
            for ($i=0; $i<$lockattempts; $i++)
              {
                if (flock($lockFH, LOCK_EX | LOCK_NB))
                  {
                    $lockobtained = 1;
                    return 1;
                  }
                print STDERR "Waiting for lock.....\n" if ($debug);
                sleep($lockwait);
              }
            return 0;
          }
        print STDERR "Unable to open lockfile $lockfile: $!\n" if ($debug);
        return 0;
      }
  }

#
# lockFree
#
sub lockFree
  {
    printf STDERR "lockFree for lock type $locktype\n" if ($debug);
    return 1 if ("$locktype" eq 'none');
    if ("$locktype" eq 'semaphore')
      {
        $locksem->op(2, -1, (SEM_UNDO | IPC_NOWAIT));
        $lockobtained = 0;
        return 1;
      }
    else
      {
        if (defined($lockFH))
          {
            flock($lockFH, LOCK_UN);
            close($lockFH);
            undef $lockFH;
          }
        $lockobtained = 0;
        return 1;
      }
  }

#
# cmd
#
sub cmd
  {
    my $cmd = shift;
    print STDERR "Issuing system command: $cmd\n" if ($debug);
    system("$cmd");
    if ($? == 0)
      {
        print STDERR "  child exited with value $?\n" if ($debug);
      }
    elsif ($? == -1)
      {
        print STDERR "  failed to execute $cmd: $!\n";
      }
    elsif ($? & 127)
      {
        printf STDERR "  child died with signal %d, %s coredump\n",
            ($? & 127),  ($? & 128) ? 'with' : 'without';
      }
    else
      {
        printf STDERR "  child exited with value %d\n", $? >> 8;
      }
    return $?;
}

#
# irsend
#
sub irsend
  {
    my $ircmd = shift;
    my $rc = 0;
    delaySleep();
    # Are we doing fine grained locking?
    if ($lockfinegrain != 0)
      {
        # Fine grained locking, we need to acquire the lock,
        # (re)issue the SET_TRANSMITTERS, issue the irsend
        # command, and then release the lock.

        if (!lockGet())
          {
            print "Unable to aquire lock\n";
            exit 1;
          }
        else
          {
            printf STDERR "Lock acquired\n" if($debug);
          }

        if (scalar(@transmitters) > 0)
          {
            my $emitters = join(' ', @transmitters);
            cmd("$irsend $irsendoptions SET_TRANSMITTERS $emitters");
            delayAccumulate($tdelay, "after set_transmitters");
          }

        delaySleep();
        $rc = cmd("$irsend $irsendoptions $ircmd");

        if (!lockFree())
          {
            print "Unable to free lock\n";
            exit 1;
          }
        else
          {
            printf STDERR "Lock freed\n" if($debug);
          }

      }
    else
      {
        # No fine grained locking.  Just issue the irsend
        if (($irsendxmitter == 0) && (scalar(@transmitters) > 0))
          {
            # Issue set transmitters if we have not yet done so
            my $emitters = join(' ', @transmitters);
            delaySleep();
            cmd("$irsend $irsendoptions SET_TRANSMITTERS $emitters");
            delayAccumulate($tdelay, "after set_transmitters");
            $irsendxmitter = 1;
          }
        delaySleep();
        $rc = cmd("$irsend $irsendoptions $ircmd");
      }
    return $rc;
  }

#
# delaySleep - sleep for the accumulated delay (if any)
#
sub delaySleep
  {
    return 0 if ($delayaccum == 0);
    print STDERR "sleeping for the accumulated delay $delayaccum\n" if($debug);
    sleep($delayaccum);
    $delayaccum = 0;
  }

#
# delayAccumulate - Add in additional delay
#
sub delayAccumulate
  {
    my $delay = shift;
    my $reason = shift;
    return 0 if ($delay == 0);
    print STDERR "adding $delay to delay accumulator: $reason\n" if ($debug);
    $delayaccum += $delay;
    return $delay;
  }

#
# processConfig
#
sub processConfig
  {

    my $cf = shift;

    #
    # If a config file specified, read in the config file
    #
    if (defined($cf) && ("$cf" ne ''))
      {
        my $options = '';
        printf STDERR "Opening configuration file $cf\n" if ($debug);
        if (open(FH,"<$cf"))
          {
            my $k; my $v;
            while(<FH>)
              {
                chomp;
                print STDERR "Reading configuration file line: $_\n" if ($debug);
                s/(.*?)\#.*/$1/;         # Remove trailing comments
                next if /^\s*(\#.*)?$/;  # Skip comments and blanks.
                s/^\s+//;
                s/\s+$//;
                $_ = "--" . "$_" if ("$_" !~ /^-/);
                $options = "$options" . ' ' . "$_";
              }
            close(FH);
          }
        if ("$options" ne '')
          {
            if (!GetOptionsFromString($options,
                  "device=s"                     => \$device,
                  "address=s"                    => \$address,
                  "delay=f"                      => \$delay,
                  "tdelay=f"                     => \$tdelay,
                  "bdelay=f"                     => \$bdelay,
                  "adelay=f"                     => \$adelay,
                  "ddelay=f"                     => \$ddelay,
                  "rdelay=f"                     => \$rdelay,
                  "idelay=f"                     => \$idelay,
                  "edelay=f"                     => \$edelay,
                  "xmitter|transmitter=i"        => \@transmitters,
                  "beforekeys=s"                 => sub { push @before, split(' ', (@_[1]))},
                  "afterkeys=s"                  => sub { push @after, split(' ', (@_[1]))},
                  "digitprefix=s"                => \$digitprefix,
                  "digitnames!"                  => \$digitnames,
                  "channeldigits=i"              => \$channeldigits,
                  "channeltransform=s"           => \$channeltransform,
                  "remote=s"                     => \$remote,
                  "cf|configfilename=s"          => sub { processConfig(@_[1]) },
                  "locktype=s"                   => \$locktype,
                  "lockfilename=s"               => \$lockfile,
                  "lockkey=o"                    => \$locksemkey,
                  "lockperm=o"                   => \$lockperm,
                  "lockfinegrained!"             => \$lockfinegrain,
                  "precmd|precommand=s"          => \@precmds,
                  "postcmd|postcommand=s"        => \@postcmds,
                  "irsend=s"                     => \$irsend,
                  "debug!"                       => \$debug))
              {
                exit 1;
              }
          }
        else
          {
            print "Unable to open the configuration file $cf: $!\n";
            exit 1;
          }
      }

  }



An example configuration file for a Comcast Motorola/Pace DTA:


Script.png LircChannelChanger-DTA

#
# Configuration file for the LircChannelChanger script
#
# Except for the configfile option, all other options
# specified on the command line can be specified in
# this file.  Comments ('#') are stripped, and options
# that are not prefixed with '--' have the '--' added.
#
# The main reason for supporting a configfile is
# that the command line for the LircChannelChanger script
# could exceed the 128 character (database) size limits
# if many options were specified (and fully typed out).
# In particular, the before or after commands with long
# remote strings.
#
remote          MotorolaDTA100-PaceDC50X   # lirc remote name
delay           .2          # .2 seconds is long enough for reliable tuning
rdelay          .2          # Add in .2 seconds for debounce compensation
                            # compensation (not clear if needed)
channeldigits   3           # Tunes faster with 3 digits (no timeout reqd)
digitprefix     KEY_        # lirc file has keys prefixed with KEY_
                            # so sending 0 requires the name KEY_0
beforekeys      KEY_INFO    # Return from extended info screen, if on it,
                            # otherwise this puts up the channel info,
                            # which you get anyway when tuning....



An example definition in mythtv to invoke the script using the example configuration file:


 /home/mythtv/bin/LircChannelChanger --cf=/home/mythtv/etc/LircChannelChanger-DTA --xmitter 1