view release on metacpan or  search on metacpan

examples/build_IR_database.pl  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use Slinke;
use Data::Dumper;

my $file = shift || "slinke.irdb";

# read in database
my ( %COMMANDS, %COMPONENT_LOOKUP, %COMPONENTS, %COMMAND_LOOKUP );
{
    local $/ = "";
    open FILE, $file;
    my $string = <FILE>;
    close FILE;
    
    eval $string;
}

my $slinke = new Slinke();
$slinke->setIRSamplingPeriod( 100 / 1e6 );
$slinke->setIRTimeoutPeriod( 500 );
#$slinke->setIRSamplingPeriod( 50 / 1e6 );
#$slinke->setIRTimeoutPeriod( 1000 );

# put code into database
#    in hash COMMANDS ( key = IR code, value = [ component name, command name ] )
#    in hash COMPONENTS ( key = component name, value = [ head, tail, pause, [ zero, one ] ] )
#    in hash COMPONENT_LOOKUP ( key = IR head, value = component name )
#    in hash COMMAND_LOOKUP ( key = [ component name ~ command name ], value = IR code )

while ( 1 ) {
    my $data = $slinke->requestInput;
    next if !$data;
    next if ( $data->{ PORT } ne "PORT_IR" );

    pop @{$data->{ DATA }};
    my $code = decodeIR( @{$data->{ DATA }} );

    my $ir = $code->{ CODE };

    my @zero = @{$code->{ ENCODING }->[0]};
    my @one = @{$code->{ ENCODING }->[1]};

    my $componentBits;
    if ( $zero[0] == $one[0] ) {
	$componentBits = substr( $ir, 0, 16 );
    }
    else { # Sony equipment - device is last five bits
	$componentBits = substr( $ir, 7 );
    }

    my $component;
    my $command;
    my $repeatable;

    # Check if we've seen this command before 
    if ( exists $COMMANDS{ $ir } ) {
	my $val = "q";
	while ( $val ne "y" && $val ne "n" ) {
	    print "Received '" . join( " ", @{$COMMANDS{ $ir }}[0..1] ), "'\n";
	    print "Is this correct? [Y/n] ";
	    $val = lc( <STDIN> );
	    chomp $val;
	    $val = "y" if !$val;
	    if ( $val eq "y" ) {
		$component = $COMMANDS{ $ir }->[0];
		$command = $COMMANDS{ $ir }->[1];
		$repeatable = $COMMANDS{ $ir }->[2];
	    }
	}
    }