# $Source: /usr/pkg/lib/perl5/site_perl/5.8.0/Device/LabJack/Control.pm $ # $Date: 2007-01-12 $ =head1 NAME Device::LabJack::Control =head1 VERSION 0.04 =head1 SYNOPSIS use Device::LabJack::Control; # Instanciate an object. my $lj = Device::LabJack::Control->new(); # Configure device $lj->set_configs( ); print join qq{\n}, $self->get_config('Gain Values'), print join qq{\n}, $lj->update_device(); =head1 DESCRIPTION An OO API for Device::LabJack plus a few OO methods so that it may be employed to collect data via Text::CSV::Munge and graphed via Chart::EPS_graph (which two modules I also wrote). LabJack firmware version used in development: 1.10000002384186 =head1 SUBROUTINES/METHODS =cut package Device::LabJack::Control; use strict; use warnings; use Carp qw(carp croak); use Device::LabJack; our ($VERSION) = '$Revision: 0.04 $' =~ m{ \$Revision: \s+ (\S+) }xm; # Confuses editor syntax highlighting. our $ASCII_POUND = "\043"; our $ASCII_SQUOT = "\047"; our @mask; =pod =head2 Channel mask array Used as mask for each individual channel for keeping track of which are inputs and which outputs, etc. =cut BEGIN { my $chan_nth = 1; for ( 1 .. 16 ) { push @mask, $chan_nth; $chan_nth = $chan_nth << 1; } } =pod =head2 Method names explained. The folks at LabJack and Chris Drake, author of C which is the parent to this module employed C for their code. As a fifty- year-old and sporting bifocals, I just cannot abide to squint at such awful typography anymore. So I have translated the every instance to the far more easily distinguished C system in this daughter module. Yet in so doing I have adhered to easily recognized variants from Chris Drake's module and from the LabJack manual. =head2 Create a new instance object. my $obj = Device::LabJack::Control->new(); This Device::LabJack::Control employs its main object hash (C<%self>) as a repository for most all of the control parameters expected by the LabJack device as inputs. Upon creation of a new object, defaluts are set for each of these. =cut # Create new object. sub new { ref( my $class = shift ) and croak is_class('new()'); my $self = {}; bless $self, $class; $self->set_configs( # Differential vs Single-ended wiring schematic. # Must account for all eight LabJack hardware channels. # Each S is a single hardware channel. # Each D is two consecutive hardware channels, 1st an even, then an odd. # Alternates: 'SSDDD 'DSSDD 'DDSSD 'DDDSS 'DSSDSS etc... 'AI Wiring' => 'DDDD', # Gains for all wired channels, but affecting D only. # Gains for S, although not used, are required for symmetry. # Example values for D are 0 thru 7 for gains of 1 thru 20. # If 'SSSSSSSS' then [0,0,0,0,0,0,0,0] # If 'SSDSSD' then [0,0,1,0,0,5] or [0,0,7,0,0,3] etc... 'AI Gains' => [0,1,2,3], # Gains of 1, 2, 4 and 5 for 'DDDD' wiring. 'AO Volts' => [0, 0], # Must have two, one for each AO channel. 'Demo' => 0, # Set to 1 when no LabJack plugged in. 'Disable Cal' => 0, # Return raw readings if 1. 'Enable STB' => 1, # STB is enabled if 1. 'ID Number' => -1, # For 1st LabJack found, set to 1. 'LED On' => 1, # Alight the LED when 1. 'Scan Count' => 7, # From 1 to 4096 scans. 'Scan Rate' => 246, # 400 <= 'Scan Rate' * channels scanned <= 8192 'Tris D' => 0, # Which way D0 thru D15? Input=0, Output=1. 'Tris IO' => 0, # Which way IO0 thru IO3? Input=0, Output=1. 'State D' => 0, # Integer. Output states for D0 thru D15. 'State IO' => 0, # Integer. Return the four IO's when 1. 'Timeout Secs' => 2, # Return if no scan after this long. 'Trigger IO' => 0, # Ports to trigger on. 'Trigger State' => 0, # Trigger on selected IO if > 0. 'Transfer Mode' => 0, # 0 = Auto; 1 = Normal, 2 = Turbo. 'Reset Counter' => 0, # Whether to reset counter at end. 'Update Digital' => 0, # Whether to write D values. 'Update IO' => 0, # Whether to write IO values. # Stuff for Asynch methods only. # Probably a waste of time as parent module is untested for this. # Presented here as head start for if and when... 'Timeout Mult' => 127, # Milliseconds timout for Asynch 'Config A' => 0, # Set D8 as out high, D9 as input when 1. 'Config B' => 0, # Set D10 to out high, D11 as input when 1. 'Config TE' => 0, # Set D12 to ouptut low when 1. 'Full A/B/C' => [200, 1, 1], # TCs for "full" delay of 9600 Baud. 'Half A/B/C' => [48, 2, 1], # TCs for "half" delay of 9600 Baud. 'Port B' => 0, # Use port B (not A) if 1. 'Enable TE' => 0, # D12 set hi during xmt low during rcv? 'Enable TO' => 0, # Will time out on rcv if 1. 'Enable Delay' => 0, # Will delay each xmt byte if 1. 'Baud Rate' => 9600, # To predict xmt/rcv times. 'R/W Bytes' => 18, # Bytes to read/write at a time. ); return $self; } =head2 Configure the device $obj->set_configs( 'Foo' => 1, 'Bar' => \@foobar ); Call the C method to modify any inputs expected by the LabJack device from their defaults as initialized by the C method. =cut # Change defaults and input info. sub set_configs { ref( my $self = shift ) or croak is_instance('set_configs()'); my %user_defs = @_; my $old_AI_wiring = $self->{'AI Wiring'}; while ( my ($key, $value) = each %user_defs ) { $key = constrain_key( $key ); # Enforce naming rule. $self->{$key} = $value; } # Simply channel configuration from (0,1,9,4,5,6,7) to 'SSDSSSS if ( defined $old_AI_wiring ne $self->{'AI Wiring'} ) { $self->ai_wiring( $self->{'AI Wiring'} ); } $self->config_limits_check(); return 'Pthhht! to Perl::Critic'; } =pod $self->config_limits_check(); Called internally by C, the C method contstrains user-supplied input to reasonable and expected values. If any prove objectionable, a verbose reply is given to explain the objection. =cut sub config_limits_check { ref( my $self = shift ) or croak is_instance('config_limits_check()'); my @croakings; if (($self->{'Scan Count'} < 1) || ($self->{'Scan Count'} > 4096)) { push @croakings, qq['Scan Count' out of bounds: 1 <= $self->{'Scan Count'} <= 4096.]; } if ($self->{'Transfer Mode'} !~ m/^(0|1|2)$/m) { push @croakings, qq['Transfer Mode' out of bounds: $self->{'Transfer Mode'} = 0, 1 or 2.]; } if ($self->{'Trigger IO'} !~ m/^(0|1|2)$/m) { push @croakings, qq['Trigger IO' out of bounds: $self->{'Trigger IO'} = 0, 1 or 2.]; } for ( @{ $self->{'Full A/B/C'} } ) { if ($_ < 0 || $_ > 255 ) { push @croakings, qq['Full A/B/C' out of bounds: 0 < $self->{'Full A/B/C'}->[$_] = 255.]; } } for ( @{ $self->{'Half A/B/C'} } ) { if ($_ < 0 || $_ > 255 ) { push @croakings, qq['Half A/B/C' out of bounds: 0 < $self->{'Full A/B/C'}->[$_] = 255.]; } } if (($self->{'R/W Bytes'} < 1) || ($self->{'R/W Bytes'} > 18)) { push @croakings, qq['R/W Bytes' out of bounds: 1 <= $self->{'R/W Bytes'} <= 18.]; } # Establish that each wired channel is provided a gain, even the # single-ended channels which don't use gains. Then check that differential # gains are appropriate. my $gains = scalar @{$self->{'AI Gains'}}; my $chans = length $self->{'AI Wiring'}; if ( $gains != $chans ) { push @croakings, qq[Imballanced count of 'AI Gains' vs 'AI Wiring': $gains = $chans.]; } else { my $i = 0; for ( split //, $self->{'AI Wiring'} ) { if ( $_ eq 'D' ) { my $chan_gain = $self->{'AI Gains'}->[$i]; if ( $chan_gain !~ m/[0..7]/m ) { push @croakings, qq[Oops! Gain for channel $i out of bounds: $chan_gain = 1 .. 7.]; } } ++$i; } } # Tell user if something's amiss. if ( @croakings ) { print "Oops! Config errors listed below...\n\t" . (join "\n\t", @croakings) . "\n"; } } =pod $self->ai_wiring('DDSSSS'); Called internally by C, the C method interprets user's choice of channel wiring configuraiton. Translates strings such as 'DDSSSS' so as to divy up the eight I channels by pairs into substs including up to four I channels. This way the user may consider channels in the hardware sense, however they may have wired it. Channels are thereby innumerated 0 thru N, never minding the LabJack's own AI channel innumeration. =cut # Dispatch table of all possible ai_wiring configs. my %ai_wiring; BEGIN { %ai_wiring = ( 'SSSSSSSS' => q{ @channels = (0, 1, 2, 3, 4, 5, 6, 7)}, 'SSSSSSD' => q{ @channels = (0, 1, 2, 3, 4, 5, 11)}, 'SSSSDSS' => q{ @channels = (0, 1, 2, 3, 10, 6, 7)}, 'SSSSDD' => q{ @channels = (0, 1, 2, 3, 10, 11)}, 'SSDSSSS' => q{ @channels = (0, 1, 9, 4, 5, 6, 7)}, 'SSDSSD' => q{ @channels = (0, 1, 9, 4, 5, 11)}, 'SSDDSS' => q{ @channels = (0, 1, 9, 10, 6, 7)}, 'SSDDD' => q{ @channels = (0, 1, 9, 10, 11)}, 'DSSSSSS' => q{ @channels = (8, 2, 3, 4, 5, 6, 7)}, 'DSSSSD' => q{ @channels = (8, 2, 3, 4, 5, 11)}, 'DSSDSS' => q{ @channels = (8, 2, 3, 10, 6, 7)}, 'DSSDD' => q{ @channels = (8, 2, 3, 10, 11)}, 'DDSSSS' => q{ @channels = (8, 9, 4, 5, 6, 7)}, 'DDSSD' => q{ @channels = (8, 9, 4, 5, 11)}, 'DDDSS' => q{ @channels = (8, 9, 10, 6, 7)}, 'DDDD' => q{ @channels = (8, 9, 10, 11)}, ); } sub ai_wiring { ref( my $self = shift ) or croak is_instance('ai_wiring()'); my $s_or_d = shift; # Examples: 'SSSSSSSS 'DDDD 'DSSSSSS 'DDSSSS etc. $s_or_d =~ tr/sd/SD/; my @single_ended = (0, 1, 2, 3, 4, 5, 6, 7); my @differential = (8, 9, 10, 11); my @channels; if ( $s_or_d =~ m/^(D|SS){4}$/im) { @channels = eval qq[$ai_wiring{"$s_or_d"}]; } else { croak 'Oops! Improper pairing of S vs D flags at method ai_wiring().' } $self->{'AI Channels'} = \@channels; # Configure gains for all channels, both S and D, even though # gains for S are ignored so as to keep symetry with other args. my @gains; for (0 .. $#channels) { push @gains, 0 } $self->{'AI Gains'} = \@gains; } =pod =head2 Read device configuration $obj->get_config('Foo Bar'); Call the C method to read back any previously set configuration by naming its hash key. =cut # Get back stored info. sub get_config { ref( my $self = shift ) or croak is_instance('get_config()'); my $key = shift; $key = constrain_key( $key ); # Enforce naming rule. if (exists $self->{$key}) { return $self->{$key}; } else { carp "Oops! Method get_key() reports that \$self->{$key} does not exist."; return undef; } } =pod =head2 LabJack Device Functionality Refer to the I for specific details to all those methods which follow that are not described as I. $self->$self->assemble_args( 'Foo 'Bar' ); Called internally by C, the C method assembles parameters from out of the object's main hash into a format expected by the LabJack device. All such input arguments thus assembled are overridden by any suplied to the calling method itself. =cut sub assemble_args { ref( my $self = shift ) or croak is_instance('assemble_args()'); my @args; for ( @_ ) { push @args, $self->get_config($_) } return @args; } =pod $obj->easy_analog_in( 0 ); # For wired channel 0. ...or... print $lj->explain( $lj->easy_analog_in( 3 ) ); # For wired channel 3. BLabJack manual, the C function. Call upon the C method to return a hash containing 'Error 'ID Number 'Over-Voltage' and 'Voltage' for given channels. With this method (and most others to follow) call upon the C method to provide a verbose explanation of the return hash's contents. =cut sub easy_analog_in { ref( my $self = shift ) or croak is_instance('easy_analog_in()'); ref( my $chan = shift ) and carp 'Oops! Method easy_analog_in() is single-channel only.'; if ( $chan < 0 || $chan > $self->{'Highest Channel'} ) { carp "Oops! Method easy_analog_in() fed channel number $chan " . "which is outside range of 0 thru $self->{'Highest Channel'}." } my @configs = @_; $self->set_configs( @configs ) if @configs; # General config changes. my @args = $self->assemble_args( 'ID Number', 'Demo', 'AI Channels', 'AI Gains', ); $args[2] = @{ $args[2] }[ $chan ]; # One channel from available. $args[3] = @{ $args[3] }[ $chan ]; # Gain assigned same channel. # print "ARGS for easy_analog_in: ", join @args, "\n"; return hashify( ['Error', 'ID Number', 'Over-Voltage', 'Voltage'], Device::LabJack::EAnalogIn(@args) ); } =pod $obj->easy_analog_out( 2.2, 3.3 ); # AO2 to 2.2 Volts. AO3 to 3.3 Volgs. BLabJack manual, the C function. Call upon the C method to set outputs for the LabJack's two fixed AO channels and also return a hash containing 'Error' and 'ID Number' for those channels. =cut sub easy_analog_out { ref( my $self = shift ) or croak is_instance('easy_analog_out()'); my $v_out_0 = shift; my $v_out_1 = shift; my @configs = @_; $self->set_configs( @configs ) if @configs; # General config changes. my @args = $self->assemble_args( 'ID Number', 'Demo' ); push @args, ($v_out_0, $v_out_1); for (2, 3) { my $i = $_ - 2; if ($args[$_] < 0 || $args[$_] > 5) { carp "Oops! Voltage of $args[$i] outside range of " . "0-5 Volts for AO$_ "; } } return hashify( ['Error', 'ID Number'], Device::LabJack::EAnalogOut(@args) ); } =pod $obj->easy_count( 0 ); Call upon the C method to return a hash containing 'Error 'ID Number 'Count' and 'Miliseconds'. =cut sub easy_count { ref( my $self = shift ) or croak is_instance('easy_count()'); my $reset_after_flag = shift; my @configs = @_; $self->set_configs( @configs ) if @configs; my @args = $self->assemble_args( 'ID Number', 'Demo' ); return hashify( ['Error', 'ID Number', 'Count', 'Miliseconds'], Device::LabJack::ECount( @args, $reset_after_flag ) ); } =pod $obj->easy_digital_in( 15, 1 ); # Channel and IO-vs-D flag. BLabJack manual, the C function. Call upon C to read from a digital input. Said input will be an IO if flag is 0, a D if flag is 1. Returns a hash containing 'Error 'ID Number and 'State' of selected input. =cut sub easy_digital_in { ref( my $self = shift ) or croak is_instance('easy_digital_in()'); my $channel = shift; my $readD; if ( ref $channel ) { # Var $channel is href for both parts at once. ($channel, $readD) = @{$channel}; } else { # Var $channel is scalar for which IO (0-3) or DI (0-15) to read. # Must now get whether to read from a D versus from an IO. $readD = shift; } $self->update_tris_d(0, $mask[$channel] ); my @configs = @_; $self->set_configs( @configs ) if @configs; my @args = $self->assemble_args( 'ID Number'); return hashify( ['Error', 'ID Number', 'State'], Device::LabJack::EDigitalIn( @args, $channel, $readD ) ); } =pod $obj->lj_easy_digital_out( 15, 1, 1) ); # Channel, IO-vs-D flag, state. BLabJack manual, the C function. Call upon the C method to write to an output, setting it to given state. Said output will be an IO if flag is 0, a D if flag is 1. Returns a hash containing only 'Error'. =cut sub easy_digital_out { ref( my $self = shift ) or croak is_instance('easy_digital_out()'); my $channel = shift; # Which IO (0-3) or DO (0-15) to write to. my $writeD; if ( ref $channel ) { # Var $channel is href for both parts at once. ($channel, $writeD) = @{$channel}; } else { # Var $channel is scalar for which IO (0-3) or DI (0-15) to write to. # Must now get whether to write to a D versus from an IO. $writeD = shift; } $self->update_tris_d(1, $mask[$channel] ); my $state = shift; # 1 for high, 0 for low if ($state) { $self->{'State D'} |= 0x00000000 | $mask[$channel]; } else { $self->{'State D'} |= 0xffffffff ^ $mask[$channel]; } my @configs = @_; $self->set_configs( @configs ) if @configs; my @args = $self->assemble_args( 'ID Number', 'Demo' ); return hashify( ['Error',], Device::LabJack::EDigitalOut( @args, $channel, $writeD, $state ) ); } =pod $obj->ai_sample([0,1,2,3]); # Sample wired channels 0 thru 3. BLabJack manual, the C function. Call upon the C method to return a hash containing 'Error 'ID Number 'IO 0 'IO 1 'IO 2 'IO 3 'Over-Voltage' and 'Voltages' of which, the last two hash keys point to array refs. =cut sub ai_sample { ref( my $self = shift ) or croak is_instance('ai_sample()'); my $chans_aref = shift; # Available chans subset array ref. my @configs = @_; $self->set_configs( @configs ) if @configs; my @args = $self->assemble_args( 'ID Number', 'Demo', 'State IO', 'Update IO', 'LED On', 'AI Channels', 'AI Gains', 'Disable Cal', ); # Reduce available chans to requested chans and choose gains to match. $args[5] = [ @{ $args[5] }[@$chans_aref] ]; $args[6] = [ @{ $args[6] }[@$chans_aref] ]; my @chan_names; for ( @{ $chans_aref} ) { push @chan_names, 'Channel ' . $_ } return hashify( ['Error', 'ID Number', 'Over-Voltage', 'State IO', @chan_names ], Device::LabJack::AISample( @args ), ); } =pod $obj->ai_burst([0,1,2,3]); # Sample wired channels 0 thru 3. BLabJack manual, the C function. Call upon the C method to return a hash containing 'Error 'ID Number 'IO 0 'IO 1 'IO 2 'IO 3 'Over-Voltage' and 'Voltages' of which, the last two hash keys point to array refs. =cut sub ai_burst { ref( my $self = shift ) or croak is_instance('ai_burst()'); my $chans_aref = shift; # Available chans subset array ref. my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', 'Demo', 'State IO', 'Update IO', 'LED On', 'AI Channels', 'AI Gains', 'Scan Rate', 'Disable Cal', 'Trigger IO', 'Trigger State', 'Scan Count', 'Timeout Secs', 'Transfer Mode', ); my $chan_cnt = scalar @{ $chans_aref }; my $ratio = $self->{'Scan Rate'} * $chan_cnt; if ( "$chan_cnt" !~ m/^(1|2|4)$/m) { print "Oops! Channel count out of bounds: $chan_cnt = 1, 2 or 4."; } elsif ($ratio < 400 || $ratio > 8192) { print q|Oops! Channel count * 'Scan Rate' out of bounds: 400 <= | . "$chan_cnt * $self->{'Scan Rate'} <= 8192."; } # Reduce available chans to requested chans and choose gains to match. $args[5] = [ @{ $args[5] }[@$chans_aref] ]; $args[6] = [ @{ $args[6] }[@$chans_aref] ]; # Cannot call hashify() as data is a big mess. return $self->hashify_ai_burst( $chans_aref, Device::LabJack::AIBurst( @args ) ); } # Custom make a hash especially for ai_burst due to its data being # crammed together into one big flat array. sub hashify_ai_burst { ref( my $self = shift ) or croak is_instance('ai_burst()'); my $chans_aref = shift; my %hash; $hash{'Error'} = shift @_; $hash{'ID Number'} = shift @_; $hash{'Scan Rate'} = shift @_; $hash{'Over-Voltage'} = shift @_; my @states; for (1 .. $self->{'Scan Count'} ) { push @states, pop @_; } $hash{'States IO Out'} = \@states; # Divy up the channel data. my $i = 0; for ( @$chans_aref ) { my $k = $i + $self->{'Scan Count'} - 1; my @data = @_[$i .. $k]; $hash{'Channel ' . $_} = \@data; $i += $self->{'Scan Count'}; } return \%hash; } =pod $obj->lj_ai_stream_start(); $obj->lj_ai_stream_read(); $obj->lj_ai_stream_clear(); BLabJack manual, the C group of functions. Empty methods which do nothing except proclaim the parent module's non-support of them. Included only so as to prevent mystified head-scrathing on the part of newbie users. =cut sub ai_stream_start { alas_and_alack('AIStreamStart()') } sub ai_stream_read { alas_and_alack('AIStreamRead()') } sub ai_stream_clear { alas_and_alack('AIStreamClear()') } =pod $obj->ao_update(1.75, 4.25); # Set AOs to 1.75 and 4.25 Volts respectively. BLabJack manual, the C function. Call upon the C method to set AO1 and AO2 to given voltages. Returns a hash containing 'Error 'ID Number 'State D 'State IO' and 'Count'. =cut sub ao_update { ref( my $self = shift ) or croak is_instance('ao_update()'); my $volts_out_1 = shift; my $volts_out_2 = shift; my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', 'Demo', 'Tris D', 'Tris IO', 'State D', 'State IO', 'Update Digital', 'Reset Counter' ); return hashify( ['Error', 'ID Number', 'State D', 'State IO', 'Count'], Device::LabJack::AOUpdate( @args, $volts_out_1, $volts_out_2 ), ); } =pod $obj->asynch_config(); BLabJack manual, the C function. Call upon the C method to configure the asynchronous comm channel(s). Sets the baud rate, etc. Refer to Labjack manual for more details. Returns a hash containing only 'ID Number'. =cut sub asynch_config { ref( my $self = shift ) or croak is_instance('asynch_config()'); my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', 'Demo', 'Timeout Mult', 'Config A', 'Config B', 'Config TE', ); for ( @{ $self->{'Full A/B/C'} } ) { push @args, $_ } for ( @{ $self->{'Half A/B/C'} } ) { push @args, $_ } return hashify( ['ID Number'], Device::LabJack::AsynchConfig( @args ), ); } =pod $obj->asynch(); BLabJack manual, the C function. Call upon the C method to write then read half-duplex asynch data on pre-configured pairs of D lines. Refer to Labjack manual for more details. Returns a hash containing only 'ID Number' and 'Data'. This method is not tested and likely to remain so until a later version. =cut sub asynch { ref( my $self = shift ) or croak is_instance('asynch()'); my $data_aref = shift; my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', 'Demo', 'Port B', 'Enable TE', 'Enable TO', 'Enable Delay', 'Baud Rate', ); push @args, ( length @{ $data_aref }, $self->{'R/W Bytes'}, $data_aref, ); return hashify( ['ID Number', 'Data'], Device::LabJack::Asynch( @args ), ); } =pod $obj->bits_to_volts(0, 4095); # Channel and bits. BLabJack manual, the C function. Call upon the C method to convert for the given channel (at its current gain), a voltage equivalent to the given bits. =cut sub bits_to_volts { ref( my $self = shift ) or croak is_instance('bits_to_volts()'); my $chan = shift; my $bits = shift; my @args = ( $self->{'AI Channels'}->[$chan], $self->{'AI Gains'}->[$chan], $bits ); my @configs = @_; $self->set_configs( @configs ) if @configs; return hashify( ['Error', 'Voltage'], Device::LabJack::BitsToVolts( @args ), ); } =pod $obj->volts_to_bits(0, 19.99); # Channel and voltage. BLabJack manual, the C function. Call upon the C method to convert for the given channel (at its current gain), a 12-bit value equivalent to the given voltage. =cut sub volts_to_bits { ref( my $self = shift ) or croak is_instance('volts_to_bits()'); my $chan = shift; my $volts = shift; my @args = ( $self->{'AI Channels'}->[$chan], $self->{'AI Gains'}->[$chan], $volts ); my @configs = @_; $self->set_configs( @configs ) if @configs; return hashify( ['Error', 'Bits'], Device::LabJack::VoltsToBits( @args ), ); } =pod $obj->counter(); BLabJack manual, the C function. Call upon the C method to read current state of the counter. =cut sub counter { ref( my $self = shift ) or croak is_instance('counter()'); my $count = shift; my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', 'Demo', 'State D', 'State IO', 'Reset Counter', 'Enable STB', ); push @args, $count; return hashify( ['Error', 'ID Number', 'State D', 'State IO', 'Count'], Device::LabJack::Counter( @args ), ); } =pod $obj->digital_io(); BLabJack manual, the C function. Call upon the C method to read and write all 20 digital IO's. All D lines must be configured first as, contrary to the LabJack manual, this function does not set them as either input or output. Use either a prior call to C, C or C for that. =cut sub digital_io { ref( my $self = shift ) or croak is_instance('digital_io()'); my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', 'Demo', 'Tris D', 'Tris IO', 'State D', 'State IO', 'Update Digital', ); return hashify( ['Error', 'ID Number', 'Tris D', 'State D', 'State IO', 'Output D' ], Device::LabJack::DigitalIO( @args ), ); } # Note: # Device::LabJack::GetErrorString not dealt with in this module. =pod $obj->get_firmware_version(); BLabJack manual, the C function. Call upon the C method to return the firmware version. =cut sub get_firmware_version { ref( my $self = shift ) or croak is_instance('get_firmware_version()'); my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', ); return hashify( [ 'Firmware Version' ], Device::LabJack::GetFirmwareVersion( @args ), ); } # Note: # Device::LabJack::GetWinVersion not dealt with in this module. # Device::LabJack::ListAll not dealt with in this module. =pod $obj->local_id(); BLabJack manual, the C function. Call upon the C method to change a LabJack's local ID. Changes will not take effect until the LabJack is re-enumerated. =cut sub local_id { ref( my $self = shift ) or croak is_instance('local_id()'); my $new_ID = shift; my @configs = @_; $self->set_configs( @configs ) if @configs; return hashify( [ 'ID Number' ], Device::LabJack::GetFirmwareVersion( "$new_ID" ), ); } sub no_thread { woe_is_me('NoThread'), 'Not written yet.' } # Calculate half a pulse for use as sub with pulse_calc(); sub pulse_half { my $t = shift; my ($b, $c, $t2); FIN: for ($c=1; $c < 256; ++$c) { for ($b=1; $b < 256; ++$b) { $t2 = 0.83 * $c + 20.17 * $b * $c; # In microseconds if ($t2 > $t) { last FIN }; } } # Keep prior if closer than final. my $last_t = 0.83 * $c + 20.17 * ($b - 1) * $c; if ($t - $last_t < $t2 - $t) { $t = $last_t; --$b; } return ($t2, $b, $c); } =pod $obj->pulse_out_calc(5, 0.666); # 5 Hz at 60% duty cycle. BLabJack manual, the C function. Note significant differences. I elected to re-write this function for two reasons. Firstly, because in the parent module C as of version 0.21 it did not work. Secondly, I preferred it should work this way instead. Call upon the C method to calcuate the inputs required by the C method. =cut # Calculate output frequency and microsecond times # for 1st and 2nd halves of a pulse. sub pulse_out_calc { ref( my $self = shift ) or croak is_instance('pulse_calc()'); my ($freq, $duty_cycle) = @_; my $t = 1_000_000 / $freq; # t = microsecs-per-sec / cycles-per-sec my $t1 = $t * $duty_cycle; # 1st half of cycle. my $t2 = $t - $t1; # 2nd half of cycle. my ($b1, $b2, $c1, $c2); ($t1, $b1, $c1) = pulse_half($t1 - 17); ($t2, $b2, $c2) = pulse_half($t2 - 12); $freq = 1_000_000 / ($t1 + 17 + $t2 + 12); # print "F = $freq Hz\n"; return hashify ( ['Frequency', 'timeB1', 'timeC1', 'timeB2', 'timeC2'], $freq, $b1, $c1, $b2, $c2 ); } =pod $obj->pulse_out_calc_retro(254, 26, 255, 13); # timeB1, timeC1, timeB2, timeC2 Call upon the C method to reverse-calcuate the the output waveform given a set of LabJack Reference Manual type input values. =cut # From the LabJack manual for PulseOut calculation. sub pulse_out_calc_retro { ref( my $self = shift ) or croak is_instance('pulse_calc_retro()'); my ($b1, $c1, $b2, $c2) = @_; my $t1 = 17 + 0.83 * $c1 + 20.17 * $b1 * $c1; my $t2 = 12 + 0.83 * $c2 + 20.17 * $b2 * $c2; my $freq = 1_000_000 / ($t1 + $t2); my $duty_cycle = $t1 / ($t1 + $t2); return hashify( [ 'Frequency', 'Duty Cycle', '1st Half', '2nd Half'], $freq, $duty_cycle, $t1, $t2 ); } =pod my @b1_c1_b2_c2 = (254, 26, 255, 13); $obj->pulse_out( 0, 2, 512, @b1_c1_b2_c2 ); BLabJack manual, the C function. Usage differs in that any D line you choose to pulse will be automatically set as an output if not done already. Call upon the C method to output pulses on any or all of the eight digital IO lines, D0-D7. The wierdness of this method originates in the LabJack itself and is reflected in all its ugliness within the parent module C. Just in case it might have some reason behind it, rather than rewrite it more to my liking, I have defined an a additional method named C. Look for it further down in this file. B To use either the this C method or its daughter method C without crashing you will require the module C version 0.3 or later. Versions 0.21 and earlier suffer a small typo in their C files. As of this writing, said latest version was not yet in CPAN and available from Chris Drake directly or from myself. Thanks to Chris for acting upon my bug report immediately upon being informed of it and for emailing the fix to me directly. =cut sub pulse_out { ref( my $self = shift ) or croak is_instance('pulse_out()'); my @pulse_args; for (qw( lowFirst bitSelect numPulses timeB1 timeC1 timeB2 timeC2 )) { push @pulse_args, shift @_; } $self->update_tris_d(1, $pulse_args[1]); my @args = $self->assemble_args( 'ID Number', 'Demo', ); push @args, @pulse_args; my @configs = @_; $self->set_configs( @configs ) if @configs; my $return; # First check that pulsed IO is set as an output. # Parens avoid precidence conflict between '&' and '==' ops. if ( ($self->{'Tris D'} & $args[3]) == $args[3]) { return hashify( [ 'ID Number' ], Device::LabJack::PulseOut( @args ), # Crashes here on Device::LabJack ver 2! ) } else { return { 'error' => 'Oops! Method pulse_out() cannot pulse D bits ' . "$args[3] while 'Tris D' set at $self->{'Tris D'}." } } } =pod $obj->easy_pulse_out( 0, 2, 512, 10, 0.5 ); Call upon the C method to in the place of C where you prefer to supply frequency and duty cycle in the place of the four timing critera timeB1, timeC1, timeB2, timeC2. =cut sub easy_pulse_out { ref( my $self = shift ) or croak is_instance('easy_pulse_out()'); my @pulse_args; for (qw( lowFirst bitSelect numPulses frequency duty_cycle )) { push @pulse_args, shift @_; } # Use the extracted timing criteria list so as to pulse the # line D2 for 500 cycles, starting out low-then-high as/per # the LabJack manual. $self->pulse_out( @pulse_args[0,1,2], $self->extract_from_href( $self->pulse_out_calc( @pulse_args[3,4] ), 'timeB1', 'timeC1', 'timeB2', 'timeC2', ), @_, ); } =pod my @b1_c1_b2_c2 = (254, 26, 255, 13); $obj->pulse_out_start( 0, 2, 512, @b1_c1_b2_c2 ); BLabJack manual, the C function. Usage differs in that any D line you choose to pulse will be automatically set as an output if not done already. Call upon the C method the same as for C where you prefer the interpreter should not wait its return, but proceed with the rest of the script. =cut sub pulse_out_start { ref( my $self = shift ) or croak is_instance('pulse_out()'); my @pulse_args; for (qw( lowFirst bitSelect numPulses timeB1 timeC1 timeB2 timeC2 )) { push @pulse_args, shift @_; } $self->update_tris_d(1, $pulse_args[1]); my @configs = @_; $self->set_configs( @configs ) if @configs; my @args = $self->assemble_args( 'ID Number', 'Demo', ); push @args, @pulse_args; my $return; return hashify( [ 'ID Number' ], Device::LabJack::PulseOutStart( @args ), ) } =pod $obj->update_tris_d( bool, channels ); Called by those subroutines which make changes of direction in the digital IO's so that their status is tracked in the main hash. =cut sub update_tris_d { ref( my $self = shift ) or croak is_instance('update_tris_d()'); my ($flag_out, $chans) = @_; # Since 'Tris D', range 0-255, indicates signal direction # for lines D0 thru D15 (0 = IN, 1 = OUT) do this... if ($flag_out) { $self->{'Tris D'} |= $chans; # Remember as output. } else { my $mask = 0xffffffff ^ $chans; $self->{'Tris D'} &= $mask; # Remember as input. } $self->digital_io(); } =pod $obj->easy_pulse_out_start( 0, 2, 512, 10, 0.5 ); Call upon the C method in the place of C where you prefer to supply frequency and duty cycle rather than the four timing critera timeB1, timeC1, timeB2, timeC2. =cut sub easy_pulse_out_start { ref( my $self = shift ) or croak is_instance('easy_pulse_out()'); my @pulse_args; for (qw( lowFirst bitSelect numPulses frequency duty_cycle )) { push @pulse_args, shift @_; } # Use the extracted timing criteria list so as to pulse the # line D2 for 500 cycles, starting out low-then-high as/per # the LabJack manual. $self->pulse_out_start( @pulse_args[0,1,2], $self->extract_from_href( $self->pulse_out_calc( @pulse_args[3,4] ), 'timeB1', 'timeC1', 'timeB2', 'timeC2' ), @_, ); } =pod $obj->pulse_out_finish( 30 ); # Thirty secs timeout. BLabJack manual, the C function. Call upon the C method to pause interpretation while awaiting pulses initiated by C or C to be completed. =cut sub pulse_out_finish { ref( my $self = shift ) or croak is_instance('pulse_out_finish()'); my $time_out_ms = shift @_; my @args= $self->assemble_args( 'ID Number', 'Demo' ); return hashify( ['ID Number'], Device::LabJack::PulseOutFinish( @args, $time_out_ms ), ); } =pod $obj->reenum(); BLabJack manual, the C function. Call the method C to cause the LabJack to reset after two seconds. The LabJack will re-enumerate upon resetting. =cut sub re_enum { ref( my $self = shift ) or croak is_instance('re_enum()'); my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', ); return hashify( [ 'ID Number' ], Device::LabJack::ReEnum( @args ), # Crashes here! ); } =pod $obj->re_set(); # Think 'reset' for LabJack. BLabJack manual, the C function. Call the method C to cause the LabJack to reset after two seconds. The LabJack will re-enumerate upon resetting. =cut sub re_set { ref( my $self = shift ) or croak is_instance('re_set()'); my @configs = @_; $self->set_configs( @configs ) if @configs; my @args= $self->assemble_args( 'ID Number', ); return hashify( [ 'ID Number' ], Device::LabJack::Reset( @args ), # Crashes here! ); } =pod $obj->sht1x(); $obj->sht_comm(); $obj->sht_crc(); BLabJack manual, the C, C and C functions. I don't have one of these sensors. Not being able to test, I have put off writing these methods until such time as I obtain one. As of now they only inform of not being supported. =cut sub sht1x { woe_is_me('SHT1X'), 'Author has no unit to experiment with.' } sub sht_comm { woe_is_me('SHTComm'), 'Author has no unit to experiment with.' } sub sht_crc { woe_is_me('SHTCRC'), 'Author has no unit to experiment with.' } ################### # GENERAL SECTION # ################### =pod hashify($names_aref, @values); Called internally by most methods to compose the hash returned by those methods. I do it this way because there were so many different ones that I could not remember them. =cut sub hashify { my ($names_aref, @values) = @_; my %hash; my $keys_in = scalar @{ $names_aref }; my $values_out = scalar @values; if ( $keys_in == $values_out ) { while ( @{ $names_aref } ) { my $key = shift @{ $names_aref }; $hash{"$key"} = shift @values; if ( $key eq 'Error' && $hash{"$key"} =~ /^[1-9]+$/ ) { # print qq|BEFORE: $hash{"$key"}\n|; $hash{"$key"} = Device::LabJack::GetErrorString($hash{"$key"}); # print qq|AFTER: $hash{"$key"}\n|; print qq|Oops! Error at &hashify(): $hash{"$key"} \n|; } } } else { $hash{'Alert!'} = "Hash keys and values not ballanced: $keys_in vs $values_out"; $hash{'Keys'} = join ', ', @{ $names_aref }; $hash{'Values'} = join ', ', @values; } return \%hash; } =pod print $obj->explain( $lj->foo( 3 ) ); Call upon the C method to return a verbose description for whatever hash another method might return. =cut # Explain contents of a hash. # Answers the question, "Tell me what that output means?". sub explain { ref( my $self = shift ) or croak is_instance('explain()'); my $href = shift; my $fdbk; my @keys = sort keys %{ $href }; for ( @keys ) { my $value = $href->{$_}; if ( ref $value ) { $value = join ', ', @{ $value }; } $fdbk .= "$_ = $value \n"; } return $fdbk; } =pod $obj->extract_from_href( $obj->foo('bar'), 'this_key', 'that_key' ); Call upon the C method to return an array of select values from the hash ref returned by most methods below. =cut # Extract select contents from hash ref. sub extract_from_href { ref( my $self = shift ) or croak is_instance('extract_from_href()'); my $href = shift; my @values; for ( @_ ) { push @values, $href->{$_}; } return @values; } # For methods not in parent module Device::LabJack. sub alas_and_alack { my $wanted = shift; my $fdbk; if ( defined &Device::LabJack::ai_stream_start ) { $fdbk .= "Hurrah! Method '$wanted' is now supported by parent module, " . "Device::LabJack. Email gan\@starling.us to inform of needed " . "update for method '$wanted'." } else { $fdbk .= "Sorry... Method '$wanted' not yet supported by parent module, " . 'Device::LabJack.'; } return $fdbk; } # For methods which exist in Device::LabJack but which I've not yet # gotten working. sub woe_is_me { my $snafu = shift; my $why = shift; my $msg = "Sorry... Method '$snafu' not yet yet working in module " . 'Device::LabJack::Control.'; $msg .= "\n$why\n" if $why; return $msg; } # Used during development and debugging. sub show_args { print "LIST OF ARGUMENTS:\n"; for ( @_ ) { if ( ref $_ ) { print "\t", join ", ", @{ $_ }; print "\n"; } else { print "\t$_\n"; } } } # Standardize case of hash keys on ucfirst. sub constrain_key { my $key = shift; $key = unquote_neatly( $key ); my @words = split q{ }, $key; for (@words) { $_ = ucfirst $_; } $key = join q{ }, @words; return $key; } # Unpad, unquote given string. sub unquote_neatly { my $str = shift; while ( $str =~ m/^($ASCII_SQUOT|\s)/m || $str =~ m/($ASCII_SQUOT|\s)$/m ) { $str =~ s/^($ASCII_SQUOT|\s)//m; $str =~ s/($ASCII_SQUOT|\s)$//m; } return $str; } # Unpad, unquote, requote given string. # This non-OO function is exported. # Could avoid exporting by making pseudo-OO and shifting $self into oblivion. sub quote_neatly { my $str = shift; $str = unquote_neatly( $str ); return qq|'$str'|; } # Binary math ops sub dec_to_bin{ return sprintf("%b", $_[0]) } sub bin_to_dec { return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); } sub is_class { return 'Oops! method ' . $_[0] . ' is class, not instance.'; } sub is_instance { return 'Oops! method ' . $_[0] . ' is instance, not class.'; } 1; __END__ =pod =head1 BUGS AND LIMITATIONS I wrote this for me and you are welcome to it for free. I offer absolutely no warranties or guarantees of any kind (expressed, implied, or even vaguely hinted at). In all probability it is riddled with bugs and wholly incompatible with all hardware everywhere...software and wetware too...down to your very DNA. Thus forewarned, employ it entirely at your own risk. =head1 AUTHOR Gan Uesli Starling > =head1 LICENSE AND COPYRIGHT Copyright (c) 2006 Gan Uesli Starling. All rights reserved. This program is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut =head2 LabJack Error Codes. 0 No error. 1 Unknown error. 2 No LabJacks found. 3 LabJack n not found 4 Set USB buffer error. 5 Open handle error. 6 Close handle error. 7 Invalid ID. 8 Invalid array size or value. 9 Invalid power index. 10 FCDD size too big. 11 HVC size too big. 12 Read error. 13 Read timeout error. 14 Write error. 15 Turbo error. 16 Illegal channel index. 17 Illegal gain index. 18 Illegal AI command. 19 Illegal AO command. 20 Bits out of range. 21 Illegal number of channels. 22 Illegal scan rate. 23 Illegal number of samples. 24 AI response error. 25 LabJack RAM checksum error. 26 AI sequence error. 27 Maximum number of streams. 28 AI stream start error. 29 PC buffer overflow. 30 LabJack buffer overflow. 31 Stream read timeout. 32 Illegal number of scans. 33 No stream was found. 40 Illegal input. 41 Echo error. 42 Data echo error. 43 Response error. 44 Asynch read timeout error. 45 Asynch read start bit error. 46 Asynch read framing error. 47 Asynch DIO config error. 48 Caps error. 49 Caps error. 50 Caps error. 51 HID number caps error. 52 HID get attributes warning. 57 Wrong firmware version error. 58 DIO config error. 64 Could not claim all Labjacks. 65 Error releasing all LabJacks. 66 Could not claim LabJack. 67 Error releasing LabJack. 68 Claimed abandoned LabJack. 69 Local ID -1 thread stopped. 70 Stop thread timeout. 71 Thread termination failed. 72 Feature handle creation error. 73 Create mutex error. 80 Synchronous CS state or direction error. 81 Synchronous SCK direction error. 82 Synchronous MSIO direction error. 83 Synchronous MOSI direction error. 89 SHT1X CRC error. 90 SHT1X measurement ready error. 91 SHT1X ack error. 92 SHT1X serial reset error =cut