From 33f9f141c4fec7f2e3b0bf36344fb1085edd8a67 Mon Sep 17 00:00:00 2001 From: ntruchsess Date: Fri, 18 Oct 2013 12:08:22 +0000 Subject: [PATCH] update perl-firmata to upstream version git-svn-id: svn://svn.code.sf.net/p/fhem/code/trunk@4064 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/lib/Device/Firmata.pm | 8 +- fhem/FHEM/lib/Device/Firmata/Base.pm | 76 +- fhem/FHEM/lib/Device/Firmata/Constants.pm | 525 +++++---- fhem/FHEM/lib/Device/Firmata/Error.pm | 22 +- fhem/FHEM/lib/Device/Firmata/IO.pm | 48 +- fhem/FHEM/lib/Device/Firmata/Language.pm | 10 +- fhem/FHEM/lib/Device/Firmata/Platform.pm | 1136 ++++++++++--------- fhem/FHEM/lib/Device/Firmata/Protocol.pm | 1212 ++++++++++----------- 8 files changed, 1445 insertions(+), 1592 deletions(-) diff --git a/fhem/FHEM/lib/Device/Firmata.pm b/fhem/FHEM/lib/Device/Firmata.pm index d5e1fcf05..44c7a5935 100644 --- a/fhem/FHEM/lib/Device/Firmata.pm +++ b/fhem/FHEM/lib/Device/Firmata.pm @@ -11,7 +11,7 @@ use Device::Firmata::Base =head1 NAME -Device::Firmata - A host interface to Firmata for the arduino platform. +Device::Firmata - Perl interface to Firmata for the arduino platform. =head1 VERSION @@ -19,7 +19,7 @@ Version 0.50 =cut -our $VERSION = '0.50'; +our $VERSION = '0.51'; our $DEBUG = 0; @@ -47,13 +47,13 @@ while (1) { =head2 open -establish communication to the device. Single argument is the name of the device file mapped to the arduino. Typicaly '/dev/ttyUSB0' +establish serial connection with an Arduino micro-controller. Single argument is the name of the device file mapped to the arduino. Typically '/dev/ttyUSB0' or 'COM9' =cut sub open { # -------------------------------------------------- -# Establish a connection with the serial port +# Establish a connection to Arduino via the serial port # my ( $self, $serial_port, $opts ) = @_; diff --git a/fhem/FHEM/lib/Device/Firmata/Base.pm b/fhem/FHEM/lib/Device/Firmata/Base.pm index 766b4014e..51163df89 100644 --- a/fhem/FHEM/lib/Device/Firmata/Base.pm +++ b/fhem/FHEM/lib/Device/Firmata/Base.pm @@ -1,19 +1,16 @@ package Device::Firmata::Base; use strict 'vars', 'subs'; -use vars qw/ - $AUTOLOAD - +use vars qw/ + $AUTOLOAD $FIRMATA_DEBUG_LEVEL $FIRMATA_ERROR_CLASS $FIRMATA_ERROR - - $FIRMATA_ATTRIBS - $FIRMATA_DEBUGGING - - $FIRMATA_LOCALE + $FIRMATA_ATTRIBS + $FIRMATA_DEBUGGING + $FIRMATA_LOCALE $FIRMATA_LOCALE_PATH - $FIRMATA_LOCALE_MESSAGES + $FIRMATA_LOCALE_MESSAGES /; =head1 NAME @@ -23,49 +20,42 @@ Device::Firmata::Base -- Abstract baseclass for Device::Firmata modules =cut $FIRMATA_DEBUGGING = 1; - -$FIRMATA_ATTRIBS = { -}; +$FIRMATA_ATTRIBS = {}; $FIRMATA_LOCALE = 'en'; $FIRMATA_LOCALE_PATH = '.'; - -$FIRMATA_DEBUG_LEVEL = 0; +$FIRMATA_DEBUG_LEVEL = 0; $FIRMATA_ERROR_CLASS = 'Device::Firmata::Error'; =head1 METHODS =head2 import -Ease the use of setting up configuration options +Ease setting of configuration options -=cut +=cut sub import { - my $self = shift; - my $pkg = caller; + my $self = shift; + my $pkg = caller; + my $config_opts = { + debugging => $FIRMATA_DEBUGGING, + }; - my $config_opts = { - debugging => $FIRMATA_DEBUGGING, - }; - - if ( @_ ) { - my $opts = $self->parameters( @_ ); - - if ( my $attrs = $opts->{FIRMATA_ATTRIBS} ) { - *{$pkg.'::FIRMATA_ATTRIBS'} = \$attrs; - } - - unless ( ref *{$pkg.'::ISA'} eq 'ARRAY' and @${$pkg.'::ISA'}) { - my @ISA = ref $opts->{ISA} ? @{$opts->{ISA}} : - $opts->{ISA} ? $opts->{ISA} : - __PACKAGE__; - *{$pkg.'::ISA'} = \@ISA; - } - - use strict; - - $self->SUPER::import( @_ ); + if ( @_ ) { + my $opts = $self->parameters( @_ ); + if ( my $attrs = $opts->{FIRMATA_ATTRIBS} ) { + *{$pkg.'::FIRMATA_ATTRIBS'} = \$attrs; } + + unless ( ref *{$pkg.'::ISA'} eq 'ARRAY' and @${$pkg.'::ISA'}) { + my @ISA = ref $opts->{ISA} ? @{$opts->{ISA}} : + $opts->{ISA} ? $opts->{ISA} : + __PACKAGE__; + *{$pkg.'::ISA'} = \@ISA; + } + use strict; + $self->SUPER::import( @_ ); + } } =head2 new @@ -92,7 +82,7 @@ sub new { =head2 create -A soft new as some objects will override new and +A soft new as some objects will override new and we don't want to cause problems but still want to invoice our creation code @@ -137,7 +127,7 @@ sub init_instance_attribs { =head2 init_class_attribs -=cut +=cut sub init_class_attribs { # -------------------------------------------------- @@ -196,7 +186,7 @@ sub parameters { @_ % 2 or $_[0]->warn( "Even number of elements were not passed to call.", join( " ", caller() ) ); - shift; + shift; return {@_}; } @@ -268,7 +258,6 @@ sub error { # Handle any error messages # my $self = shift; - if ( @_ ) { my $err_msg = $self->init_error->error(@_); $self->{error} = $err_msg; @@ -395,4 +384,3 @@ sub object_load { 1; - diff --git a/fhem/FHEM/lib/Device/Firmata/Constants.pm b/fhem/FHEM/lib/Device/Firmata/Constants.pm index d7d976751..d9e449b09 100644 --- a/fhem/FHEM/lib/Device/Firmata/Constants.pm +++ b/fhem/FHEM/lib/Device/Firmata/Constants.pm @@ -2,7 +2,7 @@ package Device::Firmata::Constants; =head1 NAME -Device::Firmata::Constants - constants used in the system +Device::Firmata::Constants - constants used in the Device::Firmata system =cut @@ -11,7 +11,6 @@ use Exporter; use vars qw/ @ISA @EXPORT_OK %EXPORT_TAGS $BASE - $DEVICES $COMMANDS $COMMAND_NAMES $COMMAND_LOOKUP /; @@ -19,325 +18,307 @@ use vars qw/ # Basic commands and constants use constant ( - $BASE = { - PIN_INPUT => 0, - PIN_OUTPUT => 1, - PIN_ANALOG => 2, - PIN_PWM => 3, - PIN_SERVO => 4, - PIN_SHIFT => 5, - PIN_I2C => 6, - PIN_ONEWIRE => 7, - PIN_STEPPER => 8, - - PIN_LOW => 0, - PIN_HIGH => 1, - } + $BASE = { + PIN_INPUT => 0, + PIN_OUTPUT => 1, + PIN_ANALOG => 2, + PIN_PWM => 3, + PIN_SERVO => 4, + PIN_SHIFT => 5, + PIN_I2C => 6, + PIN_ONEWIRE => 7, + PIN_STEPPER => 8, + PIN_LOW => 0, + PIN_HIGH => 1, + } ); -$DEVICES = { 'arduino_dumilanove' => {}, }; - # We need to apply all the available protocols use constant ( - $COMMANDS = { + $COMMANDS = { - V_2_01 => { + V_2_01 => { - MAX_DATA_BYTES => - 32, # max number of data bytes in non-Sysex messages + MAX_DATA_BYTES => 32, # max number of data bytes in non-Sysex messages - # message command bytes (128-255/0x80-0xFF) - DIGITAL_MESSAGE => 0x90, # send data for a digital pin - ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) - REPORT_ANALOG => 0xC0, # enable analog input by pin # - REPORT_DIGITAL => 0xD0, # enable digital input by port pair - SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc - REPORT_VERSION => 0xF9, # report protocol version - SYSTEM_RESET => 0xFF, # reset from MIDI - START_SYSEX => 0xF0, # start a MIDI Sysex message - END_SYSEX => 0xF7, # end a MIDI Sysex message + # message command bytes (128-255/0x80-0xFF) + DIGITAL_MESSAGE => 0x90, # send data for a digital pin + ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) + REPORT_ANALOG => 0xC0, # enable analog input by pin # + REPORT_DIGITAL => 0xD0, # enable digital input by port pair + SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc + REPORT_VERSION => 0xF9, # report protocol version + SYSTEM_RESET => 0xFF, # reset from MIDI + START_SYSEX => 0xF0, # start a MIDI Sysex message + END_SYSEX => 0xF7, # end a MIDI Sysex message - # extended command set using sysex (0-127/0x00-0x7F) - SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq - STRING_DATA => 0x71, # a string message with 14-bits per char - SHIFT_DATA => 0x75, # a bitstream to/from a shift register - I2C_REQUEST => 0x76, # send an I2C read/write request - I2C_REPLY => 0x77, # a reply to an I2C read request - I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins - REPORT_FIRMWARE => 0x79, # report name and version of the firmware - SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop - SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages - SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages + # extended command set using sysex (0-127/0x00-0x7F) + SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq + STRING_DATA => 0x71, # a string message with 14-bits per char + SHIFT_DATA => 0x75, # a bitstream to/from a shift register + I2C_REQUEST => 0x76, # send an I2C read/write request + I2C_REPLY => 0x77, # a reply to an I2C read request + I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins + REPORT_FIRMWARE => 0x79, # report name and version of the firmware + SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop + SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages + SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages - # these are DEPRECATED to make the naming more consistent - FIRMATA_STRING => 0x71, # same as STRING_DATA - SYSEX_I2C_REQUEST => 0x76, # same as I2C_REQUEST - SYSEX_I2C_REPLY => 0x77, # same as I2C_REPLY - SYSEX_SAMPLING_INTERVAL => 0x7A, # same as SAMPLING_INTERVAL + # these are DEPRECATED to make the naming more consistent + FIRMATA_STRING => 0x71, # same as STRING_DATA + SYSEX_I2C_REQUEST => 0x76, # same as I2C_REQUEST + SYSEX_I2C_REPLY => 0x77, # same as I2C_REPLY + SYSEX_SAMPLING_INTERVAL => 0x7A, # same as SAMPLING_INTERVAL - # pin modes - INPUT => 0x00, # digital pin in digitalOut mode - OUTPUT => 0x01, # digital pin in digitalInput mode - ANALOG => 0x02, # analog pin in analogInput mode - PWM => 0x03, # digital pin in PWM output mode - SERVO => 0x04, # digital pin in Servo output mode - SHIFT => 0x05, # shiftIn/shiftOut mode - I2C => 0x06, # pin included in I2C setup + # pin modes + INPUT => 0x00, # digital pin in digitalOut mode + OUTPUT => 0x01, # digital pin in digitalInput mode + ANALOG => 0x02, # analog pin in analogInput mode + PWM => 0x03, # digital pin in PWM output mode + SERVO => 0x04, # digital pin in Servo output mode + SHIFT => 0x05, # shiftIn/shiftOut mode + I2C => 0x06, # pin included in I2C setup - # Deprecated entries - deprecated => [ - qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) - ], + # Deprecated entries + deprecated => [ + qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) + ], + }, # /Constants for Version 2.1 - }, # /Constants for Version 2.1 + V_2_02 => { - V_2_02 => { + MAX_DATA_BYTES => 32, # max number of data bytes in non-Sysex messages - MAX_DATA_BYTES => - 32, # max number of data bytes in non-Sysex messages + # message command bytes (128-255/0x80-0xFF) + DIGITAL_MESSAGE => 0x90, # send data for a digital pin + ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) + REPORT_ANALOG => 0xC0, # enable analog input by pin # + REPORT_DIGITAL => 0xD0, # enable digital input by port pair + SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc + REPORT_VERSION => 0xF9, # report protocol version + SYSTEM_RESET => 0xFF, # reset from MIDI + START_SYSEX => 0xF0, # start a MIDI Sysex message + END_SYSEX => 0xF7, # end a MIDI Sysex message - # message command bytes (128-255/0x80-0xFF) - DIGITAL_MESSAGE => 0x90, # send data for a digital pin - ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) - REPORT_ANALOG => 0xC0, # enable analog input by pin # - REPORT_DIGITAL => 0xD0, # enable digital input by port pair - SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc - REPORT_VERSION => 0xF9, # report protocol version - SYSTEM_RESET => 0xFF, # reset from MIDI - START_SYSEX => 0xF0, # start a MIDI Sysex message - END_SYSEX => 0xF7, # end a MIDI Sysex message + # extended command set using sysex (0-127/0x00-0x7F) + RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). + ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers + ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info + CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins + CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution + PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value + PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value + EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin + SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq + STRING_DATA => 0x71, # a string message with 14-bits per char + SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits) + I2C_REQUEST => 0x76, # send an I2C read/write request + I2C_REPLY => 0x77, # a reply to an I2C read request + I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins + REPORT_FIRMWARE => 0x79, # report name and version of the firmware + SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop + SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages + SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages - # extended command set using sysex (0-127/0x00-0x7F) - RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). - ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers - ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info - CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins - CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution - PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value - PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value - EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin - SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq - STRING_DATA => 0x71, # a string message with 14-bits per char - SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits) - I2C_REQUEST => 0x76, # send an I2C read/write request - I2C_REPLY => 0x77, # a reply to an I2C read request - I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins - REPORT_FIRMWARE => 0x79, # report name and version of the firmware - SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop - SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages - SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages + # pin modes + INPUT => 0x00, # digital pin in digitalOut mode + OUTPUT => 0x01, # digital pin in digitalInput mode + ANALOG => 0x02, # analog pin in analogInput mode + PWM => 0x03, # digital pin in PWM output mode + SERVO => 0x04, # digital pin in Servo output mode + SHIFT => 0x05, # shiftIn/shiftOut mode + I2C => 0x06, # pin included in I2C setup - # pin modes - INPUT => 0x00, # digital pin in digitalOut mode - OUTPUT => 0x01, # digital pin in digitalInput mode - ANALOG => 0x02, # analog pin in analogInput mode - PWM => 0x03, # digital pin in PWM output mode - SERVO => 0x04, # digital pin in Servo output mode - SHIFT => 0x05, # shiftIn/shiftOut mode - I2C => 0x06, # pin included in I2C setup + # Deprecated entries + deprecated => [ + qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) + ], - # Deprecated entries - deprecated => [ - qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) - ], + }, # /Constants for Version 2.2 - }, # /Constants for Version 2.2 + V_2_03 => { - V_2_03 => { + MAX_DATA_BYTES => 32, # max number of data bytes in non-Sysex messages - MAX_DATA_BYTES => - 32, # max number of data bytes in non-Sysex messages + # message command bytes (128-255/0x80-0xFF) + DIGITAL_MESSAGE => 0x90, # send data for a digital pin + ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) + REPORT_ANALOG => 0xC0, # enable analog input by pin # + REPORT_DIGITAL => 0xD0, # enable digital input by port pair + SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc + REPORT_VERSION => 0xF9, # report protocol version + SYSTEM_RESET => 0xFF, # reset from MIDI + START_SYSEX => 0xF0, # start a MIDI Sysex message + END_SYSEX => 0xF7, # end a MIDI Sysex message - # message command bytes (128-255/0x80-0xFF) - DIGITAL_MESSAGE => 0x90, # send data for a digital pin - ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) - REPORT_ANALOG => 0xC0, # enable analog input by pin # - REPORT_DIGITAL => 0xD0, # enable digital input by port pair - SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc - REPORT_VERSION => 0xF9, # report protocol version - SYSTEM_RESET => 0xFF, # reset from MIDI - START_SYSEX => 0xF0, # start a MIDI Sysex message - END_SYSEX => 0xF7, # end a MIDI Sysex message + # extended command set using sysex (0-127/0x00-0x7F) + RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). + ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers + ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info + CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins + CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution + PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value + PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value + EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin + SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq + STRING_DATA => 0x71, # a string message with 14-bits per char + SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits) + I2C_REQUEST => 0x76, # send an I2C read/write request + I2C_REPLY => 0x77, # a reply to an I2C read request + I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins + REPORT_FIRMWARE => 0x79, # report name and version of the firmware + SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop + SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages + SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages - # extended command set using sysex (0-127/0x00-0x7F) - RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). - ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers - ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info - CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins - CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution - PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value - PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value - EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin - SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq - STRING_DATA => 0x71, # a string message with 14-bits per char - SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits) - I2C_REQUEST => 0x76, # send an I2C read/write request - I2C_REPLY => 0x77, # a reply to an I2C read request - I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins - REPORT_FIRMWARE => 0x79, # report name and version of the firmware - SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop - SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages - SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages + # pin modes + INPUT => 0x00, # digital pin in digitalOut mode + OUTPUT => 0x01, # digital pin in digitalInput mode + ANALOG => 0x02, # analog pin in analogInput mode + PWM => 0x03, # digital pin in PWM output mode + SERVO => 0x04, # digital pin in Servo output mode + SHIFT => 0x05, # shiftIn/shiftOut mode + I2C => 0x06, # pin included in I2C setup - # pin modes - INPUT => 0x00, # digital pin in digitalOut mode - OUTPUT => 0x01, # digital pin in digitalInput mode - ANALOG => 0x02, # analog pin in analogInput mode - PWM => 0x03, # digital pin in PWM output mode - SERVO => 0x04, # digital pin in Servo output mode - SHIFT => 0x05, # shiftIn/shiftOut mode - I2C => 0x06, # pin included in I2C setup + # Deprecated entries + deprecated => [ + qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) + ], - # Deprecated entries - deprecated => [ - qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) - ], + }, # /Constants for Version 2.3 (same as V_2_02) - }, # /Constants for Version 2.3 (same as V_2_02) + V_2_04 => { - V_2_04 => { + MAX_DATA_BYTES => 64, # max number of data bytes in non-Sysex messages - MAX_DATA_BYTES => 64, # max number of data bytes in non-Sysex messages + # message command bytes (128-255/0x80-0xFF) + DIGITAL_MESSAGE => 0x90, # send data for a digital pin + ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) + REPORT_ANALOG => 0xC0, # enable analog input by pin # + REPORT_DIGITAL => 0xD0, # enable digital input by port pair + SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc + REPORT_VERSION => 0xF9, # report protocol version + SYSTEM_RESET => 0xFF, # reset from MIDI + START_SYSEX => 0xF0, # start a MIDI Sysex message + END_SYSEX => 0xF7, # end a MIDI Sysex message - # message command bytes (128-255/0x80-0xFF) - DIGITAL_MESSAGE => 0x90, # send data for a digital pin - ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) - REPORT_ANALOG => 0xC0, # enable analog input by pin # - REPORT_DIGITAL => 0xD0, # enable digital input by port pair - SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc - REPORT_VERSION => 0xF9, # report protocol version - SYSTEM_RESET => 0xFF, # reset from MIDI - START_SYSEX => 0xF0, # start a MIDI Sysex message - END_SYSEX => 0xF7, # end a MIDI Sysex message + # extended command set using sysex (0-127/0x00-0x7F) + RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). + ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers + ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info + CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins + CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution + PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value + PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value + EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin + SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq + STRING_DATA => 0x71, # a string message with 14-bits per char + ONEWIRE_DATA => 0x73, # OneWire read/write/reset/select/skip/search request + read/search reply + SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits) + I2C_REQUEST => 0x76, # send an I2C read/write request + I2C_REPLY => 0x77, # a reply to an I2C read request + I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins + REPORT_FIRMWARE => 0x79, # report name and version of the firmware + SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop + SCHEDULER_DATA => 0x7B, # createtask/deletetask/addtotask/schedule/querytasks/querytask request and querytasks/querytask reply + SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages + SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages - # extended command set using sysex (0-127/0x00-0x7F) - RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). - ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers - ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info - CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins - CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution - PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value - PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value - EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin - SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq - STRING_DATA => 0x71, # a string message with 14-bits per char - ONEWIRE_DATA => 0x73, # OneWire read/write/reset/select/skip/search request + read/search reply - SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits) - I2C_REQUEST => 0x76, # send an I2C read/write request - I2C_REPLY => 0x77, # a reply to an I2C read request - I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins - REPORT_FIRMWARE => 0x79, # report name and version of the firmware - SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop - SCHEDULER_DATA => 0x7B, # createtask/deletetask/addtotask/schedule/querytasks/querytask request and querytasks/querytask reply - SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages - SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages + # pin modes + INPUT => 0x00, # digital pin in digitalOut mode + OUTPUT => 0x01, # digital pin in digitalInput mode + ANALOG => 0x02, # analog pin in analogInput mode + PWM => 0x03, # digital pin in PWM output mode + SERVO => 0x04, # digital pin in Servo output mode + SHIFT => 0x05, # shiftIn/shiftOut mode + I2C => 0x06, # pin included in I2C setup + ONEWIRE => 0x07, - # pin modes - INPUT => 0x00, # digital pin in digitalOut mode - OUTPUT => 0x01, # digital pin in digitalInput mode - ANALOG => 0x02, # analog pin in analogInput mode - PWM => 0x03, # digital pin in PWM output mode - SERVO => 0x04, # digital pin in Servo output mode - SHIFT => 0x05, # shiftIn/shiftOut mode - I2C => 0x06, # pin included in I2C setup - ONEWIRE => 0x07, + # Deprecated entries + deprecated => [ + qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) + ], + }, # /Constants for Version 2.4 - # Deprecated entries - deprecated => [ - qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) - ], + V_2_05 => { - }, # /Constants for Version 2.4 + MAX_DATA_BYTES => 64, # max number of data bytes in non-Sysex messages - V_2_05 => { + # message command bytes (128-255/0x80-0xFF) + DIGITAL_MESSAGE => 0x90, # send data for a digital pin + ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) + REPORT_ANALOG => 0xC0, # enable analog input by pin # + REPORT_DIGITAL => 0xD0, # enable digital input by port pair + SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc + REPORT_VERSION => 0xF9, # report protocol version + SYSTEM_RESET => 0xFF, # reset from MIDI + START_SYSEX => 0xF0, # start a MIDI Sysex message + END_SYSEX => 0xF7, # end a MIDI Sysex message - MAX_DATA_BYTES => 64, # max number of data bytes in non-Sysex messages + # extended command set using sysex (0-127/0x00-0x7F) + RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). + ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers + ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info + CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins + CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution + PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value + PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value + EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin + SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq + STRING_DATA => 0x71, # a string message with 14-bits per char + ONEWIRE_DATA => 0x73, # OneWire read/write/reset/select/skip/search request + read/search reply + SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits) + I2C_REQUEST => 0x76, # send an I2C read/write request + I2C_REPLY => 0x77, # a reply to an I2C read request + I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins + REPORT_FIRMWARE => 0x79, # report name and version of the firmware + SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop + SCHEDULER_DATA => 0x7B, # createtask/deletetask/addtotask/schedule/querytasks/querytask request and querytasks/querytask reply + SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages + SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages - # message command bytes (128-255/0x80-0xFF) - DIGITAL_MESSAGE => 0x90, # send data for a digital pin - ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM) - REPORT_ANALOG => 0xC0, # enable analog input by pin # - REPORT_DIGITAL => 0xD0, # enable digital input by port pair - SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc - REPORT_VERSION => 0xF9, # report protocol version - SYSTEM_RESET => 0xFF, # reset from MIDI - START_SYSEX => 0xF0, # start a MIDI Sysex message - END_SYSEX => 0xF7, # end a MIDI Sysex message + # pin modes + INPUT => 0x00, # digital pin in digitalOut mode + OUTPUT => 0x01, # digital pin in digitalInput mode + ANALOG => 0x02, # analog pin in analogInput mode + PWM => 0x03, # digital pin in PWM output mode + SERVO => 0x04, # digital pin in Servo output mode + SHIFT => 0x05, # shiftIn/shiftOut mode + I2C => 0x06, # pin included in I2C setup + ONEWIRE => 0x07, - # extended command set using sysex (0-127/0x00-0x7F) - RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). - ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers - ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info - CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins - CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution - PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value - PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value - EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin - SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq - STRING_DATA => 0x71, # a string message with 14-bits per char - ONEWIRE_DATA => 0x73, # OneWire read/write/reset/select/skip/search request + read/search reply - SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits) - I2C_REQUEST => 0x76, # send an I2C read/write request - I2C_REPLY => 0x77, # a reply to an I2C read request - I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins - REPORT_FIRMWARE => 0x79, # report name and version of the firmware - SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop - SCHEDULER_DATA => 0x7B, # createtask/deletetask/addtotask/schedule/querytasks/querytask request and querytasks/querytask reply - SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages - SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages + # Deprecated entries + deprecated => [ + qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) + ], - # pin modes - INPUT => 0x00, # digital pin in digitalOut mode - OUTPUT => 0x01, # digital pin in digitalInput mode - ANALOG => 0x02, # analog pin in analogInput mode - PWM => 0x03, # digital pin in PWM output mode - SERVO => 0x04, # digital pin in Servo output mode - SHIFT => 0x05, # shiftIn/shiftOut mode - I2C => 0x06, # pin included in I2C setup - ONEWIRE => 0x07, - - # Deprecated entries - deprecated => [ - qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL ) - ], - - }, # /Constants for Version 2.5 - } + }, # /Constants for Version 2.5 + } ); # Handle the reverse lookups of the protocol $COMMAND_LOOKUP = {}; while ( my ( $protocol_version, $protocol_commands ) = each %$COMMANDS ) { - my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version} = {}; - my $deprecated = $protocol_lookup->{deprecated} || []; - my $deprecated_lookup = { map { ( $_ => 1 ) } @$deprecated }; - while ( my ( $protocol_command, $command_value ) = - each %$protocol_commands ) - { - next if $protocol_command eq 'deprecated'; - next if $deprecated_lookup->{$protocol_command}; - $protocol_lookup->{$command_value} = $protocol_command; - } + my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version} = {}; + my $deprecated = $protocol_lookup->{deprecated} || []; + my $deprecated_lookup = { map { ( $_ => 1 ) } @$deprecated }; + while ( my ( $protocol_command, $command_value ) = each %$protocol_commands ) { + next if $protocol_command eq 'deprecated'; + next if $deprecated_lookup->{$protocol_command}; + $protocol_lookup->{$command_value} = $protocol_command; + } } # Now we consolidate all the string keynames into a single master list. -use constant ( - $COMMAND_NAMES = { - map { - map { ( $_ => $_ ) } - keys %$_ - } values %$COMMANDS - } -); - +use constant ( $COMMAND_NAMES = { map { map { ( $_ => $_ ) } keys %$_ } values %$COMMANDS } ); use constant { COMMAND_NAMES => [ $COMMAND_NAMES = [ keys %$COMMAND_NAMES ] ] }; @EXPORT_OK = ( - @$COMMAND_NAMES, keys %$BASE, - keys %$COMMANDS, - qw( $COMMANDS $COMMAND_NAMES $COMMAND_LOOKUP ) -); + @$COMMAND_NAMES, keys %$BASE, + keys %$COMMANDS, + qw( $COMMANDS $COMMAND_NAMES $COMMAND_LOOKUP ), + ); %EXPORT_TAGS = ( all => \@EXPORT_OK ); -1; +1; diff --git a/fhem/FHEM/lib/Device/Firmata/Error.pm b/fhem/FHEM/lib/Device/Firmata/Error.pm index 3c509d5fb..d086f567b 100644 --- a/fhem/FHEM/lib/Device/Firmata/Error.pm +++ b/fhem/FHEM/lib/Device/Firmata/Error.pm @@ -9,11 +9,11 @@ Device::Firmata::Error - Error handlers use strict; use Exporter; -use vars qw/ - @ISA - %ERRORS - @EXPORT - $FIRMATA_ERROR_DEFAULT +use vars qw/ + @ISA + %ERRORS + @EXPORT + $FIRMATA_ERROR_DEFAULT @ERROR_STACK /; use Device::Firmata::Base; @@ -28,7 +28,7 @@ $FIRMATA_ERROR_DEFAULT = -1; =head2 error The base error reporting system. All errors will be -stored in this object until the errors flush code is called. +stored in this object until the error flush code is called. This will allow the system to collect all errors that occur in various parts of the system in one place. Very useful for error reporting since it's a simple call to find @@ -37,10 +37,10 @@ out the last error. Invocation of this function $err->error( [numerical error level], ErrorMessage, ... parameters ... ); - -ErrorMessage can be in the format "KEY" that will be referenced by + +ErrorMessage can be in the format "KEY" that will be referenced by Device::Firmata::Base->language or "KEY:Message" where if ->language does -not map to anything, the error will default to Message +not map to anything, the error will default to Message =cut @@ -71,7 +71,7 @@ sub error { : warn "\@$fn:$pkg:$line". ' : ' . $text . "\n"; }; -# warn "Error called wih args: @_ from " . join( " ", caller() ) . "\n"; +# warn "Error called with args: @_ from " . join( " ", caller() ) . "\n"; # require Carp; # Carp::cluck(); @@ -90,5 +90,3 @@ sub errors_flush { 1; - - diff --git a/fhem/FHEM/lib/Device/Firmata/IO.pm b/fhem/FHEM/lib/Device/Firmata/IO.pm index dc2a6a602..6229c8fd6 100644 --- a/fhem/FHEM/lib/Device/Firmata/IO.pm +++ b/fhem/FHEM/lib/Device/Firmata/IO.pm @@ -17,7 +17,7 @@ use Device::Firmata::Base baudrate => 57600, }; -$SERIAL_CLASS = $^O eq 'MSWin32' ? 'Win32::Serialport' +$SERIAL_CLASS = $^O eq 'MSWin32' ? 'Win32::SerialPort' : 'Device::SerialPort'; eval "require $SERIAL_CLASS"; @@ -28,27 +28,21 @@ eval "require $SERIAL_CLASS"; sub open { # -------------------------------------------------- - my ( $pkg, $serial_port, $opts ) = @_; - - my $self = ref $pkg ? $pkg : $pkg->new($opts); - - my $serial_obj = $SERIAL_CLASS->new( $serial_port, 1, 0 ) or return; - $self->attach($serial_obj,$opts); - $self->{handle}->baudrate($self->{baudrate}); - $self->{handle}->databits(8); - $self->{handle}->stopbits(1); - - return $self; + my ( $pkg, $serial_port, $opts ) = @_; + my $self = ref $pkg ? $pkg : $pkg->new($opts); + my $serial_obj = $SERIAL_CLASS->new( $serial_port, 1, 0 ) or return; + $self->attach($serial_obj,$opts); + $self->{handle}->baudrate($self->{baudrate}); + $self->{handle}->databits(8); + $self->{handle}->stopbits(1); + return $self; } sub attach { - my ( $pkg, $serial_obj, $opts ) = @_; - - my $self = ref $pkg ? $pkg : $pkg->new($opts); - - $self->{handle} = $serial_obj; - - return $self; + my ( $pkg, $serial_obj, $opts ) = @_; + my $self = ref $pkg ? $pkg : $pkg->new($opts); + $self->{handle} = $serial_obj; + return $self; } =head2 data_write @@ -59,9 +53,9 @@ Dump a bunch of data into the comm port sub data_write { # -------------------------------------------------- - my ( $self, $buf ) = @_; - $Device::Firmata::DEBUG and print ">".join(",",map{sprintf"%02x",ord$_}split//,$buf)."\n"; - return $self->{handle}->write( $buf ); + my ( $self, $buf ) = @_; + $Device::Firmata::DEBUG and print ">".join(",",map{sprintf"%02x",ord$_}split//,$buf)."\n"; + return $self->{handle}->write( $buf ); } @@ -74,12 +68,10 @@ This function is non-blocking sub data_read { # -------------------------------------------------- - my ( $self, $bytes ) = @_; - my ( $count, $string ) = $self->{handle}->read($bytes); - if ( $Device::Firmata::DEBUG and $string ) { - print "<".join(",",map{sprintf"%02x",ord$_}split//,$string)."\n"; - } - return $string; + my ( $self, $bytes ) = @_; + my ( $count, $string ) = $self->{handle}->read($bytes); + print "<".join(",",map{sprintf"%02x",ord$_}split//,$string)."\n" if ( $Device::Firmata::DEBUG and $string ); + return $string; } 1; diff --git a/fhem/FHEM/lib/Device/Firmata/Language.pm b/fhem/FHEM/lib/Device/Firmata/Language.pm index 00425cb30..884897449 100644 --- a/fhem/FHEM/lib/Device/Firmata/Language.pm +++ b/fhem/FHEM/lib/Device/Firmata/Language.pm @@ -9,9 +9,9 @@ Device::Firmata::Language - Localization use strict; use vars qw/ - $FIRMATA_LOCALE + $FIRMATA_LOCALE $FIRMATA_LOCALE_PATH - $FIRMATA_LOCALE_MESSAGES + $FIRMATA_LOCALE_MESSAGES /; use Device::Firmata::Base ISA => 'Device::Firmata::Base', @@ -71,7 +71,6 @@ sub language { ( $m ||= {} )->{$1} = $2; } close $fh; - $m; }; @@ -88,13 +87,12 @@ sub language { my $message_template; # Get the message template in the following order: -# 1. The local object if available +# 1. The local object if available # 2. The global message object # 3. The provided default message # ref $self and $message_template = $self->{messages}{$key}; $message_template ||= $messages->{$key} || $message; - return sprintf( $message_template, @_ ); } @@ -104,5 +102,5 @@ __DATA__ FIRMATA__unhandled Unhandled attribute '%s' called FIRMATA__unknown Unknown/Unhandled error encountered: %s -FIRMATA__separator , +FIRMATA__separator , diff --git a/fhem/FHEM/lib/Device/Firmata/Platform.pm b/fhem/FHEM/lib/Device/Firmata/Platform.pm index d8b2f2bfe..33a493636 100644 --- a/fhem/FHEM/lib/Device/Firmata/Platform.pm +++ b/fhem/FHEM/lib/Device/Firmata/Platform.pm @@ -2,7 +2,7 @@ package Device::Firmata::Platform; =head1 NAME -Device::Firmata::Platform - platform specifics +Device::Firmata::Platform - Platform specifics =cut @@ -12,44 +12,44 @@ use Device::Firmata::Constants qw/ :all /; use Device::Firmata::IO; use Device::Firmata::Protocol; use Device::Firmata::Base - ISA => 'Device::Firmata::Base', - FIRMATA_ATTRIBS => { + ISA => 'Device::Firmata::Base', + FIRMATA_ATTRIBS => { - # Object handlers - io => undef, - protocol => undef, + # Object handlers + io => undef, + protocol => undef, - # Used for internal tracking of events/parameters - #protocol_version => undef, - #sysex_mode => undef, - sysex_data => [], + # Used for internal tracking of events/parameters + #protocol_version => undef, + #sysex_mode => undef, + sysex_data => [], - # To track internal status - analog_pins => [], - analog_resolutions => {}, - pwm_resolutions => {}, - servo_resolutions => {}, - ports => [], - pins => {}, - pin_modes => {}, + # To track internal status + analog_pins => [], + analog_resolutions => {}, + pwm_resolutions => {}, + servo_resolutions => {}, + ports => [], + pins => {}, + pin_modes => {}, - # To notify on events - digital_observer => [], - analog_observer => [], - sysex_observer => undef, - i2c_observer => undef, - onewire_observer => [], - scheduler_observer => undef, - string_observer => undef, - - # To track scheduled tasks - tasks => [], + # To notify on events + digital_observer => [], + analog_observer => [], + sysex_observer => undef, + i2c_observer => undef, + onewire_observer => [], + scheduler_observer => undef, + string_observer => undef, - # For information about the device. eg: firmware version - metadata => {}, - - # latest STRING_DATA response: - stringresponse => {}, + # To track scheduled tasks + tasks => [], + + # For information about the device. eg: firmware version + metadata => {}, + + # latest STRING_DATA response: + stringresponse => {}, }; =head2 open @@ -60,56 +60,46 @@ to find out how to connect to the device =cut sub open { - - # -------------------------------------------------- - my ( $pkg, $port, $opts ) = @_; - - my $self = ref $pkg ? $pkg : $pkg->new($opts); - - my $ioport = Device::Firmata::IO->open( $port, $opts ) or return; - - return $self->attach( $ioport, $opts ); + # -------------------------------------------------- + my ( $pkg, $port, $opts ) = @_; + my $self = ref $pkg ? $pkg : $pkg->new($opts); + my $ioport = Device::Firmata::IO->open( $port, $opts ) or return; + return $self->attach( $ioport, $opts ); } sub attach { - - # -------------------------------------------------- - # Attach to an open IO port and do some basic operations - # to find out how to connect to the device - # - my ( $pkg, $port, $opts ) = @_; - - my $self = ref $pkg ? $pkg : $pkg->new($opts); - - $self->{io} = $port or return; - $self->{protocol} = Device::Firmata::Protocol->new($opts) or return; - - return $self; + # -------------------------------------------------- + # Attach to an open IO port and do some basic operations + # to find out how to connect to the device + # + my ( $pkg, $port, $opts ) = @_; + my $self = ref $pkg ? $pkg : $pkg->new($opts); + $self->{io} = $port or return; + $self->{protocol} = Device::Firmata::Protocol->new($opts) or return; + return $self; } sub detach { - - my $self = shift; - - delete $self->{io}; + my $self = shift; + delete $self->{io}; } sub system_reset { - my $self = shift; - $self->{io}->data_write($self->{protocol}->message_prepare( SYSTEM_RESET => 0 )); - $self->{sysex_data} = []; - $self->{analog_pins} = []; - $self->{ports} = []; - $self->{pins} = {}; - $self->{pin_modes} = {}; - $self->{digital_observer} = []; - $self->{analog_observer} = []; - $self->{sysex_observer} = undef; - $self->{i2c_observer} = undef; - $self->{onewire_observer} = []; - $self->{scheduler_observer} = undef; - $self->{tasks} = []; - $self->{metadata} = {}; + my $self = shift; + $self->{io}->data_write($self->{protocol}->message_prepare( SYSTEM_RESET => 0 )); + $self->{sysex_data} = []; + $self->{analog_pins} = []; + $self->{ports} = []; + $self->{pins} = {}; + $self->{pin_modes} = {}; + $self->{digital_observer} = []; + $self->{analog_observer} = []; + $self->{sysex_observer} = undef; + $self->{i2c_observer} = undef; + $self->{onewire_observer} = []; + $self->{scheduler_observer} = undef; + $self->{tasks} = []; + $self->{metadata} = {}; } =head2 messages_handle @@ -121,104 +111,97 @@ them as required =cut sub messages_handle { + # -------------------------------------------------- + my ( $self, $messages ) = @_; + return unless $messages; + return unless @$messages; + # Now, handle the messages + my $proto = $self->{protocol}; + for my $message (@$messages) { + my $command = $message->{command_str}; + my $data = $message->{data}; + COMMAND_HANDLE: { + #* digital I/O message 0x90 port LSB(bits 0-6) MSB(bits 7-13) + # Handle pin messages + $command eq 'DIGITAL_MESSAGE' and do { + my $port_number = $message->{command} & 0x0f; + my $port_state = $data->[0] | ( $data->[1] << 7 ); + my $old_state = $self->{ports}[$port_number]; + my $changed_state = + defined $old_state ? $old_state ^ $port_state : 0xFF; + my $observers = $self->{digital_observer}; + my $pinbase = $port_number << 3; + for ( my $i = 0 ; $i < 8 ; $i++ ) { + my $pin = $pinbase + $i; + my $observer = $observers->[$pin]; + if ($observer) { + my $pin_mask = 1 << $i; + if ( $changed_state & $pin_mask ) { + $observer->{method}( + $pin, + defined $old_state + ? ( $old_state & $pin_mask ) > 0 + ? 1 + : 0 + : undef, + ( $port_state & $pin_mask ) > 0 ? 1 : 0, + $observer->{context} + ); + } + } + } + $self->{ports}[$port_number] = $port_state; + }; - # -------------------------------------------------- - my ( $self, $messages ) = @_; + # Handle analog pin messages + $command eq 'ANALOG_MESSAGE' and do { + my $pin_number = $message->{command} & 0x0f; + my $pin_value = ( $data->[0] | ( $data->[1] << 7 ) ); + if (defined $self->{metadata}{analog_mappings}) { + $pin_number = $self->{metadata}{analog_mappings}{$pin_number}; + } + my $observer = $self->{analog_observer}[$pin_number]; + if ($observer) { + my $old_value = $self->{analog_pins}[$pin_number]; + if ( !defined $old_value or !($old_value eq $pin_value) ) { + $observer->{method}( $pin_number, $old_value, $pin_value, $observer->{context} ); + } + } + $self->{analog_pins}[$pin_number] = $pin_value; + }; - return unless $messages; - return unless @$messages; + # Handle metadata information + $command eq 'REPORT_VERSION' and do { + $self->{metadata}{firmware_version} = sprintf "V_%i_%02i", + @$data; + last; + }; - # Now, handle the messages - my $proto = $self->{protocol}; - for my $message (@$messages) { - my $command = $message->{command_str}; - my $data = $message->{data}; + # SYSEX handling + $command eq 'START_SYSEX' and do { last; }; - COMMAND_HANDLE: { -#* digital I/O message 0x90 port LSB(bits 0-6) MSB(bits 7-13) - # Handle pin messages - $command eq 'DIGITAL_MESSAGE' and do { - my $port_number = $message->{command} & 0x0f; - my $port_state = $data->[0] | ( $data->[1] << 7 ); - my $old_state = $self->{ports}[$port_number]; - my $changed_state = - defined $old_state ? $old_state ^ $port_state : 0xFF; - my $observers = $self->{digital_observer}; - my $pinbase = $port_number << 3; - for ( my $i = 0 ; $i < 8 ; $i++ ) { - my $pin = $pinbase + $i; - my $observer = $observers->[$pin]; - if ($observer) { - my $pin_mask = 1 << $i; - if ( $changed_state & $pin_mask ) { - $observer->{method}( - $pin, - defined $old_state - ? ( $old_state & $pin_mask ) > 0 - ? 1 - : 0 - : undef, - ( $port_state & $pin_mask ) > 0 ? 1 : 0, - $observer->{context} - ); - } - } - } - $self->{ports}[$port_number] = $port_state; - }; - - # Handle analog pin messages - $command eq 'ANALOG_MESSAGE' and do { - my $pin_number = $message->{command} & 0x0f; - my $pin_value = ( $data->[0] | ( $data->[1] << 7 ) ); - if (defined $self->{metadata}{analog_mappings}) { - $pin_number = $self->{metadata}{analog_mappings}{$pin_number}; - } - my $observer = $self->{analog_observer}[$pin_number]; - if ($observer) { - my $old_value = $self->{analog_pins}[$pin_number]; - if ( !defined $old_value or !($old_value eq $pin_value) ) { - $observer->{method}( $pin_number, $old_value, $pin_value, $observer->{context} ); - } - } - $self->{analog_pins}[$pin_number] = $pin_value; - }; - - # Handle metadata information - $command eq 'REPORT_VERSION' and do { - $self->{metadata}{firmware_version} = sprintf "V_%i_%02i", - @$data; - last; - }; - - # SYSEX handling - $command eq 'START_SYSEX' and do { - last; - }; - $command eq 'DATA_SYSEX' and do { - my $sysex_data = $self->{sysex_data}; - push @$sysex_data, @$data; - last; - }; - $command eq 'END_SYSEX' and do { - my $sysex_data = $self->{sysex_data}; - my $sysex_message = $proto->sysex_parse($sysex_data); - if ( defined $sysex_message ) { - my $observer = $self->{sysex_observer}; - if (defined $observer) { - $observer->{method} ($sysex_message, $observer->{context}); - } - $self->sysex_handle($sysex_message); - } - $self->{sysex_data} = []; - last; - }; - - } - - $Device::Firmata::DEBUG and print " < $command\n"; - } + $command eq 'DATA_SYSEX' and do { + my $sysex_data = $self->{sysex_data}; + push @$sysex_data, @$data; + last; + }; + $command eq 'END_SYSEX' and do { + my $sysex_data = $self->{sysex_data}; + my $sysex_message = $proto->sysex_parse($sysex_data); + if ( defined $sysex_message ) { + my $observer = $self->{sysex_observer}; + if (defined $observer) { + $observer->{method} ($sysex_message, $observer->{context}); + } + $self->sysex_handle($sysex_message); + } + $self->{sysex_data} = []; + last; + }; + } + $Device::Firmata::DEBUG and print " < $command\n"; + } } =head2 sysex_handle @@ -230,123 +213,120 @@ them as required =cut sub sysex_handle { + # -------------------------------------------------- + my ( $self, $sysex_message ) = @_; + my $data = $sysex_message->{data}; - # -------------------------------------------------- - my ( $self, $sysex_message ) = @_; + COMMAND_HANDLER: { + $sysex_message->{command_str} eq 'REPORT_FIRMWARE' and do { + $self->{metadata}{firmware_version} = sprintf "V_%i_%02i", $data->{major_version}, $data->{minor_version}; + $self->{metadata}{firmware} = $data->{firmware}; + last; + }; - my $data = $sysex_message->{data}; + $sysex_message->{command_str} eq 'CAPABILITY_RESPONSE' and do { + my $capabilities = $data->{capabilities}; + $self->{metadata}{capabilities} = $capabilities; + my @analogpins; + my @inputpins; + my @outputpins; + my @pwmpins; + my @servopins; + my @shiftpins; + my @i2cpins; + my @onewirepins; + foreach my $pin (keys %$capabilities) { + if (defined $capabilities->{$pin}) { + if ($capabilities->{$pin}->{PIN_INPUT+0}) { + push @inputpins, $pin; + } + if ($capabilities->{$pin}->{PIN_OUTPUT+0}) { + push @outputpins, $pin; + } + if ($capabilities->{$pin}->{PIN_ANALOG+0}) { + push @analogpins, $pin; + $self->{metadata}{analog_resolutions}{$pin} = $capabilities->{$pin}->{PIN_ANALOG+0}->{resolution}; + } + if ($capabilities->{$pin}->{PIN_PWM+0}) { + push @pwmpins, $pin; + $self->{metadata}{pwm_resolutions}{$pin} = $capabilities->{$pin}->{PIN_PWM+0}->{resolution}; + } + if ($capabilities->{$pin}->{PIN_SERVO+0}) { + push @servopins, $pin; + $self->{metadata}{servo_resolutions}{$pin} = $capabilities->{$pin}->{PIN_SERVO+0}->{resolution}; + } + if ($capabilities->{$pin}->{PIN_SHIFT+0}) { + push @shiftpins, $pin; + } + if ($capabilities->{$pin}->{PIN_I2C+0}) { + push @i2cpins, $pin; + } + if ($capabilities->{$pin}->{PIN_ONEWIRE+0}) { + push @onewirepins, $pin; + } + } + } + $self->{metadata}{input_pins} = \@inputpins; + $self->{metadata}{output_pins} = \@outputpins; + $self->{metadata}{analog_pins} = \@analogpins; + $self->{metadata}{pwm_pins} = \@pwmpins; + $self->{metadata}{servo_pins} = \@servopins; + $self->{metadata}{shift_pins} = \@shiftpins; + $self->{metadata}{i2c_pins} = \@i2cpins; + $self->{metadata}{onewire_pins} = \@onewirepins; + last; + }; - COMMAND_HANDLER: { - $sysex_message->{command_str} eq 'REPORT_FIRMWARE' and do { - $self->{metadata}{firmware_version} = sprintf "V_%i_%02i", - $data->{major_version}, $data->{minor_version}; - $self->{metadata}{firmware} = $data->{firmware}; - last; - }; - - $sysex_message->{command_str} eq 'CAPABILITY_RESPONSE' and do { - my $capabilities = $data->{capabilities}; - $self->{metadata}{capabilities} = $capabilities; - my @analogpins; - my @inputpins; - my @outputpins; - my @pwmpins; - my @servopins; - my @shiftpins; - my @i2cpins; - my @onewirepins; - foreach my $pin (keys %$capabilities) { - if (defined $capabilities->{$pin}) { - if ($capabilities->{$pin}->{PIN_INPUT+0}) { - push @inputpins, $pin; - } - if ($capabilities->{$pin}->{PIN_OUTPUT+0}) { - push @outputpins, $pin; - } - if ($capabilities->{$pin}->{PIN_ANALOG+0}) { - push @analogpins, $pin; - $self->{metadata}{analog_resolutions}{$pin} = $capabilities->{$pin}->{PIN_ANALOG+0}->{resolution}; - } - if ($capabilities->{$pin}->{PIN_PWM+0}) { - push @pwmpins, $pin; - $self->{metadata}{pwm_resolutions}{$pin} = $capabilities->{$pin}->{PIN_PWM+0}->{resolution}; - } - if ($capabilities->{$pin}->{PIN_SERVO+0}) { - push @servopins, $pin; - $self->{metadata}{servo_resolutions}{$pin} = $capabilities->{$pin}->{PIN_SERVO+0}->{resolution}; - } - if ($capabilities->{$pin}->{PIN_SHIFT+0}) { - push @shiftpins, $pin; - } - if ($capabilities->{$pin}->{PIN_I2C+0}) { - push @i2cpins, $pin; - } - if ($capabilities->{$pin}->{PIN_ONEWIRE+0}) { - push @onewirepins, $pin; - } - } - } - $self->{metadata}{input_pins} = \@inputpins; - $self->{metadata}{output_pins} = \@outputpins; - $self->{metadata}{analog_pins} = \@analogpins; - $self->{metadata}{pwm_pins} = \@pwmpins; - $self->{metadata}{servo_pins} = \@servopins; - $self->{metadata}{shift_pins} = \@shiftpins; - $self->{metadata}{i2c_pins} = \@i2cpins; - $self->{metadata}{onewire_pins} = \@onewirepins; - last; - }; - - $sysex_message->{command_str} eq 'ANALOG_MAPPING_RESPONSE' and do { - $self->{metadata}{analog_mappings} = $data->{mappings}; - last; - }; - - $sysex_message->{command_str} eq 'PIN_STATE_RESPONSE' and do { - if (!defined $self->{metadata}{pinstates}) { - $self->{metadata}{pinstates} = {}; - }; - $self->{metadata}{pinstates}{ $data->{pin} } = { - mode => $data->{mode}, - state => $data->{state}, - }; - last; - }; + $sysex_message->{command_str} eq 'ANALOG_MAPPING_RESPONSE' and do { + $self->{metadata}{analog_mappings} = $data->{mappings}; + last; + }; - $sysex_message->{command_str} eq 'I2C_REPLY' and do { - my $observer = $self->{i2c_observer}; - if (defined $observer) { - $observer->{method}( $data, $observer->{context} ); - } - last; - }; + $sysex_message->{command_str} eq 'PIN_STATE_RESPONSE' and do { + if (!defined $self->{metadata}{pinstates}) { + $self->{metadata}{pinstates} = {}; + }; + $self->{metadata}{pinstates}{ $data->{pin} } = { + mode => $data->{mode}, + state => $data->{state}, + }; + last; + }; - $sysex_message->{command_str} eq 'ONEWIRE_DATA' and do { - my $pin = $data->{pin}; - my $observer = $self->{onewire_observer}[$pin]; - if (defined $observer) { - $observer->{method}( $data, $observer->{context} ); - } - last; - }; - - $sysex_message->{command_str} eq 'SCHEDULER_DATA' and do { - my $observer = $self->{scheduler_observer}; - if (defined $observer) { - $observer->{method}( $data, $observer->{context} ); - } - last; - }; - - $sysex_message->{command_str} eq 'STRING_DATA' and do { - my $observer = $self->{string_observer}; - $self->{stringresponse} = $data->{string}; - if (defined $observer) { - $observer->{method}( $data->{string}, $observer->{context} ); - } - last; - } - } + $sysex_message->{command_str} eq 'I2C_REPLY' and do { + my $observer = $self->{i2c_observer}; + if (defined $observer) { + $observer->{method}( $data, $observer->{context} ); + } + last; + }; + + $sysex_message->{command_str} eq 'ONEWIRE_DATA' and do { + my $pin = $data->{pin}; + my $observer = $self->{onewire_observer}[$pin]; + if (defined $observer) { + $observer->{method}( $data, $observer->{context} ); + } + last; + }; + + $sysex_message->{command_str} eq 'SCHEDULER_DATA' and do { + my $observer = $self->{scheduler_observer}; + if (defined $observer) { + $observer->{method}( $data, $observer->{context} ); + } + last; + }; + + $sysex_message->{command_str} eq 'STRING_DATA' and do { + my $observer = $self->{string_observer}; + $self->{stringresponse} = $data->{string}; + if (defined $observer) { + $observer->{method}( $data->{string}, $observer->{context} ); + } + last; + } + } } =head2 probe @@ -361,136 +341,131 @@ and analog mapping and capability. =cut sub probe { + # -------------------------------------------------- + my ($self) = @_; + $self->{metadata}{firmware} = ''; + $self->{metadata}{firmware_version} = ''; - # -------------------------------------------------- - my ($self) = @_; - - $self->{metadata}{firmware} = ''; - $self->{metadata}{firmware_version} = ''; - - # Wait for 5 seconds only - my $end_tics = time + 5; - $self->firmware_version_query(); - while ( $end_tics >= time ) { - select( undef, undef, undef, 0.2 ); # wait for response - if ( $self->poll && $self->{metadata}{firmware} && $self->{metadata}{firmware_version} ) { - $self->{protocol}->{protocol_version} = $self->{metadata}{firmware_version}; - if ( $self->{metadata}{capabilities} ) { - if ( $self->{metadata}{analog_mappings} ) { - return 1; - } - else { - $self->analog_mapping_query(); - } - } - else { - $self->capability_query(); - } - } - else { - $self->firmware_version_query() unless $end_tics - 2 >= time; # version query on last 2 sec only - } - } - return; + # Wait for 5 seconds only + my $end_tics = time + 5; + $self->firmware_version_query(); + while ( $end_tics >= time ) { + select( undef, undef, undef, 0.2 ); # wait for response + if ( $self->poll && $self->{metadata}{firmware} && $self->{metadata}{firmware_version} ) { + $self->{protocol}->{protocol_version} = $self->{metadata}{firmware_version}; + if ( $self->{metadata}{capabilities} ) { + if ( $self->{metadata}{analog_mappings} ) { + return 1; + } else { + $self->analog_mapping_query(); + } + } else { + $self->capability_query(); + } + } else { + $self->firmware_version_query() unless $end_tics - 2 >= time; # version query on last 2 sec only + } + } + return; } =head2 pin_mode -Similar to the pinMode function on the +Similar to the pinMode function on the arduino =cut sub pin_mode { - - # -------------------------------------------------- - my ( $self, $pin, $mode ) = @_; + + # -------------------------------------------------- + my ( $self, $pin, $mode ) = @_; die "unsupported mode '".$mode."' for pin '".$pin."'" unless $self->is_supported_mode($pin,$mode); - PIN_MODE_HANDLER: { - - ( $mode == PIN_INPUT or $mode == PIN_OUTPUT ) and do { - my $port_number = $pin >> 3; - $self->{io}->data_write($self->{protocol}->message_prepare( REPORT_DIGITAL => $port_number, 1 )); - $self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode )); - last; - }; + PIN_MODE_HANDLER: { - $mode == PIN_ANALOG and do { - my $port_number = $pin >> 3; - $self->{io}->data_write($self->{protocol}->message_prepare( REPORT_ANALOG => $port_number, 1 )); - $self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode )); - last; - }; + ( $mode == PIN_INPUT or $mode == PIN_OUTPUT ) and do { + my $port_number = $pin >> 3; + $self->{io}->data_write($self->{protocol}->message_prepare( REPORT_DIGITAL => $port_number, 1 )); + $self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode )); + last; + }; - $self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode )); - }; - $self->{pin_modes}->{$pin} = $mode; - return 1; + $mode == PIN_ANALOG and do { + my $port_number = $pin >> 3; + $self->{io}->data_write($self->{protocol}->message_prepare( REPORT_ANALOG => $port_number, 1 )); + $self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode )); + last; + }; + + $self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode )); + }; + $self->{pin_modes}->{$pin} = $mode; + return 1; } =head2 digital_write -Analogous to the digitalWrite function on the +Analogous to the digitalWrite function on the arduino =cut sub digital_write { - # -------------------------------------------------- - my ( $self, $pin, $state ) = @_; - die "pin '".$pin."' is not configured for mode 'INPUT' or 'OUTPUT'" unless ($self->is_configured_mode($pin,PIN_OUTPUT) or $self->is_configured_mode($pin,PIN_INPUT)); - my $port_number = $pin >> 3; + # -------------------------------------------------- + my ( $self, $pin, $state ) = @_; + die "pin '".$pin."' is not configured for mode 'INPUT' or 'OUTPUT'" unless ($self->is_configured_mode($pin,PIN_OUTPUT) or $self->is_configured_mode($pin,PIN_INPUT)); + my $port_number = $pin >> 3; - my $pin_offset = $pin % 8; - my $pin_mask = 1 << $pin_offset; + my $pin_offset = $pin % 8; + my $pin_mask = 1 << $pin_offset; - my $port_state = $self->{ports}[$port_number] ||= 0; - if ($state) { - $port_state |= $pin_mask; - } - else { - $port_state &= $pin_mask ^ 0xff; - } - $self->{ports}[$port_number] = $port_state; - $self->{io}->data_write($self->{protocol}->message_prepare( DIGITAL_MESSAGE => $port_number, $port_state & 0x7f, $port_state >> 7 )); - return 1; + my $port_state = $self->{ports}[$port_number] ||= 0; + if ($state) { + $port_state |= $pin_mask; + } + else { + $port_state &= $pin_mask ^ 0xff; + } + $self->{ports}[$port_number] = $port_state; + $self->{io}->data_write($self->{protocol}->message_prepare( DIGITAL_MESSAGE => $port_number, $port_state & 0x7f, $port_state >> 7 )); + return 1; } =head2 digital_read -Analogous to the digitalRead function on the +Analogous to the digitalRead function on the arduino =cut sub digital_read { - # -------------------------------------------------- - my ( $self, $pin ) = @_; - die "pin '".$pin."' is not configured for mode 'INPUT'" unless $self->is_configured_mode($pin,PIN_INPUT); - my $port_number = $pin >> 3; - my $pin_offset = $pin % 8; - my $pin_mask = 1 << $pin_offset; - my $port_state = $self->{ports}[$port_number] ||= 0; - return ( $port_state & $pin_mask ? 1 : 0 ); + # -------------------------------------------------- + my ( $self, $pin ) = @_; + die "pin '".$pin."' is not configured for mode 'INPUT'" unless $self->is_configured_mode($pin,PIN_INPUT); + my $port_number = $pin >> 3; + my $pin_offset = $pin % 8; + my $pin_mask = 1 << $pin_offset; + my $port_state = $self->{ports}[$port_number] ||= 0; + return ( $port_state & $pin_mask ? 1 : 0 ); } =head2 analog_read -Fetches the analog value of a pin +Fetches the analog value of a pin =cut sub analog_read { - # -------------------------------------------------- - # - my ( $self, $pin ) = @_; - die "pin '".$pin."' is not configured for mode 'ANALOG'" unless $self->is_configured_mode($pin,PIN_ANALOG); - return $self->{analog_pins}[$pin]; + # -------------------------------------------------- + # + my ( $self, $pin ) = @_; + die "pin '".$pin."' is not configured for mode 'ANALOG'" unless $self->is_configured_mode($pin,PIN_ANALOG); + return $self->{analog_pins}[$pin]; } =head2 analog_write @@ -499,16 +474,16 @@ sub analog_read { sub analog_write { - # -------------------------------------------------- - # Sets the PWM value on an arduino - # - my ( $self, $pin, $value ) = @_; - die "pin '".$pin."' is not configured for mode 'PWM'" unless $self->is_configured_mode($pin,PIN_PWM); + # -------------------------------------------------- + # Sets the PWM value on an arduino + # + my ( $self, $pin, $value ) = @_; + die "pin '".$pin."' is not configured for mode 'PWM'" unless $self->is_configured_mode($pin,PIN_PWM); - # FIXME: 8 -> 7 bit translation should be done in the protocol module - my $byte_0 = $value & 0x7f; - my $byte_1 = $value >> 7; - return $self->{io}->data_write($self->{protocol}->message_prepare( ANALOG_MESSAGE => $pin, $byte_0, $byte_1 )); + # FIXME: 8 -> 7 bit translation should be done in the protocol module + my $byte_0 = $value & 0x7f; + my $byte_1 = $value >> 7; + return $self->{io}->data_write($self->{protocol}->message_prepare( ANALOG_MESSAGE => $pin, $byte_0, $byte_1 )); } =head2 pwm_write @@ -520,243 +495,242 @@ pmw_write is an alias for analog_write *pwm_write = *analog_write; sub firmware_version_query { - my $self = shift; - my $firmware_version_query_packet = $self->{protocol}->packet_query_firmware; - return $self->{io}->data_write($firmware_version_query_packet); + my $self = shift; + my $firmware_version_query_packet = $self->{protocol}->packet_query_firmware; + return $self->{io}->data_write($firmware_version_query_packet); } sub capability_query { - my $self = shift; - my $capability_query_packet = $self->{protocol}->packet_query_capability(); - return $self->{io}->data_write($capability_query_packet); + my $self = shift; + my $capability_query_packet = $self->{protocol}->packet_query_capability(); + return $self->{io}->data_write($capability_query_packet); } sub analog_mapping_query { - my $self = shift; - my $analog_mapping_query_packet = $self->{protocol}->packet_query_analog_mapping(); - return $self->{io}->data_write($analog_mapping_query_packet); + my $self = shift; + my $analog_mapping_query_packet = $self->{protocol}->packet_query_analog_mapping(); + return $self->{io}->data_write($analog_mapping_query_packet); } sub pin_state_query { - my ($self,$pin) = @_; - my $pin_state_query_packet = $self->{protocol}->packet_query_pin_state($pin); - return $self->{io}->data_write($pin_state_query_packet); + my ($self,$pin) = @_; + my $pin_state_query_packet = $self->{protocol}->packet_query_pin_state($pin); + return $self->{io}->data_write($pin_state_query_packet); } sub sampling_interval { - my ( $self, $sampling_interval ) = @_; - my $sampling_interval_packet = - $self->{protocol}->packet_sampling_interval($sampling_interval); - return $self->{io}->data_write($sampling_interval_packet); + my ( $self, $sampling_interval ) = @_; + my $sampling_interval_packet = $self->{protocol}->packet_sampling_interval($sampling_interval); + return $self->{io}->data_write($sampling_interval_packet); } sub i2c_write { - my ($self,$address,@data) = @_; - return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x0,@data)); + my ($self,$address,@data) = @_; + return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x0,@data)); } sub i2c_readonce { - my ($self,$address,$register,$numbytes) = @_; - my $packet = (defined $numbytes) - ? $self->{protocol}->packet_i2c_request($address,0x8,$register,$numbytes) - : $self->{protocol}->packet_i2c_request($address,0x8,$register); - return $self->{io}->data_write($packet); + my ($self,$address,$register,$numbytes) = @_; + my $packet = (defined $numbytes) + ? $self->{protocol}->packet_i2c_request($address,0x8,$register,$numbytes) + : $self->{protocol}->packet_i2c_request($address,0x8,$register); + return $self->{io}->data_write($packet); } sub i2c_read { - my ($self,$address,$register,$numbytes) = @_; - return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x10,$register,$numbytes)); + my ($self,$address,$register,$numbytes) = @_; + return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x10,$register,$numbytes)); } sub i2c_stopreading { - my ($self,$address) = @_; - return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x18)); + my ($self,$address) = @_; + return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x18)); } sub i2c_config { - my ( $self, $delay, @data ) = @_; - return $self->{io}->data_write($self->{protocol}->packet_i2c_config($delay,@data)); + my ( $self, $delay, @data ) = @_; + return $self->{io}->data_write($self->{protocol}->packet_i2c_config($delay,@data)); } sub servo_write { - # -------------------------------------------------- - # Sets the SERVO value on an arduino - # - my ( $self, $pin, $value ) = @_; - die "pin '".$pin."' is not configured for mode 'SERVO'" unless $self->is_configured_mode($pin,PIN_SERVO); + # -------------------------------------------------- + # Sets the SERVO value on an arduino + # + my ( $self, $pin, $value ) = @_; + die "pin '".$pin."' is not configured for mode 'SERVO'" unless $self->is_configured_mode($pin,PIN_SERVO); - # FIXME: 8 -> 7 bit translation should be done in the protocol module - my $byte_0 = $value & 0x7f; - my $byte_1 = $value >> 7; - return $self->{io}->data_write($self->{protocol}->message_prepare( ANALOG_MESSAGE => $pin, $byte_0, $byte_1 )); + # FIXME: 8 -> 7 bit translation should be done in the protocol module + my $byte_0 = $value & 0x7f; + my $byte_1 = $value >> 7; + return $self->{io}->data_write($self->{protocol}->message_prepare( ANALOG_MESSAGE => $pin, $byte_0, $byte_1 )); } sub servo_config { - my ( $self, $pin, $args ) = @_; - die "pin '".$pin."' is not configured for mode 'SERVO'" unless $self->is_configured_mode($pin,PIN_SERVO); - return $self->{io}->data_write($self->{protocol}->packet_servo_config_request($pin,$args)); + my ( $self, $pin, $args ) = @_; + die "pin '".$pin."' is not configured for mode 'SERVO'" unless $self->is_configured_mode($pin,PIN_SERVO); + return $self->{io}->data_write($self->{protocol}->packet_servo_config_request($pin,$args)); } sub scheduler_create_task { - my $self = shift; - my $id=-1; - my $tasks = $self->{tasks}; - for my $task (@$tasks) { - if ($id < $task->{id}) { - $id = $task->{id}; - } - } - $id++; - my $newtask = { - id => $id, - data => [], - time_ms => undef, - }; - push @$tasks,$newtask; - return $id; + my $self = shift; + my $id=-1; + my $tasks = $self->{tasks}; + for my $task (@$tasks) { + if ($id < $task->{id}) { + $id = $task->{id}; + } + } + $id++; + my $newtask = { + id => $id, + data => [], + time_ms => undef, + }; + push @$tasks,$newtask; + return $id; } sub scheduler_delete_task { - my ($self,$id) = @_; - my $tasks = $self->{tasks}; - for my $task (@$tasks) { - if ($id == $task->{id}) { - if (defined $task->{time_ms}) { - my $packet = $self->{protocol}->packet_delete_task($id); - $self->{io}->data_write($packet); - } - delete $self->{tasks}[$id]; # delete $array[index]; (not delete @array[index];) - last; - } - } + my ($self,$id) = @_; + my $tasks = $self->{tasks}; + for my $task (@$tasks) { + if ($id == $task->{id}) { + if (defined $task->{time_ms}) { + my $packet = $self->{protocol}->packet_delete_task($id); + $self->{io}->data_write($packet); + } + delete $self->{tasks}[$id]; # delete $array[index]; (not delete @array[index];) + last; + } + } } sub scheduler_add_to_task { - my ($self,$id,$packet) = @_; - my $tasks = $self->{tasks}; - for my $task (@$tasks) { - if ($id == $task->{id}) { - my $data = $task->{data}; - push @$data,unpack "C*", $packet; - last; - } - } + my ($self,$id,$packet) = @_; + my $tasks = $self->{tasks}; + for my $task (@$tasks) { + if ($id == $task->{id}) { + my $data = $task->{data}; + push @$data,unpack "C*", $packet; + last; + } + } } sub scheduler_schedule_task { - my ($self,$id,$time_ms) = @_; - my $tasks = $self->{tasks}; - for my $task (@$tasks) { - if ($id == $task->{id}) { - if (!(defined $task->{time_ms})) { # TODO - a bit unclear why I put this test here in the first place. -> TODO: investigate and remove this check if not nessesary - my $data = $task->{data}; - my $len = @$data; - my $packet = $self->{protocol}->packet_create_task($id,$len); - $self->{io}->data_write($packet); - my $bytesPerPacket = 53; # (64-1)*7/8-2 (1 byte command, 1 byte for subcommand, 1 byte taskid) - my $j=0; - my @packetdata; - for (my $i=0;$i<$len;$i++) { - push @packetdata,@$data[$i]; - $j++; - if ($j==$bytesPerPacket) { - $j=0; - $packet = $self->{protocol}->packet_add_to_task($id,@packetdata); - $self->{io}->data_write($packet); - @packetdata = (); - } - } - if ($j>0) { - $packet = $self->{protocol}->packet_add_to_task($id,@packetdata); - $self->{io}->data_write($packet); - } - } - my $packet = $self->{protocol}->packet_schedule_task($id,$time_ms); - $self->{io}->data_write($packet); - last; - } - } + my ($self,$id,$time_ms) = @_; + my $tasks = $self->{tasks}; + for my $task (@$tasks) { + if ($id == $task->{id}) { + if (!(defined $task->{time_ms})) { # TODO - a bit unclear why I put this test here in the first place. -> TODO: investigate and remove this check if not nessesary + my $data = $task->{data}; + my $len = @$data; + my $packet = $self->{protocol}->packet_create_task($id,$len); + $self->{io}->data_write($packet); + my $bytesPerPacket = 53; # (64-1)*7/8-2 (1 byte command, 1 byte for subcommand, 1 byte taskid) + my $j=0; + my @packetdata; + for (my $i=0;$i<$len;$i++) { + push @packetdata,@$data[$i]; + $j++; + if ($j==$bytesPerPacket) { + $j=0; + $packet = $self->{protocol}->packet_add_to_task($id,@packetdata); + $self->{io}->data_write($packet); + @packetdata = (); + } + } + if ($j>0) { + $packet = $self->{protocol}->packet_add_to_task($id,@packetdata); + $self->{io}->data_write($packet); + } + } + my $packet = $self->{protocol}->packet_schedule_task($id,$time_ms); + $self->{io}->data_write($packet); + last; + } + } } sub scheduler_reset { - my $self = shift; - my $packet = $self->{protocol}->packet_reset_scheduler; - $self->{io}->data_write($packet); - $self->{tasks} = []; + my $self = shift; + my $packet = $self->{protocol}->packet_reset_scheduler; + $self->{io}->data_write($packet); + $self->{tasks} = []; } sub scheduler_query_all_tasks { - my $self = shift; - my $packet = $self->{protocol}->packet_query_all_tasks; - $self->{io}->data_write($packet); + my $self = shift; + my $packet = $self->{protocol}->packet_query_all_tasks; + $self->{io}->data_write($packet); } sub scheduler_query_task { - my ($self,$id) = @_; - my $packet = $self->{protocol}->packet_query_task($id); - $self->{io}->data_write($packet); + my ($self,$id) = @_; + my $packet = $self->{protocol}->packet_query_task($id); + $self->{io}->data_write($packet); } -# SEARCH_REQUEST, -# CONFIG_REQUEST, +# SEARCH_REQUEST, +# CONFIG_REQUEST, #$args = { -# reset => undef | 1, -# skip => undef | 1, -# select => undef | device, -# read => undef | short int, -# delay => undef | long int, -# write => undef | bytes[], +# reset => undef | 1, +# skip => undef | 1, +# select => undef | device, +# read => undef | short int, +# delay => undef | long int, +# write => undef | bytes[], #} sub onewire_search { - my ( $self, $pin ) = @_; - die "pin '".$pin."' is not configured for mode 'ONEWIRE'" unless $self->is_configured_mode($pin,PIN_ONEWIRE); - return $self->{io}->data_write($self->{protocol}->packet_onewire_search_request( $pin )); + my ( $self, $pin ) = @_; + die "pin '".$pin."' is not configured for mode 'ONEWIRE'" unless $self->is_configured_mode($pin,PIN_ONEWIRE); + return $self->{io}->data_write($self->{protocol}->packet_onewire_search_request( $pin )); } sub onewire_search_alarms { - my ( $self, $pin ) = @_; - die "pin '".$pin."' is not configured for mode 'ONEWIRE'" unless $self->is_configured_mode($pin,PIN_ONEWIRE); - return $self->{io}->data_write($self->{protocol}->packet_onewire_search_alarms_request( $pin )); + my ( $self, $pin ) = @_; + die "pin '".$pin."' is not configured for mode 'ONEWIRE'" unless $self->is_configured_mode($pin,PIN_ONEWIRE); + return $self->{io}->data_write($self->{protocol}->packet_onewire_search_alarms_request( $pin )); } sub onewire_config { - my ( $self, $pin, $power ) = @_; - die "pin '".$pin."' is not configured for mode 'ONEWIRE'" unless $self->is_configured_mode($pin,PIN_ONEWIRE); - return $self->{io}->data_write($self->{protocol}->packet_onewire_config_request( $pin, $power )); + my ( $self, $pin, $power ) = @_; + die "pin '".$pin."' is not configured for mode 'ONEWIRE'" unless $self->is_configured_mode($pin,PIN_ONEWIRE); + return $self->{io}->data_write($self->{protocol}->packet_onewire_config_request( $pin, $power )); } sub onewire_reset { - my ( $self, $pin ) = @_; - return $self->onewire_command_series( $pin, {reset => 1} ); + my ( $self, $pin ) = @_; + return $self->onewire_command_series( $pin, {reset => 1} ); } sub onewire_skip { - my ( $self, $pin ) = @_; - return $self->onewire_command_series( $pin, {skip => 1} ); + my ( $self, $pin ) = @_; + return $self->onewire_command_series( $pin, {skip => 1} ); } sub onewire_select { - my ( $self, $pin, $device ) = @_; - return $self->onewire_command_series( $pin, {select => $device} ); + my ( $self, $pin, $device ) = @_; + return $self->onewire_command_series( $pin, {select => $device} ); } sub onewire_read { - my ( $self, $pin, $numBytes ) = @_; - return $self->onewire_command_series( $pin, {read => $numBytes} ); + my ( $self, $pin, $numBytes ) = @_; + return $self->onewire_command_series( $pin, {read => $numBytes} ); } sub onewire_write { - my ( $self, $pin, @data ) = @_; - return $self->onewire_command_series( $pin, {write => \@data} ); + my ( $self, $pin, @data ) = @_; + return $self->onewire_command_series( $pin, {write => \@data} ); } sub onewire_command_series { - my ( $self, $pin, $args ) = @_; - die "pin '".$pin."' is not configured for mode 'ONEWIRE'" unless $self->is_configured_mode($pin,PIN_ONEWIRE); - return $self->{io}->data_write($self->{protocol}->packet_onewire_request( $pin, $args )); + my ( $self, $pin, $args ) = @_; + die "pin '".$pin."' is not configured for mode 'ONEWIRE'" unless $self->is_configured_mode($pin,PIN_ONEWIRE); + return $self->{io}->data_write($self->{protocol}->packet_onewire_request( $pin, $args )); } =head2 poll @@ -769,91 +743,91 @@ and process data from the arduino sub poll { - # -------------------------------------------------- - my $self = shift; - my $buf = $self->{io}->data_read(512) or return; - my $messages = $self->{protocol}->message_data_receive($buf); - $self->messages_handle($messages); - return $messages; + # -------------------------------------------------- + my $self = shift; + my $buf = $self->{io}->data_read(2048) or return; + my $messages = $self->{protocol}->message_data_receive($buf); + $self->messages_handle($messages); + return $messages; } sub observe_digital { - my ( $self, $pin, $observer, $context ) = @_; - die "unsupported mode 'INPUT' for pin '".$pin."'" unless ($self->is_supported_mode($pin,PIN_INPUT)); - $self->{digital_observer}[$pin] = { - method => $observer, - context => $context, - }; - return 1; + my ( $self, $pin, $observer, $context ) = @_; + die "unsupported mode 'INPUT' for pin '".$pin."'" unless ($self->is_supported_mode($pin,PIN_INPUT)); + $self->{digital_observer}[$pin] = { + method => $observer, + context => $context, + }; + return 1; } sub observe_analog { - my ( $self, $pin, $observer, $context ) = @_; - die "unsupported mode 'ANALOG' for pin '".$pin."'" unless ($self->is_supported_mode($pin,PIN_ANALOG)); - $self->{analog_observer}[$pin] = { - method => $observer, - context => $context, - }; - return 1; + my ( $self, $pin, $observer, $context ) = @_; + die "unsupported mode 'ANALOG' for pin '".$pin."'" unless ($self->is_supported_mode($pin,PIN_ANALOG)); + $self->{analog_observer}[$pin] = { + method => $observer, + context => $context, + }; + return 1; } sub observe_sysex { - my ( $self, $observer, $context ) = @_; - $self->{sysex_observer} = { - method => $observer, - context => $context, - }; - return 1; + my ( $self, $observer, $context ) = @_; + $self->{sysex_observer} = { + method => $observer, + context => $context, + }; + return 1; } sub observe_i2c { - my ( $self, $observer, $context ) = @_; - return undef if (defined $self->{metadata}->{i2cpins} && @$self->{metadata}->{i2cpins} == 0 ); - $self->{i2c_observer} = { - method => $observer, - context => $context, - }; - return 1; + my ( $self, $observer, $context ) = @_; + return undef if (defined $self->{metadata}->{i2cpins} && @$self->{metadata}->{i2cpins} == 0 ); + $self->{i2c_observer} = { + method => $observer, + context => $context, + }; + return 1; } sub observe_onewire { - my ( $self, $pin, $observer, $context ) = @_; - die "unsupported mode 'ONEWIRE' for pin '".$pin."'" unless ($self->is_supported_mode($pin,PIN_ONEWIRE)); - $self->{onewire_observer}[$pin] = { - method => $observer, - context => $context, - }; - return 1; + my ( $self, $pin, $observer, $context ) = @_; + die "unsupported mode 'ONEWIRE' for pin '".$pin."'" unless ($self->is_supported_mode($pin,PIN_ONEWIRE)); + $self->{onewire_observer}[$pin] = { + method => $observer, + context => $context, + }; + return 1; } sub observe_scheduler { - my ( $self, $observer, $context ) = @_; - $self->{scheduler_observer} = { - method => $observer, - context => $context, - }; - return 1; + my ( $self, $observer, $context ) = @_; + $self->{scheduler_observer} = { + method => $observer, + context => $context, + }; + return 1; } sub observe_string { - my ( $self, $observer, $context ) = @_; - $self->{string_observer} = { - method => $observer, - context => $context, - }; - return 1; + my ( $self, $observer, $context ) = @_; + $self->{string_observer} = { + method => $observer, + context => $context, + }; + return 1; } sub is_supported_mode { - my ($self,$pin,$mode) = @_; - return undef if (defined $self->{metadata}->{capabilities} and (!(defined $self->{metadata}->{capabilities}->{$pin}) or !(defined $self->{metadata}->{capabilities}->{$pin}->{$mode}))); - return 1; + my ($self,$pin,$mode) = @_; + return undef if (defined $self->{metadata}->{capabilities} and (!(defined $self->{metadata}->{capabilities}->{$pin}) or !(defined $self->{metadata}->{capabilities}->{$pin}->{$mode}))); + return 1; } sub is_configured_mode { - my ($self,$pin,$mode) = @_; - return undef if (!defined $self->{pin_modes}->{$pin} or $self->{pin_modes}->{$pin} != $mode); - return 1; + my ($self,$pin,$mode) = @_; + return undef if (!defined $self->{pin_modes}->{$pin} or $self->{pin_modes}->{$pin} != $mode); + return 1; } 1; diff --git a/fhem/FHEM/lib/Device/Firmata/Protocol.pm b/fhem/FHEM/lib/Device/Firmata/Protocol.pm index d137d1252..47af6d94c 100644 --- a/fhem/FHEM/lib/Device/Firmata/Protocol.pm +++ b/fhem/FHEM/lib/Device/Firmata/Protocol.pm @@ -1,6 +1,6 @@ package Device::Firmata::Protocol; -=head1 NAME +=head1 NAME Device::Firmata::Protocol - details of the actual firmata protocol @@ -11,93 +11,93 @@ use warnings; use vars qw/ $MIDI_DATA_SIZES /; use constant { - MIDI_COMMAND => 0x80, - MIDI_PARSE_NORMAL => 0, - MIDI_PARSE_SYSEX => 1, - MIDI_START_SYSEX => 0xf0, - MIDI_END_SYSEX => 0xf7, + MIDI_COMMAND => 0x80, + MIDI_PARSE_NORMAL => 0, + MIDI_PARSE_SYSEX => 1, + MIDI_START_SYSEX => 0xf0, + MIDI_END_SYSEX => 0xf7, }; use Device::Firmata::Constants qw/ :all /; use Device::Firmata::Base - ISA => 'Device::Firmata::Base', - FIRMATA_ATTRIBS => { - buffer => [], - parse_status => MIDI_PARSE_NORMAL, - protocol_version => 'V_2_04', # We are starting with the highest protocol + ISA => 'Device::Firmata::Base', + FIRMATA_ATTRIBS => { + buffer => [], + parse_status => MIDI_PARSE_NORMAL, + protocol_version => 'V_2_04', # We are starting with the highest protocol }; $MIDI_DATA_SIZES = { - 0x80 => 2, - 0x90 => 2, - 0xA0 => 2, - 0xB0 => 2, - 0xC0 => 1, - 0xD0 => 1, - 0xE0 => 2, - 0xF0 => 0, # note that this requires special handling + 0x80 => 2, + 0x90 => 2, + 0xA0 => 2, + 0xB0 => 2, + 0xC0 => 1, + 0xD0 => 1, + 0xE0 => 2, + 0xF0 => 0, # note that this requires special handling - # Special for version queries - 0xF4 => 2, - 0xF9 => 2, - 0x71 => 0, - 0xFF => 0, + # Special for version queries + 0xF4 => 2, + 0xF9 => 2, + 0x71 => 0, + 0xFF => 0, }; our $ONE_WIRE_COMMANDS = { - SEARCH_REQUEST => 0x40, - CONFIG_REQUEST => 0x41, - SEARCH_REPLY => 0x42, - READ_REPLY => 0x43, - SEARCH_ALARMS_REQUEST => 0x44, - SEARCH_ALARMS_REPLY => 0x45, - RESET_REQUEST_BIT => 0x01, - SKIP_REQUEST_BIT => 0x02, - SELECT_REQUEST_BIT => 0x04, - READ_REQUEST_BIT => 0x08, - DELAY_REQUEST_BIT => 0x10, - WRITE_REQUEST_BIT => 0x20, + SEARCH_REQUEST => 0x40, + CONFIG_REQUEST => 0x41, + SEARCH_REPLY => 0x42, + READ_REPLY => 0x43, + SEARCH_ALARMS_REQUEST => 0x44, + SEARCH_ALARMS_REPLY => 0x45, + RESET_REQUEST_BIT => 0x01, + SKIP_REQUEST_BIT => 0x02, + SELECT_REQUEST_BIT => 0x04, + READ_REQUEST_BIT => 0x08, + DELAY_REQUEST_BIT => 0x10, + WRITE_REQUEST_BIT => 0x20, }; our $SCHEDULER_COMMANDS = { - CREATE_FIRMATA_TASK => 0, - DELETE_FIRMATA_TASK => 1, - ADD_TO_FIRMATA_TASK => 2, - DELAY_FIRMATA_TASK => 3, - SCHEDULE_FIRMATA_TASK => 4, - QUERY_ALL_FIRMATA_TASKS => 5, - QUERY_FIRMATA_TASK => 6, - RESET_FIRMATA_TASKS => 7, - ERROR_TASK_REPLY => 8, - QUERY_ALL_TASKS_REPLY => 9, - QUERY_TASK_REPLY => 10, + CREATE_FIRMATA_TASK => 0, + DELETE_FIRMATA_TASK => 1, + ADD_TO_FIRMATA_TASK => 2, + DELAY_FIRMATA_TASK => 3, + SCHEDULE_FIRMATA_TASK => 4, + QUERY_ALL_FIRMATA_TASKS => 5, + QUERY_FIRMATA_TASK => 6, + RESET_FIRMATA_TASKS => 7, + ERROR_TASK_REPLY => 8, + QUERY_ALL_TASKS_REPLY => 9, + QUERY_TASK_REPLY => 10, }; our $MODENAMES = { - 0 => 'INPUT', - 1 => 'OUTPUT', - 2 => 'ANALOG', - 3 => 'PWM', - 4 => 'SERVO', - 5 => 'SHIFT', - 6 => 'I2C', - 7 => 'ONEWIRE', + 0 => 'INPUT', + 1 => 'OUTPUT', + 2 => 'ANALOG', + 3 => 'PWM', + 4 => 'SERVO', + 5 => 'SHIFT', + 6 => 'I2C', + 7 => 'ONEWIRE', }; =head1 DESCRIPTION Because we're dealing with a permutation of the -MIDI protocol, certain commands are one bytes, +MIDI protocol, certain commands are one byte, others 2 or even 3. We do this part to figure out how many bytes we're actually looking at -One of the first things to know is that that while +One of the first things to know is that while MIDI is packet based, the bytes have specialized construction (where the top-most bit has been reserved to differentiate if it's a command or a data bit) -So on any byte being transferred in a MIDI stream, it +So any byte being transferred in a MIDI stream will look like the following BIT# | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | @@ -107,9 +107,9 @@ If X is a "1" this byte is considered a command byte If X is a "0" this byte is considered a data bte We figure out how many bytes a packet is by looking at the -command byte and of that byte, only the high nybble. -This nybble tells us the requisite information via a lookup -table... +command byte and of that byte, only the high nibble. +This nibble tells us the requisite information via a lookup +table... See: http://www.midi.org/techspecs/midimessages.php And @@ -119,7 +119,7 @@ For more information Basically, however: command -nibble bytes +nibble bytes 8 2 9 2 A 2 @@ -133,198 +133,182 @@ F 0 or variable =head2 message_data_receive -Receive a string of data. Normally, only one byte -is passed due to the code but you can also pass as -many bytes in a string as you'd like +Receive a string of data. Normally, only one byte +is passed due to the code, but you can also pass as +many bytes in a string as you'd like. =cut sub message_data_receive { - # -------------------------------------------------- - my ( $self, $data ) = @_; + # -------------------------------------------------- + my ( $self, $data ) = @_; - defined $data and length $data or return; + defined $data and length $data or return; - my $protocol_version = $self->{protocol_version}; - my $protocol_commands = $COMMANDS->{$protocol_version}; - my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version}; + my $protocol_version = $self->{protocol_version}; + my $protocol_commands = $COMMANDS->{$protocol_version}; + my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version}; - # Add the new data to the buffer - my $buffer = $self->{buffer} ||= []; - push @$buffer, unpack "C*", $data; + # Add the new data to the buffer + my $buffer = $self->{buffer} ||= []; + push @$buffer, unpack "C*", $data; - my @packets; + my @packets; - # Loop until we're finished parsing all available packets - while (@$buffer) { - - # Not in SYSEX mode, we can proceed normally - if ( $self->{parse_status} == MIDI_PARSE_NORMAL - and $buffer->[0] == MIDI_START_SYSEX ) - { - my $command = shift @$buffer; - push @packets, - { - command => $command, - command_str => $protocol_lookup->{$command} || 'START_SYSEX', - }; - $self->{parse_status} = MIDI_PARSE_SYSEX; - next; - } - - # If in sysex mode, we will check for the end of the sysex message here - elsif ( $self->{parse_status} == MIDI_PARSE_SYSEX - and $buffer->[0] == MIDI_END_SYSEX ) - { - $self->{parse_status} = MIDI_PARSE_NORMAL; - my $command = shift @$buffer; - push @packets, - { - command => $command, - command_str => $protocol_lookup->{$command} || 'END_SYSEX', - }; - } + # Loop until we're finished parsing all available packets + while (@$buffer) { + # Not in SYSEX mode, we can proceed normally + if ( $self->{parse_status} == MIDI_PARSE_NORMAL and $buffer->[0] == MIDI_START_SYSEX ) { + my $command = shift @$buffer; + push @packets, { + command => $command, + command_str => $protocol_lookup->{$command} || 'START_SYSEX', + }; + $self->{parse_status} = MIDI_PARSE_SYSEX; + next; + } + # If in sysex mode, we will check for the end of the sysex message here + elsif ( $self->{parse_status} == MIDI_PARSE_SYSEX and $buffer->[0] == MIDI_END_SYSEX ) { + $self->{parse_status} = MIDI_PARSE_NORMAL; + my $command = shift @$buffer; + push @packets, { + command => $command, + command_str => $protocol_lookup->{$command} || 'END_SYSEX', + }; + } # Regardless of the SYSEX mode we are in, we will allow commands to interrupt the flowthrough - elsif ( $buffer->[0] & MIDI_COMMAND ) { - my $command = $buffer->[0] & 0xf0; - my $bytes = - ( $MIDI_DATA_SIZES->{$command} - || $MIDI_DATA_SIZES->{ $buffer->[0] } ) + 1; - if ( @$buffer < $bytes ) { - last; - } - my @data = splice @$buffer, 0, $bytes; - $command = shift @data; - push @packets, - { - command => $command, - command_str => $protocol_lookup->{$command} - || $protocol_lookup->{ $command & 0xf0 } - || 'UNKNOWN', - data => \@data - }; - } + elsif ( $buffer->[0] & MIDI_COMMAND ) { + my $command = $buffer->[0] & 0xf0; + my $bytes = ( $MIDI_DATA_SIZES->{$command} || $MIDI_DATA_SIZES->{ $buffer->[0] } ) + 1; + last if ( @$buffer < $bytes ); + my @data = splice @$buffer, 0, $bytes; + $command = shift @data; + push @packets, + { + command => $command, + command_str => $protocol_lookup->{$command} + || $protocol_lookup->{ $command & 0xf0 } + || 'UNKNOWN', + data => \@data + }; + } # We have a data byte, if we're in SYSEX mode, we'll just add that to the data stream # packet - elsif ( $self->{parse_status} == MIDI_PARSE_SYSEX ) { + elsif ( $self->{parse_status} == MIDI_PARSE_SYSEX ) { + my $data = shift @$buffer; + if ( @packets and $packets[-1]{command_str} eq 'DATA_SYSEX' ) { + push @{ $packets[-1]{data} }, $data; + } + else { + push @packets, + { + command => 0x0, + command_str => 'DATA_SYSEX', + data => [$data] + }; + } - my $data = shift @$buffer; - if ( @packets and $packets[-1]{command_str} eq 'DATA_SYSEX' ) { - push @{ $packets[-1]{data} }, $data; - } - else { - push @packets, - { - command => 0x0, - command_str => 'DATA_SYSEX', - data => [$data] - }; - } + } - } + # No idea what to do with this one, eject it and skip to the next + else { + shift @$buffer; + last if ( not @$buffer ); + } + } - # No idea what to do with this one, eject it and skip to the next - else { - shift @$buffer; - if ( not @$buffer ) { - last; - } - } - - } - - return if not @packets; - return \@packets; + return if not @packets; + return \@packets; } =head2 sysex_parse -Takes the sysex data buffer and parses it into +Takes the sysex data buffer and parses it into something useful =cut sub sysex_parse { - # -------------------------------------------------- - my ( $self, $sysex_data ) = @_; + # -------------------------------------------------- + my ( $self, $sysex_data ) = @_; - my $protocol_version = $self->{protocol_version}; - my $protocol_commands = $COMMANDS->{$protocol_version}; - my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version}; + my $protocol_version = $self->{protocol_version}; + my $protocol_commands = $COMMANDS->{$protocol_version}; + my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version}; - my $command = shift @$sysex_data; - if ( defined $command ) { - my $command_str = $protocol_lookup->{$command}; - - if ($command_str) { - my $return_data; + my $command = shift @$sysex_data; + if ( defined $command ) { + my $command_str = $protocol_lookup->{$command}; - COMMAND_HANDLER: { - - $command == $protocol_commands->{STRING_DATA} and do { - $return_data = $self->handle_string_data($sysex_data); - last; - }; - - $command == $protocol_commands->{REPORT_FIRMWARE} and do { - $return_data = $self->handle_report_firmware($sysex_data); - last; - }; + if ($command_str) { + my $return_data; - $command == $protocol_commands->{CAPABILITY_RESPONSE} and do { - $return_data = $self->handle_capability_response($sysex_data); - last; - }; + COMMAND_HANDLER: { - $command == $protocol_commands->{ANALOG_MAPPING_RESPONSE} and do { - $return_data = - $self->handle_analog_mapping_response($sysex_data); - last; - }; + $command == $protocol_commands->{STRING_DATA} and do { + $return_data = $self->handle_string_data($sysex_data); + last; + }; - $command == $protocol_commands->{PIN_STATE_RESPONSE} and do { - $return_data = $self->handle_pin_state_response($sysex_data); - last; - }; - - $command == $protocol_commands->{I2C_REPLY} and do { - $return_data = $self->handle_i2c_reply($sysex_data); - last; - }; + $command == $protocol_commands->{REPORT_FIRMWARE} and do { + $return_data = $self->handle_report_firmware($sysex_data); + last; + }; - $command == $protocol_commands->{ONEWIRE_DATA} and do { - $return_data = $self->handle_onewire_reply($sysex_data); - last; - }; + $command == $protocol_commands->{CAPABILITY_RESPONSE} and do { + $return_data = $self->handle_capability_response($sysex_data); + last; + }; - $command == $protocol_commands->{SCHEDULER_DATA} and do { - $return_data = $self->handle_scheduler_response($sysex_data); - last; - }; - - $command == $protocol_commands->{RESERVED_COMMAND} and do { - $return_data = $sysex_data; - last; - }; - } + $command == $protocol_commands->{ANALOG_MAPPING_RESPONSE} and do { + $return_data = + $self->handle_analog_mapping_response($sysex_data); + last; + }; - return { - command => $command, - command_str => $command_str, - data => $return_data - }; - } else { - return { - command => $command, - data => $sysex_data - } - } - } - return undef; + $command == $protocol_commands->{PIN_STATE_RESPONSE} and do { + $return_data = $self->handle_pin_state_response($sysex_data); + last; + }; + + $command == $protocol_commands->{I2C_REPLY} and do { + $return_data = $self->handle_i2c_reply($sysex_data); + last; + }; + + $command == $protocol_commands->{ONEWIRE_DATA} and do { + $return_data = $self->handle_onewire_reply($sysex_data); + last; + }; + + $command == $protocol_commands->{SCHEDULER_DATA} and do { + $return_data = $self->handle_scheduler_response($sysex_data); + last; + }; + + $command == $protocol_commands->{RESERVED_COMMAND} and do { + $return_data = $sysex_data; + last; + }; + } + + return { + command => $command, + command_str => $command_str, + data => $return_data + }; + } else { + return { + command => $command, + data => $sysex_data + } + } + } + return undef; } =head2 message_prepare @@ -336,17 +320,17 @@ that can be transmitted to the serial output sub message_prepare { - # -------------------------------------------------- - my ( $self, $command_name, $channel, @data ) = @_; + # -------------------------------------------------- + my ( $self, $command_name, $channel, @data ) = @_; - my $protocol_version = $self->{protocol_version}; - my $protocol_commands = $COMMANDS->{$protocol_version}; - my $command = $protocol_commands->{$command_name} or return; + my $protocol_version = $self->{protocol_version}; + my $protocol_commands = $COMMANDS->{$protocol_version}; + my $command = $protocol_commands->{$command_name} or return; - my $bytes = 1 + - ( $MIDI_DATA_SIZES->{ $command & 0xf0 } || $MIDI_DATA_SIZES->{$command} ); - my $packet = pack "C" x $bytes, $command | $channel, @data; - return $packet; + my $bytes = 1 + + ( $MIDI_DATA_SIZES->{ $command & 0xf0 } || $MIDI_DATA_SIZES->{$command} ); + my $packet = pack "C" x $bytes, $command | $channel, @data; + return $packet; } =head2 packet_sysex_command @@ -357,19 +341,19 @@ create a binary packet containing a sysex-command sub packet_sysex_command { - my ( $self, $command_name, @data ) = @_; + my ( $self, $command_name, @data ) = @_; - my $protocol_version = $self->{protocol_version}; - my $protocol_commands = $COMMANDS->{$protocol_version}; - my $command = $protocol_commands->{$command_name} or return; + my $protocol_version = $self->{protocol_version}; + my $protocol_commands = $COMMANDS->{$protocol_version}; + my $command = $protocol_commands->{$command_name} or return; # my $bytes = 3+($MIDI_DATA_SIZES->{$command & 0xf0}||$MIDI_DATA_SIZES->{$command}); - my $bytes = @data + 3; - my $packet = pack "C" x $bytes, $protocol_commands->{START_SYSEX}, - $command, - @data, - $protocol_commands->{END_SYSEX}; - return $packet; + my $bytes = @data + 3; + my $packet = pack "C" x $bytes, $protocol_commands->{START_SYSEX}, + $command, + @data, + $protocol_commands->{END_SYSEX}; + return $packet; } =head2 packet_query_version @@ -379,9 +363,8 @@ Craft a firmware version query packet to be sent =cut sub packet_query_version { - - my $self = shift; - return $self->message_prepare( REPORT_VERSION => 0 ); + my $self = shift; + return $self->message_prepare( REPORT_VERSION => 0 ); } @@ -390,10 +373,8 @@ sub handle_query_version_response { } sub handle_string_data { - my ( $self, $sysex_data ) = @_; - return { - string => double_7bit_to_string($sysex_data) - }; + my ( $self, $sysex_data ) = @_; + return { string => double_7bit_to_string($sysex_data) }; } =head2 packet_query_firmware @@ -403,28 +384,22 @@ Craft a firmware variant query packet to be sent =cut sub packet_query_firmware { - - my $self = shift; - - return $self->packet_sysex_command(REPORT_FIRMWARE); + my $self = shift; + return $self->packet_sysex_command(REPORT_FIRMWARE); } sub handle_report_firmware { - - my ( $self, $sysex_data ) = @_; - - return { - major_version => shift @$sysex_data, - minor_version => shift @$sysex_data, - firmware => double_7bit_to_string($sysex_data) - }; + my ( $self, $sysex_data ) = @_; + return { + major_version => shift @$sysex_data, + minor_version => shift @$sysex_data, + firmware => double_7bit_to_string($sysex_data) + }; } sub packet_query_capability { - - my $self = shift; - - return $self->packet_sysex_command(CAPABILITY_QUERY); + my $self = shift; + return $self->packet_sysex_command(CAPABILITY_QUERY); } #/* capabilities response @@ -442,37 +417,29 @@ sub packet_query_capability { # */ sub handle_capability_response { - - my ( $self, $sysex_data ) = @_; - - my %capabilities; - - my $byte = shift @$sysex_data; - my $i=0; - while ( defined $byte ) { - - my %pinmodes; - while ( defined $byte && $byte != 127 ) { - $pinmodes{$byte} = { - mode_str => $MODENAMES->{$byte}, - resolution => shift @$sysex_data # /secondbyte - }; - $byte = shift @$sysex_data; - } - $capabilities{$i}=\%pinmodes; - $i++; - $byte = shift @$sysex_data; - } - - return { capabilities => \%capabilities }; - + my ( $self, $sysex_data ) = @_; + my %capabilities; + my $byte = shift @$sysex_data; + my $i=0; + while ( defined $byte ) { + my %pinmodes; + while ( defined $byte && $byte != 127 ) { + $pinmodes{$byte} = { + mode_str => $MODENAMES->{$byte}, + resolution => shift @$sysex_data # /secondbyte + }; + $byte = shift @$sysex_data; + } + $capabilities{$i}=\%pinmodes; + $i++; + $byte = shift @$sysex_data; + } + return { capabilities => \%capabilities }; } sub packet_query_analog_mapping { - - my $self = shift; - - return $self->packet_sysex_command(ANALOG_MAPPING_QUERY); + my $self = shift; + return $self->packet_sysex_command(ANALOG_MAPPING_QUERY); } #/* analog mapping response @@ -487,22 +454,17 @@ sub packet_query_analog_mapping { # */ sub handle_analog_mapping_response { + my ( $self, $sysex_data ) = @_; + my %pins; + my $pin_mapping = shift @$sysex_data; + my $i=0; - my ( $self, $sysex_data ) = @_; - - my %pins; - my $pin_mapping = shift @$sysex_data; - my $i=0; - - while ( defined $pin_mapping ) { - if ($pin_mapping!=127) { - $pins{$pin_mapping}=$i; - } - $pin_mapping = shift @$sysex_data; - $i++; - } - - return { mappings => \%pins }; + while ( defined $pin_mapping ) { + $pins{$pin_mapping}=$i if ($pin_mapping!=127); + $pin_mapping = shift @$sysex_data; + $i++; + } + return { mappings => \%pins }; } #/* pin state query @@ -514,10 +476,8 @@ sub handle_analog_mapping_response { # */ sub packet_query_pin_state { - - my ( $self, $pin ) = @_; - - return $self->packet_sysex_command( PIN_STATE_QUERY, $pin ); + my ( $self, $pin ) = @_; + return $self->packet_sysex_command( PIN_STATE_QUERY, $pin ); } #/* pin state response @@ -534,35 +494,30 @@ sub packet_query_pin_state { # */ sub handle_pin_state_response { + my ( $self, $sysex_data ) = @_; + my $pin = shift @$sysex_data; + my $mode = shift @$sysex_data; + my $state = shift @$sysex_data & 0x7f; + my $nibble = shift @$sysex_data; + for ( my $i = 1 ; defined $nibble ; $nibble = shift @$sysex_data ) { + $state += ( $nibble & 0x7f ) << ( 7 * $i ); + } - my ( $self, $sysex_data ) = @_; - - my $pin = shift @$sysex_data; - my $mode = shift @$sysex_data; - my $state = shift @$sysex_data & 0x7f; - - my $nibble = shift @$sysex_data; - for ( my $i = 1 ; defined $nibble ; $nibble = shift @$sysex_data ) { - $state += ( $nibble & 0x7f ) << ( 7 * $i ); - } - - return { - pin => $pin, - mode => $mode, - moden_str => $MODENAMES->{$mode}, - state => $state - }; + return { + pin => $pin, + mode => $mode, + moden_str => $MODENAMES->{$mode}, + state => $state + }; } sub packet_sampling_interval { - - my ( $self, $interval ) = @_; - - return $self->packet_sysex_command( SAMPLING_INTERVAL, - $interval & 0x7f, - $interval >> 7 - ); + my ( $self, $interval ) = @_; + return $self->packet_sysex_command( SAMPLING_INTERVAL, + $interval & 0x7f, + $interval >> 7 + ); } #/* I2C read/write request @@ -583,27 +538,25 @@ sub packet_sampling_interval { # */ sub packet_i2c_request { + my ( $self, $address, $command, @i2cdata ) = @_; + if (($address & 0x380) > 0) { + $command |= (0x20 | (($address >> 7) & 0x7)); + } - my ( $self, $address, $command, @i2cdata ) = @_; - - if (($address & 0x380) > 0) { - $command |= (0x20 | (($address >> 7) & 0x7)); - } - - if (scalar @i2cdata) { - my @data; - push_array_as_two_7bit(\@i2cdata,\@data); - return $self->packet_sysex_command( I2C_REQUEST, - $address & 0x7f, - $command, - @data, - ); - } else { - return $self->packet_sysex_command( I2C_REQUEST, - $address & 0x7f, - $command, - ); - } + if (scalar @i2cdata) { + my @data; + push_array_as_two_7bit(\@i2cdata,\@data); + return $self->packet_sysex_command( I2C_REQUEST, + $address & 0x7f, + $command, + @data, + ); + } else { + return $self->packet_sysex_command( I2C_REQUEST, + $address & 0x7f, + $command, + ); + } } #/* I2C reply @@ -621,17 +574,15 @@ sub packet_i2c_request { # */ sub handle_i2c_reply { - - my ( $self, $sysex_data ) = @_; - - my $address = shift14bit($sysex_data); - my $register = shift14bit($sysex_data); - my @data = double_7bit_to_array($sysex_data); - return { - address => $address, - register => $register, - data => \@data, - }; + my ( $self, $sysex_data ) = @_; + my $address = shift14bit($sysex_data); + my $register = shift14bit($sysex_data); + my @data = double_7bit_to_array($sysex_data); + return { + address => $address, + register => $register, + data => \@data, + }; } #/* I2C config @@ -645,13 +596,11 @@ sub handle_i2c_reply { # */ sub packet_i2c_config { - - my ( $self, $delay, @data ) = @_; - - return $self->packet_sysex_command( I2C_CONFIG, - $delay & 0x7f, - $delay >> 7, @data - ); + my ( $self, $delay, @data ) = @_; + return $self->packet_sysex_command( I2C_CONFIG, + $delay & 0x7f, + $delay >> 7, @data + ); } #/* servo config @@ -667,19 +616,17 @@ sub packet_i2c_config { # */ sub packet_servo_config_request { + my ( $self, $pin, $data ) = @_; + my $min_pulse = $data->{min_pulse}; + my $max_pulse = $data->{max_pulse}; - my ( $self, $pin, $data ) = @_; - - my $min_pulse = $data->{min_pulse}; - my $max_pulse = $data->{max_pulse}; - - return $self->packet_sysex_command( SERVO_CONFIG, - $pin & 0x7f, - $min_pulse & 0x7f, - $min_pulse >> 7, - $max_pulse & 0x7f, - $max_pulse >> 7 - ); + return $self->packet_sysex_command( SERVO_CONFIG, + $pin & 0x7f, + $min_pulse & 0x7f, + $min_pulse >> 7, + $max_pulse & 0x7f, + $max_pulse >> 7 + ); } #This is just the standard SET_PIN_MODE message: @@ -701,343 +648,318 @@ sub packet_servo_config_request { # */ sub packet_onewire_search_request { - my ( $self, $pin ) = @_; - return $self->packet_sysex_command( ONEWIRE_DATA,$ONE_WIRE_COMMANDS->{SEARCH_REQUEST},$pin); + my ( $self, $pin ) = @_; + return $self->packet_sysex_command( ONEWIRE_DATA,$ONE_WIRE_COMMANDS->{SEARCH_REQUEST},$pin); }; sub packet_onewire_search_alarms_request { - my ( $self, $pin ) = @_; - return $self->packet_sysex_command( ONEWIRE_DATA,$ONE_WIRE_COMMANDS->{SEARCH_ALARMS_REQUEST},$pin); + my ( $self, $pin ) = @_; + return $self->packet_sysex_command( ONEWIRE_DATA,$ONE_WIRE_COMMANDS->{SEARCH_ALARMS_REQUEST},$pin); }; sub packet_onewire_config_request { - my ( $self, $pin, $power ) = @_; - return $self->packet_sysex_command( ONEWIRE_DATA, $ONE_WIRE_COMMANDS->{CONFIG_REQUEST},$pin, - ( defined $power ) ? $power : 1 - ); + my ( $self, $pin, $power ) = @_; + return $self->packet_sysex_command( ONEWIRE_DATA, $ONE_WIRE_COMMANDS->{CONFIG_REQUEST},$pin, + ( defined $power ) ? $power : 1 + ); }; #$args = { -# reset => undef | 1, -# skip => undef | 1, -# select => undef | device, -# read => undef | short int, -# delay => undef | long int, -# write => undef | bytes[], +# reset => undef | 1, +# skip => undef | 1, +# select => undef | device, +# read => undef | short int, +# delay => undef | long int, +# write => undef | bytes[], #} sub packet_onewire_request { - my ( $self, $pin, $args ) = @_; - my $subcommand = 0; - my @data; - if (defined $args->{reset}) { - $subcommand |= $ONE_WIRE_COMMANDS->{RESET_REQUEST_BIT}; - } - if (defined $args->{skip}) { - $subcommand |= $ONE_WIRE_COMMANDS->{SKIP_REQUEST_BIT}; - } - if (defined $args->{select}) { - $subcommand |= $ONE_WIRE_COMMANDS->{SELECT_REQUEST_BIT}; - push_onewire_device_to_byte_array($args->{select},\@data); - } - if (defined $args->{read}) { - $subcommand |= $ONE_WIRE_COMMANDS->{READ_REQUEST_BIT}; - push @data,$args->{read} & 0xFF; - push @data,($args->{read}>>8) & 0xFF; - if ($self->{protocol_version} ne 'V_2_04') { - my $id = (defined $args->{id}) ? $args->{id} : 0; - push @data,$id &0xFF; - push @data,($id>>8) & 0xFF; - } - } - if (defined $args->{delay}) { - $subcommand |= $ONE_WIRE_COMMANDS->{DELAY_REQUEST_BIT}; - push @data,$args->{delay} & 0xFF; - push @data,($args->{delay}>>8) & 0xFF; - push @data,($args->{delay}>>16) & 0xFF; - push @data,($args->{delay}>>24) & 0xFF; - } - if (defined $args->{write}) { - $subcommand |= $ONE_WIRE_COMMANDS->{WRITE_REQUEST_BIT}; - my $writeBytes=$args->{write}; - push @data,@$writeBytes; - } - return $self->packet_sysex_command( ONEWIRE_DATA, $subcommand, $pin, pack_as_7bit(@data)); + my ( $self, $pin, $args ) = @_; + my $subcommand = 0; + my @data; + if (defined $args->{reset}) { + $subcommand |= $ONE_WIRE_COMMANDS->{RESET_REQUEST_BIT}; + } + if (defined $args->{skip}) { + $subcommand |= $ONE_WIRE_COMMANDS->{SKIP_REQUEST_BIT}; + } + if (defined $args->{select}) { + $subcommand |= $ONE_WIRE_COMMANDS->{SELECT_REQUEST_BIT}; + push_onewire_device_to_byte_array($args->{select},\@data); + } + if (defined $args->{read}) { + $subcommand |= $ONE_WIRE_COMMANDS->{READ_REQUEST_BIT}; + push @data,$args->{read} & 0xFF; + push @data,($args->{read}>>8) & 0xFF; + if ($self->{protocol_version} ne 'V_2_04') { + my $id = (defined $args->{id}) ? $args->{id} : 0; + push @data,$id &0xFF; + push @data,($id>>8) & 0xFF; + } + } + if (defined $args->{delay}) { + $subcommand |= $ONE_WIRE_COMMANDS->{DELAY_REQUEST_BIT}; + push @data,$args->{delay} & 0xFF; + push @data,($args->{delay}>>8) & 0xFF; + push @data,($args->{delay}>>16) & 0xFF; + push @data,($args->{delay}>>24) & 0xFF; + } + if (defined $args->{write}) { + $subcommand |= $ONE_WIRE_COMMANDS->{WRITE_REQUEST_BIT}; + my $writeBytes=$args->{write}; + push @data,@$writeBytes; + } + return $self->packet_sysex_command( ONEWIRE_DATA, $subcommand, $pin, pack_as_7bit(@data)); }; - + sub handle_onewire_reply { + my ( $self, $sysex_data ) = @_; + my $command = shift @$sysex_data; + my $pin = shift @$sysex_data; - my ( $self, $sysex_data ) = @_; + if ( defined $command ) { + COMMAND_HANDLER: { + $command == $ONE_WIRE_COMMANDS->{READ_REPLY} and do { #PIN,COMMAND,ADDRESS,DATA + my @data = unpack_from_7bit(@$sysex_data); + if ($self->{protocol_version} eq 'V_2_04') { + my $device = shift_onewire_device_from_byte_array(\@data); + return { + pin => $pin, + command => 'READ_REPLY', + device => $device, + data => \@data + }; + } else { + my $id = shift @data; + $id += (shift @data)<<8; + return { + pin => $pin, + command => 'READ_REPLY', + id => $id, + data => \@data + }; + }; + }; - my $command = shift @$sysex_data; - my $pin = shift @$sysex_data; - - if ( defined $command ) { - COMMAND_HANDLER: { - - $command == $ONE_WIRE_COMMANDS->{READ_REPLY} - and do { #PIN,COMMAND,ADDRESS,DATA - - my @data = unpack_from_7bit(@$sysex_data); - if ($self->{protocol_version} eq 'V_2_04') { - my $device = shift_onewire_device_from_byte_array(\@data); - - return { - pin => $pin, - command => 'READ_REPLY', - device => $device, - data => \@data - }; - } else { - my $id = shift @data; - $id += (shift @data)<<8; - return { - pin => $pin, - command => 'READ_REPLY', - id => $id, - data => \@data - }; - }; - }; - - ($command == $ONE_WIRE_COMMANDS->{SEARCH_REPLY} or $command == $ONE_WIRE_COMMANDS->{SEARCH_ALARMS_REPLY}) - and do { #PIN,COMMAND,ADDRESS... - - my @devices; - my @data = unpack_from_7bit(@$sysex_data); - my $device = shift_onewire_device_from_byte_array(\@data); - while ( defined $device ) { - push @devices, $device; - $device = shift_onewire_device_from_byte_array(\@data); - } - return { - pin => $pin, - command => $command == $ONE_WIRE_COMMANDS->{SEARCH_REPLY} ? 'SEARCH_REPLY' : 'SEARCH_ALARMS_REPLY', - devices => \@devices, - }; - }; - } - } + ($command == $ONE_WIRE_COMMANDS->{SEARCH_REPLY} or $command == $ONE_WIRE_COMMANDS->{SEARCH_ALARMS_REPLY}) and do { #PIN,COMMAND,ADDRESS... + my @devices; + my @data = unpack_from_7bit(@$sysex_data); + my $device = shift_onewire_device_from_byte_array(\@data); + while ( defined $device ) { + push @devices, $device; + $device = shift_onewire_device_from_byte_array(\@data); + } + return { + pin => $pin, + command => $command == $ONE_WIRE_COMMANDS->{SEARCH_REPLY} ? 'SEARCH_REPLY' : 'SEARCH_ALARMS_REPLY', + devices => \@devices, + }; + }; + } + } } sub packet_create_task { - my ($self,$id,$len) = @_; - my $packet = $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{CREATE_FIRMATA_TASK}, $id, $len & 0x7F, $len>>7); - return $packet; + my ($self,$id,$len) = @_; + my $packet = $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{CREATE_FIRMATA_TASK}, $id, $len & 0x7F, $len>>7); + return $packet; } sub packet_delete_task { - my ($self,$id) = @_; - return $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{DELETE_FIRMATA_TASK}, $id); + my ($self,$id) = @_; + return $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{DELETE_FIRMATA_TASK}, $id); } sub packet_add_to_task { - my ($self,$id,@data) = @_; - my $packet = $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{ADD_TO_FIRMATA_TASK}, $id, pack_as_7bit(@data)); - return $packet; + my ($self,$id,@data) = @_; + my $packet = $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{ADD_TO_FIRMATA_TASK}, $id, pack_as_7bit(@data)); + return $packet; } sub packet_delay_task { - my ($self,$time_ms) = @_; - my $packet = $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{DELAY_FIRMATA_TASK}, pack_as_7bit($time_ms & 0xFF, ($time_ms & 0xFF00)>>8, ($time_ms & 0xFF0000)>>16,($time_ms & 0xFF000000)>>24)); - return $packet; + my ($self,$time_ms) = @_; + my $packet = $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{DELAY_FIRMATA_TASK}, pack_as_7bit($time_ms & 0xFF, ($time_ms & 0xFF00)>>8, ($time_ms & 0xFF0000)>>16,($time_ms & 0xFF000000)>>24)); + return $packet; } sub packet_schedule_task { - my ($self,$id,$time_ms) = @_; - my $packet = $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{SCHEDULE_FIRMATA_TASK}, $id, pack_as_7bit($time_ms & 0xFF, ($time_ms & 0xFF00)>>8, ($time_ms & 0xFF0000)>>16,($time_ms & 0xFF000000)>>24)); - return $packet; + my ($self,$id,$time_ms) = @_; + my $packet = $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{SCHEDULE_FIRMATA_TASK}, $id, pack_as_7bit($time_ms & 0xFF, ($time_ms & 0xFF00)>>8, ($time_ms & 0xFF0000)>>16,($time_ms & 0xFF000000)>>24)); + return $packet; } sub packet_query_all_tasks { - my $self = shift; - return $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{QUERY_ALL_FIRMATA_TASKS}); + my $self = shift; + return $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{QUERY_ALL_FIRMATA_TASKS}); } sub packet_query_task { - my ($self,$id) = @_; - return $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{QUERY_FIRMATA_TASK},$id); + my ($self,$id) = @_; + return $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{QUERY_FIRMATA_TASK},$id); } sub packet_reset_scheduler { - my $self = shift; - return $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{RESET_FIRMATA_TASKS}); + my $self = shift; + return $self->packet_sysex_command('SCHEDULER_DATA', $SCHEDULER_COMMANDS->{RESET_FIRMATA_TASKS}); } sub handle_scheduler_response { - my ( $self, $sysex_data ) = @_; - - my $command = shift @$sysex_data; + my ( $self, $sysex_data ) = @_; + my $command = shift @$sysex_data; - if ( defined $command ) { - COMMAND_HANDLER: { + if ( defined $command ) { + COMMAND_HANDLER: { + $command == $SCHEDULER_COMMANDS->{QUERY_ALL_TASKS_REPLY} and do { + return { + command => 'QUERY_ALL_TASKS_REPLY', + ids => $sysex_data, + } + }; - $command == $SCHEDULER_COMMANDS->{QUERY_ALL_TASKS_REPLY} and do { - return { - command => 'QUERY_ALL_TASKS_REPLY', - ids => $sysex_data, - } - }; - - ($command == $SCHEDULER_COMMANDS->{QUERY_TASK_REPLY} or $command == $SCHEDULER_COMMANDS->{ERROR_TASK_REPLY}) and do { - - my $error = ($command == $SCHEDULER_COMMANDS->{ERROR_TASK_REPLY}); - if (scalar @$sysex_data == 1) { - return { - command => ($error ? 'ERROR_TASK_REPLY' : 'QUERY_TASK_REPLY'), - id => shift @$sysex_data, - } - } - if (scalar @$sysex_data >= 11) { - my $id = shift @$sysex_data; - my @data = unpack_from_7bit(@$sysex_data); - return { - command => ($error ? 'ERROR_TASK_REPLY' : 'QUERY_TASK_REPLY'), - id => $id, - time_ms => shift @data | (shift @data)<<8 | (shift @data)<<16 | (shift @data)<<24, - len => shift @data | (shift @data)<<8, - position => shift @data | (shift @data)<<8, - messages => \@data, - } - } - }; - } - } + ($command == $SCHEDULER_COMMANDS->{QUERY_TASK_REPLY} or $command == $SCHEDULER_COMMANDS->{ERROR_TASK_REPLY}) and do { + my $error = ($command == $SCHEDULER_COMMANDS->{ERROR_TASK_REPLY}); + if (scalar @$sysex_data == 1) { + return { + command => ($error ? 'ERROR_TASK_REPLY' : 'QUERY_TASK_REPLY'), + id => shift @$sysex_data, + } + } + if (scalar @$sysex_data >= 11) { + my $id = shift @$sysex_data; + my @data = unpack_from_7bit(@$sysex_data); + return { + command => ($error ? 'ERROR_TASK_REPLY' : 'QUERY_TASK_REPLY'), + id => $id, + time_ms => shift @data | (shift @data)<<8 | (shift @data)<<16 | (shift @data)<<24, + len => shift @data | (shift @data)<<8, + position => shift @data | (shift @data)<<8, + messages => \@data, + } + } + }; + } + } } - + sub shift14bit { - - my $data = shift; - - my $lsb = shift @$data; - my $msb = shift @$data; - return - defined $lsb - ? defined $msb - ? ( $msb << 7 ) + ( $lsb & 0x7f ) - : $lsb - : undef; + my $data = shift; + my $lsb = shift @$data; + my $msb = shift @$data; + return + defined $lsb + ? defined $msb + ? ( $msb << 7 ) + ( $lsb & 0x7f ) + : $lsb + : undef; } sub double_7bit_to_string { - my ( $data, $numbytes ) = @_; - my $ret; - if ( defined $numbytes ) { - for ( my $i = 0 ; $i < $numbytes ; $i++ ) { - my $value = shift14bit($data); - $ret .= chr($value); - } - } - else { - while (@$data) { - my $value = shift14bit($data); - $ret .= chr($value); - } - } - return $ret; + my ( $data, $numbytes ) = @_; + my $ret; + if ( defined $numbytes ) { + for ( my $i = 0 ; $i < $numbytes ; $i++ ) { + my $value = shift14bit($data); + $ret .= chr($value); + } + } + else { + while (@$data) { + my $value = shift14bit($data); + $ret .= chr($value); + } + } + return $ret; } sub double_7bit_to_array { - my ( $data, $numbytes ) = @_; - my @ret; - if ( defined $numbytes ) { - for ( my $i = 0 ; $i < $numbytes ; $i++ ) { - push @ret, shift14bit($data); - } - } - else { - while (@$data) { - my $value = shift14bit($data); - push @ret, $value; - } - } - return @ret; + my ( $data, $numbytes ) = @_; + my @ret; + if ( defined $numbytes ) { + for ( my $i = 0 ; $i < $numbytes ; $i++ ) { + push @ret, shift14bit($data); + } + } + else { + while (@$data) { + my $value = shift14bit($data); + push @ret, $value; + } + } + return @ret; } sub shift_onewire_device_from_byte_array { - my $buffer = shift; - - my $family = shift @$buffer; - if ( defined $family ) { - my @address; - for (my $i=0;$i<6;$i++) { - push @address,shift @$buffer; - } - my $crc = shift @$buffer; - return { - family => $family, - identity => \@address, - crc => $crc - }; - } - else { - return undef; - } - + my $buffer = shift; + my $family = shift @$buffer; + if ( defined $family ) { + my @address; + for (my $i=0;$i<6;$i++) { push @address,shift @$buffer; } + my $crc = shift @$buffer; + return { + family => $family, + identity => \@address, + crc => $crc + }; + } + else { + return undef; + } } sub push_value_as_two_7bit { - my ( $value, $buffer ) = @_; - push @$buffer, $value & 0x7f; #LSB - push @$buffer, ( $value >> 7 ) & 0x7f; #MSB + my ( $value, $buffer ) = @_; + push @$buffer, $value & 0x7f; #LSB + push @$buffer, ( $value >> 7 ) & 0x7f; #MSB } sub push_onewire_device_to_byte_array { - my ( $device, $buffer ) = @_; - push @$buffer, $device->{family}; - for ( my $i = 0 ; $i < 6 ; $i++ ) { - push @$buffer, $device->{identity}[$i]; - } - push @$buffer, $device->{crc}; + my ( $device, $buffer ) = @_; + push @$buffer, $device->{family}; + for ( my $i = 0 ; $i < 6 ; $i++ ) { push @$buffer, $device->{identity}[$i]; } + push @$buffer, $device->{crc}; } sub push_array_as_two_7bit { - my ( $data, $buffer ) = @_; - my $byte = shift @$data; - while ( defined $byte ) { - push_value_as_two_7bit( $byte, $buffer ); - $byte = shift @$data; - } + my ( $data, $buffer ) = @_; + my $byte = shift @$data; + while ( defined $byte ) { + push_value_as_two_7bit( $byte, $buffer ); + $byte = shift @$data; + } } sub pack_as_7bit { - my @data = @_; - my @outdata; - my $numBytes = @data; - my $messageSize = ( $numBytes << 3 ) / 7; - for ( my $i = 0 ; $i < $messageSize ; $i++ ) { - my $j = $i * 7; - my $pos = $j >> 3; - my $shift = $j & 7; - my $out = $data[$pos] >> $shift & 0x7F; - - if ($out >> 7 > 0) { - printf "%b, %b, %d\n",$data[$pos],$out,$shift; - } - - if ( $shift > 1 && $pos < $numBytes-1 ) { - $out |= ( $data[ $pos + 1 ] << ( 8 - $shift ) ) & 0x7F; - } - push( @outdata, $out ); - } - return @outdata; + my @data = @_; + my @outdata; + my $numBytes = @data; + my $messageSize = ( $numBytes << 3 ) / 7; + for ( my $i = 0 ; $i < $messageSize ; $i++ ) { + my $j = $i * 7; + my $pos = $j >> 3; + my $shift = $j & 7; + my $out = $data[$pos] >> $shift & 0x7F; + printf "%b, %b, %d\n",$data[$pos],$out,$shift if ($out >> 7 > 0); + $out |= ( $data[ $pos + 1 ] << ( 8 - $shift ) ) & 0x7F if ( $shift > 1 && $pos < $numBytes-1 ); + push( @outdata, $out ); + } + return @outdata; } sub unpack_from_7bit { - my @data = @_; - my @outdata; - my $numBytes = @data; - my $outBytes = ( $numBytes * 7 ) >> 3; - for ( my $i = 0 ; $i < $outBytes ; $i++ ) { - my $j = $i << 3; - my $pos = $j / 7; - my $shift = $j % 7; - push( @outdata, - ( $data[$pos] >> $shift ) | - ( ( $data[ $pos + 1 ] << ( 7 - $shift ) ) & 0xFF ) ); - } - return @outdata; + my @data = @_; + my @outdata; + my $numBytes = @data; + my $outBytes = ( $numBytes * 7 ) >> 3; + for ( my $i = 0 ; $i < $outBytes ; $i++ ) { + my $j = $i << 3; + my $pos = $j / 7; + my $shift = $j % 7; + push( @outdata, + ( $data[$pos] >> $shift ) | + ( ( $data[ $pos + 1 ] << ( 7 - $shift ) ) & 0xFF ) ); + } + return @outdata; } 1;