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

in der DOS-Konsole ein.

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)

Anbieter: nmq​rstx-18­@yahoo.de, die Seite verwendet funktionsbedingt einen Session-Cookie und ist Bestandteil meines nach modernen Aspekten in Perl entwickelten Frameworks.