Perl Klasse für USB-Dongle Revolt PX-1674-675

Mit Perl Device::USB::PX1674 Elektrogeräte bzw. Funksteckdosen PX-1672-675, PX-1673-675 schalten

Hinweis: Die erforderlichen Module sind für Win32 via ppm verfügbar, tippe einfach:

ppm install http://rolfrost.de/Device-USB.ppd
ppm install http://rolfrost.de/Device-USB-PX1674.ppd

Auf einer Win32-Maschine wird der USB-Stick über libusb-win32-devices angesteuert. Für die Instanzerstellung ist also der Stick mit dem zur LibUSB mitgeliefeten InfWizard als USB-Device einzurichten. Der optionale Verbose-Modus veranlasst eine print-Ausgabe der an den Stick gesendeten Bytesequenz als Hex-Dump.

my $px = Device::USB::PX1674->new(
    addr => 0x1A85,
    verb => 1
) or die $@;

Auf einer Adresse können bis zu 6 Geräte (Steckdosen) angelernt werden. Zur Auslösung eines Schaltvorganges ist die Geräte-ID anzugeben. Sofern das nicht der Fall ist, werden alle Geräte, die auf diese Adresse (Hauscode) angelernt wurden, geschaltet.

$px->On(1); # Schaltet Steckdose 1 On
            # ===Payload===
            # 1A 85 F0 70 20 0A 00 18

$px->Off(); # schaltet die ganze Gruppe ab
            # ===Payload===
            # 1A 85 10 50 20 0A 00 18

# Ebenfalls möglich
$px->switch('On', 1); # Schaltet Steckdose 1 On
$px->switch('Off');   # Schaltet die Gruppe Off

Perl Source für das Modul Device::USB::PX1674

# Revolt USB Dongle PX-1674-675

package Device::USB::PX1674;

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();
        $usb->find_busses || die "No USB busses found!\n";
        my $dev = $usb->find_device($cfg{vid}, $cfg{pid} ) or die "Device Vendor '$vid', Product '$pid' not found\n";
        $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, 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;#########################################################################
__END__
package main;
use Data::Dumper;
my $px = Device::USB::PX1674->new(
    #addr => 0x1A85,
    #verb => 1
) or die $@;

$px->Off(1)

Datenschutzerklärung: Diese Seite dient rein privaten Zwecken. Auf den für diese Domäne installierten Seiten werden grundsätzlich keine personenbezogenen Daten erhoben. Das Loggen der Zugriffe mit Ihrer Remote Adresse erfolgt beim Provider soweit das technisch erforderlich ist. s​os­@rolf­rost.de. Entity: 594ce34ab15e04755be0f16fa32f53b7