#!/usr/bin/perl

use strict;
use warnings;

use Device::USB;

my $usb = Device::USB->new();

unless( @ARGV ) {
    list_devices();
    exit 0;
}

my $colour;
if( @ARGV==2 ) {
    $colour = $ARGV[1];
}
else {
    $colour = $ARGV[0];
}
die "The colour must be between 0 and 7.\n" 
    if $colour and not $colour =~ /^[0-7]$/;

if( not $ARGV[1] or $ARGV[0] =~ /([a-f\d]+):([a-f\d]+)/i ) {
    my( $mfg, $prod );
    if( $ARGV[1] ) {
        ( $mfg, $prod ) = ( hex $1, hex $2 );
    }
    else {
        ( $mfg, $prod ) = ( 0x1294, 0x1320 ) unless $ARGV[1];
    }
    foreach my $bus ( $usb->list_busses ) {
        foreach my $dev ( $bus->devices ) {
            next unless $dev->idVendor == $mfg and $dev->idProduct == $prod;
            set_colour( $dev, $colour );
        }
    }
}
elsif( $ARGV[0] =~ /(\d+)-(\d+)/ ) {
    my( $busN, $devN ) = ( $1, $2 );
    foreach my $bus ( $usb->list_busses ) {
        next unless $bus->dirname == $busN;
        foreach my $dev ( $usb->find_device_if( sub { $_->filename == $devN } ) ) {
            set_colour( $dev, $colour );
        }
    }
}
else {
    die <<USAGE;
Usage: $0
       $0 COLOUR
       $0 DEV COLOUR
Where 
    DEV is either VENDOR:PRODUCT or BUS-DEVICE
    COLOUR is 0 to 7
USAGE
}



###########################################
sub list_devices
{
    foreach my $bus ( $usb->list_busses ) {
        foreach my $dev ( $bus->devices ) {
            print "Device: ", join '-', 0+$bus->dirname, 0+$dev->filename;
                
            printf " %04X:%04X ", $dev->idVendor(), $dev->idProduct();
            $dev->open() and print $dev->manufacturer(), "/", $dev->product();
            print "\n";
        }
    }
}

###########################################
sub set_colour
{
    my( $dev, $colour ) = @_;
    $dev->open or die "Unable to open device: $!";
    $dev->detach_kernel_driver_np( 0 ) or die;
    $dev->detach_kernel_driver_np( 1 ) or die;
    my $cfg = $dev->get_configuration( 0 );
    $dev->set_configuration( $cfg ) or die;
    my $intf = $cfg->interfaces->[0][0];
    $dev->claim_interface( $intf ) or die;
    $dev->set_altinterface( $intf) or die;
    $dev->interrupt_write( 0x02, make_data( $colour ), 1000 );
}

###########################################
sub make_data
{
    my( $colour ) = @_;
    $colour ||= 1;
    return pack "c*", $colour, 0, 0, 0, 0;
}

# Mailbox:
# 0001 1 green
# 0010 2 red
# 0011 3 blue
# 0100 4 cyan
# 0101 5 light green
# 0110 6 magenta
# 0111 7 light blue

# Tear drop
# 0001 1 blue
# 0010 2 red
# 0011 3 green
# 0100 4 cyan
# 0101 5 magenta
# 0110 6 yellow
# 0111 7 pale blue