File Coverage

blib/lib/Device/USB/PX1674.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# CMD-Class for Revolt USB Dongle PX-1674-675

package Device::USB::PX1674;

$VERSION = '1.04';

use strict;
use warnings;
use Device::USB;
use Carp;

sub new{
    my $class = shift;
    my %cfg = (
        vid  => 0xFFFF,   # Vendor ID
        pid  => 0x1122,   # Product ID
        ept  => 0x02,     # Endpoint Out
        addr => 0x1A1A,   # Hauscode
        intf => 0,        # Interface
        cfg  => 1,        # Configuration
        verb => 0,        # Verbose
    @_);
    my $self = bless{
        CMD   => {
            1     => { On => 0xF0, Off => 0xE0 },
            2     => { On => 0xD0, Off => 0xC0 },
            3     => { On => 0xB0, Off => 0xA0 },
            4     => { On => 0x90, Off => 0x80 },
            5     => { On => 0x70, Off => 0x60 },
            6     => { On => 0x50, Off => 0x40 },
            group => { On => 0x20, Off => 0x10 },
        },
        CFG => \%cfg,
    }, $class;

    eval{
        my $vid = sprintf "%04X", $cfg{vid};
        my $pid = sprintf "%04X", $cfg{pid};
        my $usb = Device::USB->new;

        my $dev = undef;
        foreach my $d( $usb->list_devices ){
            if( $d->idVendor == $cfg{vid} && $d->idProduct == $cfg{pid} ){
                $dev = $d;
                last;
            }
        }
        die "Device Vendor '$vid', Product '$pid' not found\n"
            unless $dev;
        $dev->open || die "Error open device!\n";

        if( $dev->set_configuration($cfg{cfg}) != 0 ){
            die "Can not set configuration!\n";
        }
        if( $dev->claim_interface($cfg{intf}) != 0 ){
            die "Can not claim interface\n";
        }

        $self->{usb_dev} = $dev;
        $self;
    };
}
# On|Off|switch
# Übergeben wird die Gerätenummer
# Ansonsten wird die Gruppe geschaltet
# __ANON__
my $OnOff = sub{
    my $self = shift;
    my $dest = shift;
    my $devnr = shift || 'group';
    my $payload = $self->_payload($devnr, $dest);

    print join(" ", map{sprintf("%02X", $_)}unpack "C*", $payload) if $self->{CFG}{verb};
    return $self->{usb_dev}->bulk_write( $self->{CFG}{ept}, $payload, 8, 5000);
};
############################ Private ######################################
sub _payload{
    my $self  = shift;
    my $devnr = shift;
    my $dest  = shift;

    my $cmd = $self->{CMD}{$devnr}{$dest} || croak "CMD '$dest' for device '$devnr' not found!";
    my ($b1, $b2) = unpack "CC", pack "n", $self->{CFG}{addr};
    my $chk = 255 - ($b1 + $b2 + $cmd) % 256;
    return pack "C8", $b1,$b2,$cmd,$chk,0x20,0x0A,0x00,0x18;
}

# On || Off || switch über eine anonyme Funktion
sub AUTOLOAD{
    my $self = shift;
    my $name = our $AUTOLOAD =~ /::(\w+)$/ ? $1 : '';
    if( $name eq 'On' || $name eq 'Off' ){
        $self->$OnOff($name, @_);
    }
    elsif( $name eq 'switch'){
        $self->$OnOff(@_);
    }
    else{ die "Unbekannte Funktion: '$name'!\n" }
}
sub DESTROY{}
1;#########################################################################

#my $px = Device::USB::PX1674->new() or die $@;
#$px->Off;

__END__