Device-USB-0.38/0000755000175000017500000000000013510122743012554 5ustar gwadejgwadejDevice-USB-0.38/t/0000755000175000017500000000000013510122743013017 5ustar gwadejgwadejDevice-USB-0.38/t/15-usb_dev_configuration.t0000644000175000017500000000274112304114533020007 0ustar gwadejgwadej#!perl -T use Test::More; use Device::USB; use strict; use warnings; use constant TESTS_PER_CONFIGURATION => 7; my $usb = Device::USB->new(); if(defined $usb) { my $config_count = 0; foreach my $dev ($usb->list_devices()) { $config_count += $dev->bNumConfigurations(); } if($config_count) { plan tests => 2 + TESTS_PER_CONFIGURATION * $config_count; } else { plan skip_all => 'No devices found.'; } } else { fail( "Unable to create USB object." ); } can_ok( "Device::USB::DevConfig", qw/wTotalLength bNumInterfaces interfaces bConfigurationValue iConfiguration bmAttributes MaxPower/ ); my @devices = $usb->list_devices(); isnt( scalar @devices, 0, "USB devices found" ); foreach my $dev (@devices) { my $filename = $dev->filename(); my $cfgno = 0; foreach my $cfg ($dev->configurations()) { isa_ok( $cfg, "Device::USB::DevConfig" ); like( $cfg->wTotalLength(), qr/^\d+$/, "$filename:$cfgno: USB Version" ); is( $cfg->bNumInterfaces(), scalar @{$cfg->interfaces()}, "$filename:$cfgno: interface count" ); like( $cfg->bConfigurationValue(), qr/^\d+$/, "$filename:$cfgno: configuration value" ); like( $cfg->iConfiguration(), qr/^\d+$/, "$filename:$cfgno: configuration" ); like( $cfg->bmAttributes(), qr/^\d+$/, "$filename:$cfgno: Attributes" ); like( $cfg->MaxPower(), qr/^\d+$/, "$filename:$cfgno: max power" ); ++$cfgno; } } Device-USB-0.38/t/06-list_devices.t0000644000175000017500000000245712304111574016114 0ustar gwadejgwadej#!perl -T use lib "t"; use TestTools; use Test::More tests => 8; use Device::USB; use strict; use warnings; my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); can_ok( $usb, "list_devices" ); my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); my $found_device = TestTools::find_an_installed_device( 0, @{$busses} ); SKIP: { skip "No installed USB devices", 5 unless defined $found_device; my $vendor = $found_device->idVendor(); my $product = $found_device->idProduct(); my @devices = $usb->list_devices( $vendor, $product ); my $device_count = @devices; ok( 0 < $device_count, "At least one device found" ); my $matches = grep { $_->idVendor() == $vendor && $_->idProduct() == $product } @devices; is( $matches, $device_count, "All match vendor and product" ); my @vendor_devices = $usb->list_devices( $vendor ); my $vdevice_count = @vendor_devices; ok( $device_count <= $vdevice_count, "At least one device found by vendor" ); $matches = grep { $_->idVendor() == $vendor } @vendor_devices; is( $matches, $vdevice_count, "All vendors match" ); my @all_devices = $usb->list_devices(); my $all_count = @all_devices; ok( $vdevice_count <= $all_count, "At least one device found" ); } Device-USB-0.38/t/04-find_device.t0000644000175000017500000000301712304111574015665 0ustar gwadejgwadej#!perl -T use lib "t"; use TestTools; use Test::More tests => 8; use Device::USB; use strict; use warnings; my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); can_ok( $usb, "find_device" ); ok( !defined $usb->find_device( 0xFFFF, 0xFFFF ), "No device found" ); my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); my $found_device = TestTools::find_an_installed_device( 0, @{$busses} ); SKIP: { skip "No USB devices installed", 4 unless defined $found_device; my $vendor = $found_device->idVendor(); my $product = $found_device->idProduct(); my $dev = $usb->find_device( $vendor, $product ); ok( defined $dev, "Device found." ); is_deeply( $dev, $found_device, "first device matches" ); my $count = @{$busses}; skip "Only one USB device installed", 2 if $count < 2; $found_device = undef; for(my $i = 1; $i < $count; ++$i) { my $dev = TestTools::find_an_installed_device( $i, @{$busses} ); next unless defined $dev; # New vendor/product combination if($vendor != $dev->idVendor() || $product != $dev->idProduct()) { $found_device = $dev; last; } } skip "No accessible device found", 2 unless defined $found_device; $vendor = $found_device->idVendor(); $product = $found_device->idProduct(); $dev = $usb->find_device( $vendor, $product ); ok( defined $dev, "Device found." ); is_deeply( $dev, $found_device, "second device matches" ); } Device-USB-0.38/t/03-list_busses.t0000644000175000017500000000104112304111574015757 0ustar gwadejgwadej#!perl -T use Test::More qw(no_plan); ## no critic(ProhibitNoPlan) use Device::USB; use strict; use warnings; # # No plan, because the number of tests depends on the number of # busses and devices on the system. # my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); can_ok( $usb, "list_busses" ); my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); isa_ok( $busses, "ARRAY", "An array of busses returned." ); foreach my $bus (@{$busses}) { isa_ok( $bus, "Device::USB::Bus" ); } Device-USB-0.38/t/01-create-usb.t0000644000175000017500000000030112304115036015443 0ustar gwadejgwadej#!perl use Test::More tests => 2; use strict; use warnings; use Device::USB; my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); isa_ok( $usb, 'Device::USB' ); Device-USB-0.38/t/07-list_devices_if.t0000644000175000017500000000400712304111574016564 0ustar gwadejgwadej#!perl -T use lib "t"; use TestTools; use Test::More tests => 11; use Device::USB; use strict; use warnings; my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); can_ok( $usb, "list_devices_if" ); eval { $usb->list_devices_if() }; like( $@, qr/Missing predicate/, "Requires a predicate." ); eval { $usb->list_devices_if( 1 ) }; like( $@, qr/Predicate must be/, "Requires a code reference." ); my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); my $found_device = TestTools::find_an_installed_device( 0, @{$busses} ); SKIP: { skip "No installed USB devices", 6 unless defined $found_device; my $vendor = $found_device->idVendor(); my $product = $found_device->idProduct(); my @devices = $usb->list_devices_if( sub { $_->idVendor() == $vendor && $_->idProduct() == $product } ); my $device_count = @devices; ok( 0 < $device_count, "At least one device found" ); my $matches = grep { $_->idVendor() == $vendor && $_->idProduct() == $product } @devices; is( $matches, $device_count, "All match vendor and product" ); my @vendor_devices = $usb->list_devices_if( sub { $_->idVendor() == $vendor } ); my $vdevice_count = @vendor_devices; ok( $device_count <= $vdevice_count, "At least one device found by vendor" ); $matches = grep { $_->idVendor() == $vendor } @vendor_devices; is( $matches, $vdevice_count, "All vendors match." ); my @all_devices = $usb->list_devices_if( sub { defined } ); my $all_count = @all_devices; ok( $vdevice_count <= $all_count, "At least one device found" ); my @hubs = $usb->list_devices_if( sub { 9 == $_->bDeviceClass() } ); my $mismatches = grep { 9 != $_->bDeviceClass() } @hubs; ok( !$mismatches, "No non-hubs selected." ); } sub check_classes { foreach my $dev ($usb->list_devices()) { print join( ': ', $dev->idVendor(), $dev->idProduct(), $dev->bDeviceClass(), $dev->bDeviceSubClass() ), "\n"; } return; } Device-USB-0.38/t/08-get_busses.t0000644000175000017500000000111212304111574015567 0ustar gwadejgwadej#!perl -T use Test::More qw(no_plan); ## no critic(ProhibitNoPlan) use Device::USB; use strict; use warnings; # # No plan, because the number of tests depends on the number of # busses and devices on the system. # my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); can_ok( $usb, "get_busses" ); $usb->find_busses(); $usb->find_devices(); my $busses = $usb->get_busses(); ok( defined $busses, "USB busses found" ); isa_ok( $busses, "ARRAY", "An array of busses returned." ); foreach my $bus (@{$busses}) { isa_ok( $bus, "Device::USB::Bus" ); } Device-USB-0.38/t/18-usb_device-configurations.t0000644000175000017500000000150412304111574020572 0ustar gwadejgwadej#!perl -T use Test::More; use Device::USB; use strict; use warnings; my $usb = Device::USB->new(); if(defined $usb) { my @devices = $usb->list_devices(); my $num_configs = 0; $num_configs += $_->bNumConfigurations() foreach @devices; plan tests => 1 + $num_configs*2; } else { fail( "Unable to create USB object." ); } my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); foreach my $bus (@{$busses}) { foreach my $dev (@{$bus->devices()}) { my @configs = $dev->configurations(); my $num_configs = $dev->bNumConfigurations() - 1; foreach my $i (0..$num_configs) { is( $dev->get_configuration( $i ), $configs[$i], "Positive index" ); is( $dev->get_configuration( -$i ), $configs[-$i], "Negative index" ); } } } Device-USB-0.38/t/12-constants.t0000644000175000017500000000177212304111574015447 0ustar gwadejgwadej#!perl -T use Test::More tests => 18; use Device::USB; use strict; use warnings; can_ok( 'Device::USB', qw/CLASS_PER_INSTANCE/ ); is( Device::USB::CLASS_PER_INSTANCE, 0, "CLASS_PER_INSTANCE value" ); can_ok( 'Device::USB', qw/CLASS_AUDIO/ ); is( Device::USB::CLASS_AUDIO, 1, "CLASS_AUDIO value" ); can_ok( 'Device::USB', qw/CLASS_COMM/ ); is( Device::USB::CLASS_COMM, 2, "CLASS_COMM value" ); can_ok( 'Device::USB', qw/CLASS_HID/ ); is( Device::USB::CLASS_HID, 3, "CLASS_HID value" ); can_ok( 'Device::USB', qw/CLASS_PRINTER/ ); is( Device::USB::CLASS_PRINTER, 7, "CLASS_PRINTER value" ); can_ok( 'Device::USB', qw/CLASS_MASS_STORAGE/ ); is( Device::USB::CLASS_MASS_STORAGE, 8, "CLASS_MASS_STORAGE value" ); can_ok( 'Device::USB', qw/CLASS_HUB/ ); is( Device::USB::CLASS_HUB, 9, "CLASS_HUB value" ); can_ok( 'Device::USB', qw/CLASS_DATA/ ); is( Device::USB::CLASS_DATA, 10, "CLASS_DATA value" ); can_ok( 'Device::USB', qw/CLASS_VENDOR_SPEC/ ); is( Device::USB::CLASS_VENDOR_SPEC, 0xff, "CLASS_VENDOR_SPEC value" ); Device-USB-0.38/t/00-load.t0000644000175000017500000000025412304111574014341 0ustar gwadejgwadej#!perl -T use Test::More tests => 1; use strict; use warnings; BEGIN { use_ok( 'Device::USB' ); } diag( "Testing Device::USB $Device::USB::VERSION, Perl $], $^X" ); Device-USB-0.38/t/14-bus_list_devices_if.t0000644000175000017500000000342112304114657017437 0ustar gwadejgwadej#!perl -T use lib "t"; use TestTools; use Test::More tests => 10; use Device::USB; use strict; use warnings; my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); my $bus = ($usb->list_busses())[0]; SKIP: { skip "No installed USB buses", 9 unless defined $bus; can_ok( $bus, "list_devices_if" ); eval { $bus->list_devices_if() }; like( $@, qr/Missing predicate/, "Requires a predicate." ); eval { $bus->list_devices_if( 1 ) }; like( $@, qr/Predicate must be/, "Requires a code reference." ); my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); my ($found_bus, $found_device) = TestTools::find_an_installed_device_and_bus( 0, @{$busses} ); skip "No installed USB devices", 5 unless defined $found_device; my $vendor = $found_device->idVendor(); my $product = $found_device->idProduct(); my @devices = $found_bus->list_devices_if( sub { $_->idVendor() == $vendor && $_->idProduct() == $product } ); my $device_count = @devices; ok( 0 < $device_count, "At least one device found" ); my $matches = grep { $_->idVendor() == $vendor && $_->idProduct() == $product } @devices; is( $matches, $device_count, "All match vendor and product" ); my @vendor_devices = $found_bus->list_devices_if( sub { $_->idVendor() == $vendor } ); my $vdevice_count = @vendor_devices; ok( $device_count <= $vdevice_count, "At least one device found" ); $matches = grep { $_->idVendor() == $vendor } @vendor_devices; is( $matches, $vdevice_count, "All match vendor" ); my @all_devices = $found_bus->list_devices_if( sub { defined } ); my $all_count = @all_devices; ok( $vdevice_count <= $all_count, "At least one device found" ); } Device-USB-0.38/t/10-usb-device-accessors.t0000644000175000017500000000365112304115242017434 0ustar gwadejgwadej#!perl -T use Test::More; use Device::USB; use strict; use warnings; use constant TESTS_PER_DEVICE => 14; my $usb = Device::USB->new(); if(defined $usb) { my @devices = $usb->list_devices(); plan tests => 2 + TESTS_PER_DEVICE * scalar @devices; } else { fail( "Unable to create USB object." ); } my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); can_ok( "Device::USB::Device", qw/filename configurations get_configuration bcdUSB bDeviceClass bDeviceSubClass bDeviceProtocol bMaxPacketSize0 idVendor idProduct bcdDevice iManufacturer iProduct iSerialNumber bNumConfigurations/ ); foreach my $bus (@{$busses}) { foreach my $dev (@{$bus->devices()}) { isa_ok( $dev, "Device::USB::Device" ); my $filename = $dev->filename(); my $regex = ($^O !~ /win/i) ? qr/^(?:\d+|[0-9a-f-]+)$/ : qr/^[\\.]*[0-9a-z-]+$/; like( $filename, $regex, "Filename is a valid format" ); my $configs = $dev->configurations(); isa_ok( $configs, 'ARRAY' ); like( $dev->bcdUSB(), qr/^\d+\.\d+$/, "$filename: USB Version" ); like( $dev->bDeviceClass(), qr/^\d+$/, "$filename: device class" ); like( $dev->bDeviceSubClass(), qr/^\d+$/, "$filename: device subclass" ); like( $dev->bMaxPacketSize0(), qr/^\d+$/, "$filename: max packet size" ); like( $dev->idVendor(), qr/^\d+$/, "$filename: vendor id" ); like( $dev->idProduct(), qr/^\d+$/, "$filename: product id" ); like( $dev->bcdDevice(), qr/^\d+\.\d+$/, "$filename: Device version" ); like( $dev->iManufacturer(), qr/^\d+$/, "$filename: manufacturer index" ); like( $dev->iProduct(), qr/^\d+$/, "$filename: product index" ); like( $dev->iSerialNumber(), qr/^\d+$/, "$filename: serial number index" ); is( $dev->bNumConfigurations(), scalar(@{$configs}), "$filename: number of configurations matches" ); } } Device-USB-0.38/t/02-find_busses_devices.t0000644000175000017500000000065512304111574017437 0ustar gwadejgwadej#!perl -T use Test::More tests => 4; use Device::USB; use strict; use warnings; my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); can_ok( $usb, "find_busses", "find_devices" ); my $bus_changes = $usb->find_busses(); is( $usb->find_busses(), 0, "No bus changes since last call." ); my $device_changes = $usb->find_devices(); is( $usb->find_devices(), 0, "No device changes since last call." ); Device-USB-0.38/t/13-bus_find_device_if.t0000644000175000017500000000317712304114735017225 0ustar gwadejgwadej#!perl -T use lib "t"; use TestTools; use Test::More tests => 8; use Device::USB; use strict; use warnings; my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); my $bus = ($usb->list_busses())[0]; SKIP: { skip "No USB buses found.", 7 unless defined $bus; eval { $bus->find_device_if() }; like( $@, qr/Missing predicate/, "Requires a predicate." ); eval { $bus->find_device_if( 1 ) }; like( $@, qr/Predicate must be/, "Requires a code reference." ); my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); my ($found_bus, $found_device) = TestTools::find_an_installed_device_and_bus( 0, @{$busses} ); skip "No USB devices installed", 4 unless defined $found_device; my $vendor = $found_device->idVendor(); my $product = $found_device->idProduct(); my $dev = $found_bus->find_device_if( sub { $vendor == $_->idVendor() && $product == $_->idProduct() } ); ok( defined $dev, "Device found." ); is_deeply( $dev, $found_device, "first device matches" ); my $count = @{$busses}; skip "Only one USB device installed", 2 if $count < 2; ($found_bus, $found_device) = TestTools::find_an_installed_device_and_bus( 1, @{$busses} ); skip "No accessible device found", 2 unless defined $found_device; $vendor = $found_device->idVendor(); $product = $found_device->idProduct(); $dev = $found_bus->find_device_if( sub { $vendor == $_->idVendor() && $product == $_->idProduct() } ); ok( defined $dev, "Device found." ); is_deeply( $dev, $found_device, "second device matches" ); } Device-USB-0.38/t/09-usb-bus.t0000644000175000017500000000137112304115277015020 0ustar gwadejgwadej#!perl -T use Test::More qw(no_plan); ## no critic(ProhibitNoPlan) use Device::USB; use strict; use warnings; # # No plan, because the number of tests depends on the number of # busses and devices on the system. # my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); can_ok( "Device::USB::Bus", qw/dirname location devices/ ); foreach my $bus (@{$busses}) { isa_ok( $bus, "Device::USB::Bus" ); ok( defined $bus->dirname(), "Dirname returns a value" ); ok( defined $bus->location, "Location returns a value" ); my @devices = $bus->devices(); foreach my $dev (@devices) { isa_ok( $dev, "Device::USB::Device" ); } } Device-USB-0.38/t/05-find_device_if.t0000644000175000017500000000414212304111574016344 0ustar gwadejgwadej#!perl -T use lib "t"; use TestTools; use Test::More tests => 11; use Device::USB; use strict; use warnings; my $usb = Device::USB->new(); ok( defined $usb, "Object successfully created" ); can_ok( $usb, "find_device_if" ); ok( !defined $usb->find_device_if( sub { 0xFFFF == $_->idVendor() && 0xFFFF == $_->idProduct() } ), "No device found" ); eval { $usb->find_device_if() }; like( $@, qr/Missing predicate/, "Requires a predicate." ); eval { $usb->find_device_if( 1 ) }; like( $@, qr/Predicate must be/, "Requires a code reference." ); my $busses = $usb->list_busses(); ok( defined $busses, "USB busses found" ); my $found_device = TestTools::find_an_installed_device( 0, @{$busses} ); SKIP: { skip "No USB devices installed", 5 unless defined $found_device; my $vendor = $found_device->idVendor(); my $product = $found_device->idProduct(); my $dev = $usb->find_device_if( sub { $vendor == $_->idVendor() && $product == $_->idProduct() } ); ok( defined $dev, "Device found." ); is_deeply( $dev, $found_device, "first device matches" ); my $count = @{$busses}; skip "Only one USB device installed", 3 if $count < 2; $found_device = undef; for(my $i = 1; $i < $count; ++$i) { my $dev = TestTools::find_an_installed_device( $i, @{$busses} ); next unless defined $dev; # New vendor/product combination if($vendor != $dev->idVendor() || $product != $dev->idProduct()) { $found_device = $dev; last; } } skip "No accessible device found", 3 unless defined $found_device; $vendor = $found_device->idVendor(); $product = $found_device->idProduct(); $dev = $usb->find_device_if( sub { $vendor == $_->idVendor() && $product == $_->idProduct() } ); ok( defined $dev, "Device found." ); is_deeply( $dev, $found_device, "second device matches" ); my $hub = $usb->find_device_if( sub { Device::USB::CLASS_HUB == $_->bDeviceClass() } ); ok( $hub && Device::USB::CLASS_HUB == $hub->bDeviceClass(), "Hub found." ); } Device-USB-0.38/t/16-usb_dev_interface.t0000644000175000017500000000361712304114533017104 0ustar gwadejgwadej#!perl -T use Test::More; use Device::USB; use strict; use warnings; use constant TESTS_PER_INTERFACE => 8; my $usb = Device::USB->new(); if(defined $usb) { my $interface_count = 0; foreach my $dev ($usb->list_devices()) { foreach my $config ($dev->configurations()) { $interface_count += scalar( map {@{$_}} $config->interfaces() ); } } if($interface_count) { plan tests => 2 + TESTS_PER_INTERFACE * $interface_count; } else { plan skip_all => 'No devices found.'; } } else { fail( "Unable to create USB object." ); } my @devices = $usb->list_devices(); isnt( scalar @devices, 0, "USB devices found" ); can_ok( "Device::USB::DevInterface", qw/bInterfaceNumber endpoints bNumEndpoints iInterface bInterfaceClass bInterfaceSubClass bInterfaceProtocol/ ); foreach my $dev (@devices) { my $filename = $dev->filename(); my $cfgno = 0; foreach my $cfg ($dev->configurations()) { foreach my $if (map { @{$_} } $cfg->interfaces()) { my $ifno = $if->bInterfaceNumber(); isa_ok( $if, "Device::USB::DevInterface" ); like( $if->bInterfaceNumber(), qr/^\d+$/, "$filename:$cfgno:$ifno: Interface Number" ); like( $if->bAlternateSetting(), qr/^\d+$/, "$filename:$cfgno:$ifno: Alternate Setting" ); is( $if->bNumEndpoints(), scalar @{$if->endpoints()}, "$filename:$cfgno:$ifno: endpoint count" ); like( $if->bInterfaceClass(), qr/^\d+$/, "$filename:$cfgno:$ifno: Interface Class" ); like( $if->bInterfaceSubClass(), qr/^\d+$/, "$filename:$cfgno:$ifno: Interface Sub Class" ); like( $if->bInterfaceProtocol(), qr/^\d+$/, "$filename:$cfgno:$ifno: Interface Protocol" ); like( $if->iInterface(), qr/^\d+$/, "$filename:$cfgno:$ifno: Interface string index" ); } ++$cfgno; } } Device-USB-0.38/t/11-usb-device-methods.t0000644000175000017500000000112412304111574017110 0ustar gwadejgwadej#!perl -T use Test::More tests => 2; use Device::USB; use strict; use warnings; # # Just testing the existence of methods at this point, not their # functionality. # # Synthetics can_ok( "Device::USB::Device", qw/DESTROY manufacturer product serial_number/ ); # libusb methods can_ok( "Device::USB::Device", qw/open set_configuration set_altinterface clear_halt reset claim_interface release_interface control_msg get_string get_string_simple get_descriptor get_descriptor_by_endpoint bulk_read interrupt_read bulk_write interrupt_write/ ); Device-USB-0.38/t/17-usb_dev_endpoint.t0000644000175000017500000000352512304114533016763 0ustar gwadejgwadej#!perl -T use Test::More; use Device::USB; use strict; use warnings; use constant TESTS_PER_ENDPOINT => 7; my $usb = Device::USB->new(); if(defined $usb) { my $endpoint_count = 0; foreach my $dev ($usb->list_devices()) { foreach my $config ($dev->configurations()) { my @interfaces = map {@{$_}} $config->interfaces(); $endpoint_count += $_->bNumEndpoints() foreach @interfaces; } } if($endpoint_count) { plan tests => 2 + TESTS_PER_ENDPOINT * $endpoint_count; } else { plan skip_all => 'No devices found.'; } } else { fail( "Unable to create USB object." ); } my @devices = $usb->list_devices(); isnt( scalar @devices, 0, "USB devices found" ); can_ok( "Device::USB::DevEndpoint", qw/bEndpointAddress bmAttributes wMaxPacketSize bInterval bRefresh bSynchAddress/ ); foreach my $dev (@devices) { my $filename = $dev->filename(); my $cfgno = 0; foreach my $cfg ($dev->configurations()) { foreach my $if (map { @{$_} } $cfg->interfaces()) { my $ifno = $if->bInterfaceNumber(); foreach my $ep ($if->endpoints()) { my $descr = "$filename:$cfgno:$ifno:".$ep->bEndpointAddress(); isa_ok( $ep, "Device::USB::DevEndpoint" ); like( $ep->bEndpointAddress(), qr/^\d+$/, "$descr: Endpoint Address" ); like( $ep->bmAttributes(), qr/^\d+$/, "$descr: Attributes" ); like( $ep->wMaxPacketSize(), qr/^\d+$/, "$descr: Max Packet Size" ); like( $ep->bInterval(), qr/^\d+$/, "$descr: Interval" ); like( $ep->bRefresh(), qr/^\d+$/, "$descr: Refresh" ); like( $ep->bSynchAddress(), qr/^\d+$/, "$descr: Synch Address" ); } } ++$cfgno; } } Device-USB-0.38/t/TestTools.pm0000644000175000017500000000330612304111574015317 0ustar gwadejgwadejpackage TestTools; # Library utility for testing # use strict; use warnings; # # Find a particular unique installed device. # # which - the number of the unique installed device. # 0 = first, 1 = second, etc. # busses - list of busses to check # # Ignore any device with the same vendor/product id pair. # Look only at the unique devices, or the first of non-unique devices. # sub find_an_installed_device { my $which = shift; my @uniqs = (); foreach my $bus (@_) { next unless @{$bus->devices()}; foreach my $dev ($bus->devices()) { my $vendor = $dev->idVendor(); my $product = $dev->idProduct(); next if grep { $_->[0] == $vendor and $_->[1] == $product } @uniqs; return $dev unless $which--; push @uniqs, [ $vendor, $product ]; } } return; } # # Find a particular unique installed device with its bus. # # which - the number of the unique installed device. # 0 = first, 1 = second, etc. # busses - list of busses to check # # Ignore any device with the same vendor/product id pair. # Look only at the unique devices, or the first of non-unique devices. # sub find_an_installed_device_and_bus { my $which = shift; my @uniqs = (); foreach my $bus (@_) { next unless @{$bus->devices()}; foreach my $dev ($bus->devices()) { my $vendor = $dev->idVendor(); my $product = $dev->idProduct(); next if grep { $_->[0] == $vendor and $_->[1] == $product } @uniqs; return ($bus, $dev) unless $which--; push @uniqs, [ $vendor, $product ]; } } return; } 1; Device-USB-0.38/MANIFEST0000644000175000017500000000153113510122743013705 0ustar gwadejgwadejChanges bin/dump_usb.pl lib/Device/USB.pm lib/Device/USB/Bus.pm lib/Device/USB/DevConfig.pm lib/Device/USB/DevEndpoint.pm lib/Device/USB/Device.pm lib/Device/USB/DevInterface.pm lib/Device/USB/FAQ.pod Makefile.PL MANIFEST MANIFEST.SKIP META.yml README t/00-load.t t/01-create-usb.t t/02-find_busses_devices.t t/03-list_busses.t t/04-find_device.t t/05-find_device_if.t t/06-list_devices.t t/07-list_devices_if.t t/08-get_busses.t t/09-usb-bus.t t/10-usb-device-accessors.t t/11-usb-device-methods.t t/12-constants.t t/13-bus_find_device_if.t t/14-bus_list_devices_if.t t/15-usb_dev_configuration.t t/16-usb_dev_interface.t t/17-usb_dev_endpoint.t t/18-usb_device-configurations.t t/TestTools.pm xt/boilerplate.t xt/critic.t xt/hasversion.t xt/podcoverage.t xt/pod.t USB.pm META.json Module JSON meta-data (added by MakeMaker) Device-USB-0.38/lib/0000755000175000017500000000000013510122743013322 5ustar gwadejgwadejDevice-USB-0.38/lib/Device/0000755000175000017500000000000013510122743014521 5ustar gwadejgwadejDevice-USB-0.38/lib/Device/USB/0000755000175000017500000000000013510122743015152 5ustar gwadejgwadejDevice-USB-0.38/lib/Device/USB/Bus.pm0000644000175000017500000001063313510122446016244 0ustar gwadejgwadejpackage Device::USB::Bus; require 5.006; use warnings; use strict; use Carp; =encoding utf8 =head1 NAME Device::USB::Bus - Use libusb to access USB devices. =head1 VERSION Version 0.38 =cut our $VERSION=0.38; =head1 SYNOPSIS This class encapsulates the USB bus structure and provides methods for retrieving data from it. This class is not meant to be used alone, it is part of the Device::USB package. Device:USB:LibUSB provides a Perl wrapper around the libusb library. This supports Perl code controlling and accessing USB devices. use Device::USB; my $usb = Device::USB->new(); foreach my $bus ($usb->list_busses()) { print $bus->dirname(), ":\n"; foreach my $dev ($bus->devices()) { print "\t", $dev->filename(), "\n"; } } =head1 DESCRIPTION This module provides a Perl interface to the bus structures returned by the libusb library. This library supports a read-only interface to the data libusb returns about a USB bus. =head1 FUNCTIONS =over 4 =item dirname Return the directory name associated with this bus. =cut sub dirname { my $self = shift; return $self->{dirname}; } =item location Return the location value associated with this bus. =cut sub location { my $self = shift; return $self->{location}; } =item devices In array context, it returns a list of Device::USB::Device objects representing all of the devices on this bus. In scalar context, it returns a reference to that array. =cut sub devices { my $self = shift; return wantarray ? @{$self->{devices}} : $self->{devices}; } =item find_device_if Find a particular USB device based on the supplied predicate coderef. If more than one device would satisfy the predicate, the first one found is returned. =over 4 =item pred the predicate used to select a device =back returns a device reference or undef if none was found. =cut sub find_device_if { my $self = shift; my $pred = shift; croak( "Missing predicate for choosing a device.\n" ) unless defined $pred; croak( "Predicate must be a code reference.\n" ) unless 'CODE' eq ref $pred; local $_ = undef; foreach($self->devices()) { return $_ if $pred->(); } return; } =item list_devices_if This method provides a flexible interface for finding devices. It takes a single coderef parameter that is used to test each discovered device. If the coderef returns a true value, the device is returned in the list of matching devices, otherwise it is not. =over 4 =item pred coderef to test devices. =back For example, my @devices = $bus->list_devices_if( sub { Device::USB::CLASS_HUB == $_->bDeviceClass() } ); Returns all USB hubs found on this bus. The device to test is available to the coderef in the C<$_> variable for simplicity. =cut sub list_devices_if { my $self = shift; my $pred = shift; croak( "Missing predicate for choosing devices.\n" ) unless defined $pred; croak( "Predicate must be a code reference.\n" ) unless 'CODE' eq ref $pred; local $_ = undef; my @devices = grep { $pred->() } $self->devices(); return wantarray ? @devices : \@devices; } =back =head1 DIAGNOSTICS This is an explanation of the diagnostic and error messages this module can generate. =head1 DEPENDENCIES This module depends on the Carp and Device::USB, as well as the strict and warnings pragmas. Obviously, libusb must be available since that is the entire reason for the module's existence. =head1 AUTHOR G. Wade Johnson (gwadej at cpan dot org) Paul Archer (paul at paularcher dot org) Houston Perl Mongers Group =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS Thanks go to various members of the Houston Perl Mongers group for input on the module. But thanks mostly go to Paul Archer who proposed the project and helped with the development. Thanks also go to Josep Monés Teixidor, Mike McCauley, and Tony Awtrey for spotting, reporting, and (sometimes) fixing bugs. =head1 COPYRIGHT & LICENSE Copyright 2006-2013 Houston Perl Mongers This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Device-USB-0.38/lib/Device/USB/DevInterface.pm0000644000175000017500000001030113510122446020042 0ustar gwadejgwadejpackage Device::USB::DevInterface; require 5.006; use warnings; use strict; use Carp; =encoding utf8 =head1 Device::USB::DevInterface This class encapsulates a USB Device Interface and the methods that object would support. =head1 NAME Device::USB::DevInterface - Access a device interface returned by libusb. =head1 VERSION Version 0.38 =cut our $VERSION=0.38; =head1 SYNOPSIS Device::USB:DevInterface provides a Perl object for accessing an interface of a configuration of a USB device using the libusb library. use Device::USB; my $usb = Device::USB->new(); my $dev = $usb->find_device( $VENDOR, $PRODUCT ); printf "Device: %04X:%04X\n", $dev->idVendor(), $dev->idProduct(); $dev->open(); my $cfg = $dev->config()->[0]; my $inter = $cfg->interfaces()->[0]; print "Interface:", $inter->bInterfaceNumber(), " name: ", $dev->get_string_simple($iter->iInterface()), ": endpoint count: ", $inter->nNumEndpoints(), "\n"; See USB specification for an explanation of the attributes of an interface. =head1 DESCRIPTION This module defines a Perl object that represents the data associated with a USB device configuration's interface. The object provides read-only access to the important data associated with the interface. =head2 METHODS There are several accessor methods that return data from the interface. Each is named after the field that they return. These accessors include: =cut # I need to build a lot of accessors sub _make_descr_accessor { my $name = shift; ## no critic (ProhibitStringyEval) return eval <<"EOE"; sub $name { my \$self = shift; return \$self->{$name}; } EOE } =over 4 =item bInterfaceNumber The 0-based number of this interface. =item bAlternateSetting Value used to select this alternate setting for the interface specified in bInterfaceNumber. =item bNumEndpoints Number of endpoints (excluding endpoint 0) available on this interface. If the value is 0, only the control interface is supported. =item bInterfaceClass Class code as specified by the USB-IF. A value of 0xff is a vendor-specific interface class. =item bInterfaceSubClass Subclass code specified by the USB-IF. If bInterfaceClass is not 0xff, this field must use only subclasses specified by the USB-IF. =item bInterfaceProtocol The InterfaceProtocol as specified by the USB-IF. A value of 0xff uses a vendor-specific protocol. =item iInterface Returns the index of the string descriptor describing this interface. The string can be retrieved using the method C. =cut _make_descr_accessor( 'bInterfaceNumber' ); _make_descr_accessor( 'bAlternateSetting' ); _make_descr_accessor( 'bNumEndpoints' ); _make_descr_accessor( 'bInterfaceClass' ); _make_descr_accessor( 'bInterfaceSubClass' ); _make_descr_accessor( 'bInterfaceProtocol' ); _make_descr_accessor( 'iInterface' ); =item endpoints Returns a list of endpoint objects associated with this interface. =cut sub endpoints { my $self = shift; return wantarray ? @{$self->{endpoints}} : $self->{endpoints}; } =back =head1 DIAGNOSTICS This is an explanation of the diagnostic and error messages this module can generate. =head1 DEPENDENCIES This module depends on the Carp, Inline and Inline::C modules, as well as the strict and warnings pragmas. Obviously, libusb must be available since that is the entire reason for the module's existence. =head1 AUTHOR G. Wade Johnson (gwadej at cpan dot org) Paul Archer (paul at paularcher dot org) Houston Perl Mongers Group =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS Thanks go to various members of the Houston Perl Mongers group for input on the module. But thanks mostly go to Paul Archer who proposed the project and helped with the development. =head1 COPYRIGHT & LICENSE Copyright 2006-2013 Houston Perl Mongers This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Device-USB-0.38/lib/Device/USB/Device.pm0000644000175000017500000004246713510122447016725 0ustar gwadejgwadejpackage Device::USB::Device; require 5.006; use warnings; use strict; use Carp; use constant MAX_BUFFER_SIZE => 256; =encoding utf8 =head1 Device::USB::Device This class encapsulates the USB device structure and the methods that may be applied to it. =head1 NAME Device::USB::Device - Use libusb to access USB devices. =head1 VERSION Version 0.38 =cut our $VERSION=0.38; =head1 SYNOPSIS Device:USB::Device provides a Perl object for accessing a USB device using the libusb library. use Device::USB; my $usb = Device::USB->new(); my $dev = $usb->find_device( $VENDOR, $PRODUCT ); printf "Device: %04X:%04X\n", $dev->idVendor(), $dev->idProduct(); print "Manufactured by ", $dev->manufacturer(), "\n", " Product: ", $dev->product(), "\n"; $dev->set_configuration( $CFG ); $dev->control_msg( @params ); ... See the libusb manual for more information about most of the methods. The functionality is generally the same as the libusb function whose name is the method name prepended with "usb_". =head1 DESCRIPTION This module defines a Perl object that represents the data and functionality associated with a USB device. The object interface provides read-only access to the important data associated with a device. It also provides methods for almost all of the functions supplied by libusb. Where necessary, the interfaces to these methods were changed to better match Perl usage. However, most of the methods are straight-forward wrappers around their libusb counterparts. =head2 METHODS =over 4 =item DESTROY Close the device connected to the object. =cut sub DESTROY { my $self = shift; Device::USB::libusb_close( $self->{handle} ) if $self->{handle}; return; } # Make certain the device is open. sub _assert_open { my $self = shift; if(!defined $self->{handle}) { $self->open() or croak "Cannot open device: $!\n"; } return; } # I need to build a lot of accessors sub _make_descr_accessor { my $name = shift; ## no critic (ProhibitStringyEval) return eval <<"EOE"; sub $name { my \$self = shift; return \$self->{descriptor}->{$name}; } EOE } =item filename Retrieve the filename associated with the device. =cut sub filename { my $self = shift; return $self->{filename}; } =item config In list context, return a list of the configuration structures for this device. In scalar context, return a reference to that list. This method is deprecated in favor of the two new methods: configurations and get_configuration. =cut sub config { my $self = shift; return wantarray ? @{$self->{config}} : $self->{config}; } =item configurations In list context, return a list of the configuration structures for this device. In scalar context, return a reference to that list. =cut sub configurations { my $self = shift; return wantarray ? @{$self->{config}} : $self->{config}; } =item get_configuration Retrieve the configuration requested by index. The legal values are from 0 to bNumConfigurations() - 1. Negative values access from the back of the list of configurations. =over 4 =item index numeric index of the index to return. If not supplied, use 0. =back Returns an object encapsulating the configuration on success, or C on failure. =cut sub get_configuration { my $self = shift; my $index = shift || 0; return $self->configurations()->[$index]; } =item accessors There a several accessor methods that return data from the device and device descriptor. Each is named after the field that they return. All of the BCD fields have been changed to floating point numbers, so that you don't have to decode them yourself. The methods include: =over 4 =item bcdUSB =item bDeviceClass =item bDeviceSubClass =item bDeviceProtocol =item bMaxPacketSize0 =item idVendor =item idProduct =item bcdDevice =item iManufacturer =item iProduct =item iSerialNumber =item bNumConfigurations =back =cut _make_descr_accessor( 'bcdUSB' ); _make_descr_accessor( 'bDeviceClass' ); _make_descr_accessor( 'bDeviceSubClass' ); _make_descr_accessor( 'bDeviceProtocol' ); _make_descr_accessor( 'bMaxPacketSize0' ); _make_descr_accessor( 'idVendor' ); _make_descr_accessor( 'idProduct' ); _make_descr_accessor( 'bcdDevice' ); _make_descr_accessor( 'iManufacturer' ); _make_descr_accessor( 'iProduct' ); _make_descr_accessor( 'iSerialNumber' ); _make_descr_accessor( 'bNumConfigurations' ); =item manufacturer Retrieve the manufacture name from the device as a string. Return undef if the device read fails. =cut sub manufacturer { my $self = shift; return $self->get_string_simple( $self->iManufacturer() ); } =item product Retrieve the product name from the device as a string. Return undef if the device read fails. =cut sub product { my $self = shift; return $self->get_string_simple( $self->iProduct() ); } =item serial_number Retrieve the serial number from the device as a string. Return undef if the device read fails. =cut sub serial_number { my $self = shift; return $self->get_string_simple( $self->iSerialNumber() ); } =item open Open the device. If the device is already open, close it and reopen it. If the device fails to open, the reason will be available in $!. =cut sub open ## no critic (ProhibitBuiltinHomonyms) { my $self = shift; Device::USB::libusb_close( $self->{handle} ) if $self->{handle}; local $! = 0; $self->{handle} = Device::USB::libusb_open( $self->{device} ); return 0 == $!; } =item set_configuration Sets the active configuration of the device. =over 4 =item configuration the integer specified in the descriptor field bConfigurationValue. =back returns 0 on success or <0 on error When using libusb-win32 under Windows, it is important to call C after the C but before any other method calls. Without this call, other methods may not work. This call is not required under Linux. =cut sub set_configuration { my $self = shift; my $configuration = shift; $self->_assert_open(); return Device::USB::libusb_set_configuration( $self->{handle}, $configuration ); } =item set_altinterface Sets the active alternative setting of the current interface for the device. =over 4 =item alternate the integer specified in the descriptor field bAlternateSetting. =back returns 0 on success or <0 on error =cut sub set_altinterface { my $self = shift; my $alternate = shift; $self->_assert_open(); return Device::USB::libusb_set_altinterface( $self->{handle}, $alternate ); } =item clear_halt Clears any halt status on the supplied endpoint. =over 4 =item alternate the integer specified bEndpointAddress descriptor field. =back returns 0 on success or <0 on error =cut sub clear_halt { my $self = shift; my $ep = shift; $self->_assert_open(); return Device::USB::libusb_clear_halt( $self->{handle}, $ep ); } =item reset Resets the device. This also closes the handle and invalidates this device. This device will be unusable. =cut sub reset ## no critic (ProhibitBuiltinHomonyms) { my $self = shift; return 0 unless defined $self->{handle}; my $ret = Device::USB::libusb_reset( $self->{handle} ); delete $self->{handle} unless $ret; return $ret; } =item claim_interface Claims the specified interface with the operating system. =over 4 =item interface The interface value listed in the descriptor field bInterfaceNumber. =back Returns 0 on success, <0 on failure. =cut sub claim_interface { my $self = shift; my $interface = shift; $self->_assert_open(); return Device::USB::libusb_claim_interface( $self->{handle}, $interface ); } =item release_interface Releases the specified interface back to the operating system. =over 4 =item interface The interface value listed in the descriptor field bInterfaceNumber. =back Returns 0 on success, <0 on failure. =cut sub release_interface { my $self = shift; my $interface = shift; $self->_assert_open(); return Device::USB::libusb_release_interface( $self->{handle}, $interface ); } =item control_msg Performs a control request to the default control pipe on a device. =over 4 =item requesttype =item request =item value =item index =item bytes Any returned data is placed here. If you don't want any returned data, pass undef. =item size Size of supplied buffer. =item timeout Milliseconds to wait for response. =back Returns number of bytes read or written on success, <0 on failure. =cut sub control_msg { my $self = shift; ## no critic (RequireArgUnpacking) my ($requesttype, $request, $value, $index, $bytes, $size, $timeout) = @_; $bytes = q{} unless defined $bytes; $self->_assert_open(); my ($retval, $out) = Device::USB::libusb_control_msg( $self->{handle}, $requesttype, $request, $value, $index, $bytes, $size, $timeout ); # replace the input string in $bytes. $_[4] = $out if defined $_[4]; return $retval; } =item get_string Retrieve a string descriptor from the device. =over 4 =item index The index of the string in the string list. =item langid The language id used to specify which of the supported languages the string should be encoded in. =back Returns a Unicode string. The function returns undef on error. =cut sub get_string { my $self = shift; my $index = shift; my $langid = shift; $self->_assert_open(); my $buf = "\0" x MAX_BUFFER_SIZE; my $retlen = Device::USB::libusb_get_string( $self->{handle}, $index, $langid, $buf, MAX_BUFFER_SIZE ); return if $retlen < 0; return substr( $buf, 0, $retlen ); } =item get_string_simple Retrieve a string descriptor from the device. =over 4 =item index The index of the string in the string list. =back Returns a C-style string if successful, or undef on error. =cut sub get_string_simple { my $self = shift; my $index = shift; $self->_assert_open(); my $buf = "\0" x MAX_BUFFER_SIZE; my $retlen = Device::USB::libusb_get_string_simple( $self->{handle}, $index, $buf, MAX_BUFFER_SIZE ); return if $retlen < 0; return substr( $buf, 0, $retlen ); } =item get_descriptor Retrieve a descriptor from the device =over 4 =item type The type of descriptor to retrieve. =item index The index of that descriptor in the list of descriptors of that type. =back TODO: This method needs major rewrite to be Perl-ish. I need to provide a better way to specify the type (or at least document which are available), and I need to return a Perl data structure, not a buffer of binary data. =cut sub get_descriptor { my $self = shift; my $type = shift; my $index = shift; $self->_assert_open(); my $buf = "\0" x MAX_BUFFER_SIZE; my $retlen = Device::USB::libusb_get_descriptor( $self->{handle}, $type, $index, $buf, MAX_BUFFER_SIZE ); return if $retlen < 0; return substr( $buf, 0, $retlen ); } =item get_descriptor_by_endpoint Retrieve an endpoint-specific descriptor from the device =over 4 =item ep Endpoint to query. =item type The type of descriptor to retrieve. =item index The index of that descriptor in the list of descriptors. =item buf Buffer into which to write the requested descriptor =item size Max size to read into the buffer. =back TODO: This method needs major rewrite to be Perl-ish. I need to provide a better way to specify the type (or at least document which are available), and I need to return a Perl data structure, not a buffer of binary data. =cut sub get_descriptor_by_endpoint { my $self = shift; my $ep = shift; my $type = shift; my $index = shift; $self->_assert_open(); my $buf = "\0" x MAX_BUFFER_SIZE; my $retlen = Device::USB::libusb_get_descriptor_by_endpoint( $self->{handle}, $ep, $type, $index, $buf, MAX_BUFFER_SIZE ); return if $retlen < 0; return substr( $buf, 0, $retlen ); } =item bulk_read Perform a bulk read request from the specified endpoint. =over 4 =item ep The number of the endpoint to read =item bytes Buffer into which to write the requested data. =item size Max size to read into the buffer. =item timeout Maximum time to wait (in milliseconds) =back The function returns the number of bytes returned or <0 on error. USB is packet based, not stream based. So using C to read part of the packet acts like a I. The next time you read, all of the packet is still there. The data is only removed when you read the entire packet. For this reason, you should always call C with the total packet size. =cut sub bulk_read { my $self = shift; # Don't change to shifts, I need to write back to $bytes. my ($ep, $bytes, $size, $timeout) = @_; $bytes = q{} unless defined $bytes; $self->_assert_open(); if(length $bytes < $size) { $bytes .= "\0" x ($size - length $bytes); } my $retlen = Device::USB::libusb_bulk_read( $self->{handle}, $ep, $bytes, $size, $timeout ); # stick back in the bytes parameter. $_[1] = substr( $bytes, 0, $retlen ); return $retlen; } =item interrupt_read Perform a interrupt read request from the specified endpoint. =over 4 =item ep The number of the endpoint to read =item bytes Buffer into which to write the requested data. =item size Max size to read into the buffer. =item timeout Maximum time to wait (in milliseconds) =back The function returns the number of bytes returned or <0 on error. =cut sub interrupt_read { my $self = shift; # Don't change to shifts, I need to write back to $bytes. my ($ep, $bytes, $size, $timeout) = @_; $bytes = q{} unless defined $bytes; $self->_assert_open(); if(length $bytes < $size) { $bytes .= "\0" x ($size - length $bytes); } my $retlen = Device::USB::libusb_interrupt_read( $self->{handle}, $ep, $bytes, $size, $timeout ); # stick back in the bytes parameter. $_[1] = substr( $bytes, 0, $retlen ); return $retlen; } =item bulk_write Perform a bulk write request to the specified endpoint. =over 4 =item ep The number of the endpoint to write =item bytes Buffer from which to write the requested data. =item timeout Maximum time to wait (in milliseconds) =back The function returns the number of bytes written or <0 on error. =cut sub bulk_write { my $self = shift; my $ep = shift; my $bytes = shift; my $timeout = shift; $self->_assert_open(); return Device::USB::libusb_bulk_write( $self->{handle}, $ep, $bytes, length $bytes, $timeout ); } =item interrupt_write Perform a interrupt write request to the specified endpoint. =over 4 =item ep The number of the endpoint to write =item bytes Buffer from which to write the requested data. =item timeout Maximum time to wait (in milliseconds) =back The function returns the number of bytes written or <0 on error. =cut sub interrupt_write { my $self = shift; my $ep = shift; my $bytes = shift; my $timeout = shift; $self->_assert_open(); return Device::USB::libusb_interrupt_write( $self->{handle}, $ep, $bytes, length $bytes, $timeout ); } =item get_driver_np This function returns the name of the driver bound to the interface specified by the parameter interface. =over 4 =item $interface The interface number of interest. =back Returns C on error. =cut sub get_driver_np { my $self = shift; my $interface = shift; my $name = shift; $self->_assert_open(); my $buf = "\0" x MAX_BUFFER_SIZE; my $retlen = Device::USB::libusb_get_driver_np( $self->{handle}, $interface, $buf, MAX_BUFFER_SIZE ); return if $retlen < 0; return substr( $buf, 0, $retlen ); } =item detach_kernel_driver_np This function will detach a kernel driver from the interface specified by parameter interface. Applications using libusb can then try claiming the interface. Returns 0 on success or < 0 on error. =cut sub detach_kernel_driver_np { my $self = shift; my $interface = shift; $self->_assert_open(); return Device::USB::libusb_detach_kernel_driver_np( $self->{handle}, $interface ); } =back =head1 DIAGNOSTICS This is an explanation of the diagnostic and error messages this module can generate. =over 4 =item Cannot open device: I Unable to open the USB device for the reason given. =back =head1 DEPENDENCIES This module depends on the Carp, Inline and Inline::C modules, as well as the strict and warnings pragmas. Obviously, libusb must be available since that is the entire reason for the module's existence. =head1 AUTHOR G. Wade Johnson (gwadej at cpan dot org) Paul Archer (paul at paularcher dot org) Houston Perl Mongers Group =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS Thanks go to various members of the Houston Perl Mongers group for input on the module. But thanks mostly go to Paul Archer who proposed the project and helped with the development. =head1 COPYRIGHT & LICENSE Copyright 2006-2013 Houston Perl Mongers This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Device-USB-0.38/lib/Device/USB/FAQ.pod0000644000175000017500000001050212473355463016301 0ustar gwadejgwadej=encoding utf8 =head1 NAME Device::USB::FAQ - Frequently Asked Questions for Device::USB =head1 SYNOPSIS perldoc Device::USB::FAQ =head1 DESCRIPTION This is an attempt to answer some of the frequently asked questions about the Device::USB module =head1 QUESTIONS =head2 Which platforms does Device::USB support? C supports any platform that C supports. This list currently includes Linux, FreeBSD, NetBSD, OpenBSD, Darwin, and MacOS X. There is a port of the C library to the Windows environment called C. Because I don't have a development environment for testing this library, C does not yet support this library. =head2 Do I have to use Device::USB as root? By default, access to the USB devices on a Unix-based system appear to be limited to the root account. This usually causes access to most of the C features to fail with a permission error. Using the C module as root avoids this feature, but is not very satisfying from a security standpoint. (See the next question for more options.) =head2 How do I enable use of Device::USB as a non-root user? Some of the attributes of USB devices are available to non-root users, but accessing many of the more interesting features require special privileges. According to the libusb source, the C function requires either device nodes to be present or the usbfs file system to be mounted in specific locations. Those places in order are: =over 4 =item 1) F - pre-2.6.11: via devfs / post-2.6.11: via udev =item 2) F - usbfs =back Look in both locations on your system for which of these two methods your libusb will use. No matter which method your system uses, you will probably want to create a separate group to control access. Run this command to add a system group: addgroup --system usb or groupadd --system usb You can then add users to that group to allow access to your usb devices. =head3 DEVFS / HOTPLUG TODO =head3 UDEV If you use Debian/Ubuntu, look in the F file. If you want to allow global access to all usb devices, make this change: Change this: SUBSYSTEM=="usb_device", MODE="0664" To this: SUBSYSTEM=="usb_device", MODE="0664", GROUP="usb" After you reboot, all usb devices will inherit the mode and group specified. If you want to only change permissions for certain devices, you can add this on one line and adjust the product and vendor IDs: SUBSYSTEM=="usb_device", GROUP="usb", \ SYSFS{idVendor}=="1234", SYSFS{idProduct}=="1234" =head3 USBFS The usbfs defaults to root as the user and group. This can be changed in the F by adding the following on one line: none /proc/bus/usb usbfs noauto,\ listuid=0,listgid=118,listmode=0664,\ busuid=0,busgid=118,busmode=0775,\ devuid=0,devgid=118,devmode=0664\ 0 0 The value C<118> in the above should be replaced with the group id of your usb group (created above). The list* values are to allow listing devices, the bus* is to control access to the bus directories and the dev* values control access to the device files. This approach does not allow the kind of granular permission that the udev approach gives, so it is all or nothing unless permissions are changed programmatically. If your F file already has a line for F, add the options above to the line that is already there rather than adding the new line. For example, you would change usbfs /proc/bus/usb usbfs noauto 0 0 to usbfs /proc/bus/usb usbfs noauto,\ listuid=0,listgid=118,listmode=0664,\ busuid=0,busgid=118,busmode=0775,\ devuid=0,devgid=118,devmode=0664\ 0 0 Once again, this needs to be all on one line with the C<\> characters removed. =head1 SEE ALSO Device::USB and the C library site at L. =head1 AUTHOR G. Wade Johnson (gwadej at cpan dot org) Paul Archer (paul at paularcher dot org) Houston Perl Mongers Group =head1 ACKNOWLEDGEMENTS Thanks go to various users who submitted questions and answers for the list. In particular, Anthony L. Awtrey who contributed the first FAQ answer. =head1 COPYRIGHT & LICENSE Copyright 2006-2013 Houston Perl Mongers This document is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Device-USB-0.38/lib/Device/USB/DevConfig.pm0000644000175000017500000000775613510122447017374 0ustar gwadejgwadejpackage Device::USB::DevConfig; require 5.006; use warnings; use strict; use Carp; =encoding utf8 =head1 Device::USB::DevConfig This class encapsulates a USB Device Configuration and the methods that object would support. =head1 NAME Device::USB::DevConfig - Access the device configuration returned by libusb. =head1 VERSION Version 0.38 =cut our $VERSION=0.38; =head1 SYNOPSIS Device::USB:DevConfig provides a Perl object for accessing a configuration of a USB device using the libusb library. use Device::USB; my $usb = Device::USB->new(); my $dev = $usb->find_device( $VENDOR, $PRODUCT ); printf "Device: %04X:%04X\n", $dev->idVendor(), $dev->idProduct(); $dev->open(); my $cfg = $dev->config()->[0]; print "Config:", $cfg->iConfiguration(), ": interface count: ", $cfg->nNumInterfaces(), "\n"; See USB specification for an explanation of the attributes of a configuration. =head1 DESCRIPTION This module defines a Perl object that represents the data associated with a USB device's configuration. The object provides read-only access to the important data associated with the configuration. =head2 METHODS There are several accessor methods that return data from the configuration. Each is named after the field that they return. These accessors include: =cut # I need to build a lot of accessors sub _make_descr_accessor { my $name = shift; ## no critic (ProhibitStringyEval) return eval <<"EOE"; sub $name { my \$self = shift; return \$self->{$name}; } EOE } =over 4 =item wTotalLength Returns the total length of the data returned for this configuration. =item bNumInterfaces Returns the number of interfaces supported by this configuration. =item interfaces Returns a list of lists of interface objects associated with this configuration. Each of the inner lists is a set of alternate versions of that interface. =cut sub interfaces { my $self = shift; return wantarray ? @{$self->{interfaces}} : $self->{interfaces}; } =item bConfigurationValue Returns the value passed to SetConfiguration to select this configuration. =item iConfiguration Returns the index of the string descriptor describing this configuration. The string can be retrieved using the method C. =item bmAttributes Returns a bitmap listing the attributes. The bits a number starting with the LSB as 0. Bit 6 is 1 if the device is self-powered. Bit 5 is 1 if the device supports Remote Wakeup. =item MaxPower Returns the Maximum power consumption in mA. This value is not in units of 2mA as in the spec, but in actual mA. =back =cut _make_descr_accessor( 'wTotalLength' ); _make_descr_accessor( 'bNumInterfaces' ); _make_descr_accessor( 'bConfigurationValue' ); _make_descr_accessor( 'iConfiguration' ); _make_descr_accessor( 'bmAttributes' ); _make_descr_accessor( 'MaxPower' ); =head1 DIAGNOSTICS This is an explanation of the diagnostic and error messages this module can generate. =head1 DEPENDENCIES This module depends on the Carp, Inline and Inline::C modules, as well as the strict and warnings pragmas. Obviously, libusb must be available since that is the entire reason for the module's existence. =head1 AUTHOR G. Wade Johnson (gwadej at cpan dot org) Paul Archer (paul at paularcher dot org) Houston Perl Mongers Group =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS Thanks go to various members of the Houston Perl Mongers group for input on the module. But thanks mostly go to Paul Archer who proposed the project and helped with the development. =head1 COPYRIGHT & LICENSE Copyright 2006-2013 Houston Perl Mongers This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Device-USB-0.38/lib/Device/USB/DevEndpoint.pm0000644000175000017500000000617113510122447017735 0ustar gwadejgwadejpackage Device::USB::DevEndpoint; require 5.006; use warnings; use strict; use Carp; =encoding utf8 =head1 Device::USB::DevEndpoint This class encapsulates a USB Device endpoint and the methods that object would support. =head1 NAME Device::USB::DevEndpoint - Access a device endpoint returned by libusb. =head1 VERSION Version 0.38 =cut our $VERSION=0.38; =head1 SYNOPSIS Device::USB:DevEndpoint provides a Perl object for accessing an endpoint of an interface of a USB device using the libusb library. use Device::USB; my $usb = Device::USB->new(); my $dev = $usb->find_device( $VENDOR, $PRODUCT ); printf "Device: %04X:%04X\n", $dev->idVendor(), $dev->idProduct(); $dev->open(); my $cfg = $dev->config()->[0]; my $inter = $cfg->interfaces()->[0]->[0]; my $ep = $inter->endpoints()->[0]; print "Endpoint:", $inter->bEndpointAddress(), " name: ", $dev->get_string_simple($iter->iInterface()), "\n"; See USB specification for an explanation of the attributes of an endpoint. =head1 DESCRIPTION This module defines a Perl object that represents the data associated with a USB interface endpoint. The object provides read-only access to the important data associated with the endpoint. =head2 METHODS There are several accessor methods that return data from the interface. Each is named after the field that they return. These accessors include: =cut # I need to build a lot of accessors sub _make_descr_accessor { my $name = shift; ## no critic (ProhibitStringyEval) return eval <<"EOE"; sub $name { my \$self = shift; return \$self->{$name}; } EOE } =over 4 =item bEndpointAddress =item bmAttributes =item wMaxPacketSize =item bInterval =item bRefresh =item bSynchAddress =cut _make_descr_accessor( 'bEndpointAddress' ); _make_descr_accessor( 'bmAttributes' ); _make_descr_accessor( 'wMaxPacketSize' ); _make_descr_accessor( 'bInterval' ); _make_descr_accessor( 'bRefresh' ); _make_descr_accessor( 'bSynchAddress' ); =back =head1 DIAGNOSTICS This is an explanation of the diagnostic and error messages this module can generate. =head1 DEPENDENCIES This module depends on the Carp, Inline and Inline::C modules, as well as the strict and warnings pragmas. Obviously, libusb must be available since that is the entire reason for the module's existence. =head1 AUTHOR G. Wade Johnson (gwadej at cpan dot org) Paul Archer (paul at paularcher dot org) Houston Perl Mongers Group =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS Thanks go to various members of the Houston Perl Mongers group for input on the module. But thanks mostly go to Paul Archer who proposed the project and helped with the development. =head1 COPYRIGHT & LICENSE Copyright 2006-2013 Houston Perl Mongers This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Device-USB-0.38/lib/Device/USB.pm0000644000175000017500000007023713510122447015522 0ustar gwadejgwadejpackage Device::USB; require 5.006; use warnings; use strict; use Carp; use Inline ( C => "DATA", ($ENV{LIBUSB_LIBDIR} ? ( LIBS => "-L\"$ENV{LIBUSB_LIBDIR}\" " . ($^O eq 'MSWin32' ? ' -llibusb -L\"$ENV{WINDDK}\\lib\\crt\\i386\" -lmsvcrt ' : '-lusb') ) : ( LIBS => '-lusb', ) ), ($ENV{LIBUSB_INCDIR} ? ( INC => "-I\"$ENV{LIBUSB_INCDIR}\"" ) : () ), NAME => 'Device::USB', VERSION => '0.38', ); Inline->init(); # # Now the Perl code. # use Device::USB::Device; use Device::USB::DevConfig; use Device::USB::DevInterface; use Device::USB::DevEndpoint; use Device::USB::Bus; use constant CLASS_PER_INSTANCE => 0; use constant CLASS_AUDIO => 1; use constant CLASS_COMM => 2; use constant CLASS_HID => 3; use constant CLASS_PRINTER => 7; use constant CLASS_MASS_STORAGE => 8; use constant CLASS_HUB => 9; use constant CLASS_DATA => 10; use constant CLASS_VENDOR_SPEC => 0xff; =encoding utf8 =head1 NAME Device::USB - Use libusb to access USB devices. (DEPRECATED) =head1 VERSION Version 0.38 =cut our $VERSION=0.38; =head1 SYNOPSIS Device::USB has now been superceded by L, which supports the v1.0 libusb API. Device::USB provides a Perl wrapper around the libusb library. This supports Perl code controlling and accessing USB devices. use Device::USB; my $usb = Device::USB->new(); my $dev = $usb->find_device( $VENDOR, $PRODUCT ); printf "Device: %04X:%04X\n", $dev->idVendor(), $dev->idProduct(); $dev->open(); print "Manufactured by ", $dev->manufacturer(), "\n", " Product: ", $dev->product(), "\n"; $dev->set_configuration( $CFG ); $dev->control_msg( @params ); ... See the libusb manual for more information about most of the methods. The functionality is generally the same as the libusb function whose name is the method name prepended with "usb_". =head1 DESCRIPTION This module is deprecated as of version 0.38. I have not had the time or need to update the module, and no one has been willing to take it over. This module provides a Perl interface to the C library libusb. This library supports a relatively full set of functionality to access a USB device. In addition to the libusb functionality Device::USB provides a few convenience features that are intended to produce a more Perl-ish interface. These features include: =over 4 =item * Using the library initializes it, no need to call the underlying usb_init function. =item * Object interface reduces namespace pollution and provides a better interface to the library. =item * The find_device method finds the device associated with a vendor id and product id and creates an appropriate Device::USB::Device object to manipulate the USB device. =item * Object interfaces to the bus and device data structures allowing read access to information about each. =back =head1 Device::USB This class provides an interface to the non-bus and non-device specific functions of the libusb library. In particular, it provides interfaces to find busses and devices. It also provides convenience methods that simplify some of the tasks above. =head2 CONSTANTS This class provides a set of constants for the defined device classes. The constants defined at this time are: =over 4 =item * CLASS_PER_INSTANCE =item * CLASS_AUDIO =item * CLASS_COMM =item * CLASS_HID =item * CLASS_PRINTER =item * CLASS_MASS_STORAGE =item * CLASS_HUB =item * CLASS_DATA =item * CLASS_VENDOR_SPEC =back =head2 FUNCTIONS =over 4 =cut # # Internal-only, one-time init function. my $init_ref; $init_ref = sub { libusb_init(); $init_ref = sub {}; }; =item new Create a new Device::USB object for accessing the library. =cut sub new { my $class = shift; $init_ref->(); return bless {}, $class; } =item debug_mode This class method enables low-level debugging messages from the library interface code. =over 4 =item level 0 disables debugging, 1 enables some debug messages, and 2 enables verbose debug messages Any other values are forced to the nearest endpoint. =back =cut sub debug_mode { my ($class, $level) = @_; lib_debug_mode( $level ); return; } =item find_busses Returns the number of changes since previous call to the function: the number of busses added or removed. =cut sub find_busses { my $self = shift; return libusb_find_busses(); } =item find_devices Returns the number of changes since previous call to the function: the number of devices added or removed. Should be called after find_busses. =cut sub find_devices { my $self = shift; return libusb_find_devices(); } =item find_device Find a particular USB device based on the vendor and product ids. If more than one device has the same product id from the same vendor, the first one found is returned. =over 4 =item vendor the vendor id =item product product id for that vendor =back returns a device reference or undef if none was found. =cut sub find_device { my $self = shift; my $vendor = shift; my $product = shift; return lib_find_usb_device( $vendor, $product ); } =item find_device_if Find a particular USB device based on the supplied predicate coderef. If more than one device would satisfy the predicate, the first one found is returned. =over 4 =item pred the predicate used to select a device =back returns a device reference or undef if none was found. =cut sub find_device_if { my $self = shift; my $pred = shift; croak( "Missing predicate for choosing a device.\n" ) unless defined $pred; croak( "Predicate must be a code reference.\n" ) unless 'CODE' eq ref $pred; foreach my $bus ($self->list_busses()) { my $dev = $bus->find_device_if( $pred ); return $dev if defined $dev; } return; } =item list_devices Find all devices matching a vendor id and optional product id. If called with no parameters, returns a list of all devices. If no product id is given, returns all devices found with the supplied vendor id. If a product id is given, returns all devices matching both the vendor id and product id. =over 4 =item vendor the optional vendor id =item product optional product id for that vendor =back returns a list of devices matching the supplied criteria or a reference to that array in scalar context =cut sub list_devices { my $self = shift; my $vendor = shift; my $product = shift; my $pred = undef; if(!defined $vendor) { $pred = sub { defined }; } elsif(!defined $product) { $pred = sub { $vendor == $_->idVendor() }; } else { $pred = sub { $vendor == $_->idVendor() && $product == $_->idProduct() }; } return $self->list_devices_if( $pred ); } =item list_devices_if This method provides a more flexible interface for finding devices. It takes a single coderef parameter that is used to test each discovered device. If the coderef returns a true value, the device is returned in the list of matching devices, otherwise it is not. =over 4 =item pred coderef to test devices. =back For example, my @devices = $usb->list_devices_if( sub { Device::USB::CLASS_HUB == $_->bDeviceClass() } ); Returns all USB hubs found. The device to test is available to the coderef in the C<$_> variable for simplicity. =cut sub list_devices_if { my $self = shift; my $pred = shift; croak( "Missing predicate for choosing devices.\n" ) unless defined $pred; croak( "Predicate must be a code reference.\n" ) unless 'CODE' eq ref $pred; my @devices = (); local $_ = undef; foreach my $bus ($self->list_busses()) { # Push all matching devices for this bus on list. push @devices, $bus->list_devices_if( $pred ); } return wantarray ? @devices : \@devices; } =item list_busses Return the complete list of information after finding busses and devices. By using this function, you do not need to do the find_* calls yourself. returns a reference to an array of busses. =cut sub list_busses { my $self = shift; my $busses = lib_list_busses(); return wantarray ? @{$busses} : $busses; } =item get_busses Return the complete list of information after finding busses and devices. Before calling this function, remember to call find_busses and find_devices. returns a reference to an array of busses. =cut sub get_busses { my $self = shift; my $busses = lib_get_usb_busses(); return wantarray ? @{$busses} : $busses; } =back =head1 LIBRARY INTERFACE The raw api of the libusb library is also : =over 4 =item DeviceUSBDebugLevel() =item libusb_init() =item libusb_find_busses() =item libusb_find_devices() =item libusb_get_busses() =item libusb_open(void *dev) =item libusb_close(void *dev) =item libusb_set_configuration(void *dev, int configuration) =item libusb_set_altinterface(void *dev, int alternate) =item libusb_clear_halt(void *dev, unsigned int ep) =item libusb_reset(void *dev) =item libusb_get_driver_np(void *dev, int interface, char *name, unsigned int namelen) =item libusb_detach_kernel_driver_np(void *dev, int interface) =item libusb_claim_interface(void *dev, int interface) =item libusb_release_interface(void *dev, int interface) =item libusb_control_msg(void *dev, int requesttype, int request, int value, int index, char *bytes, int size, int timeout) =item libusb_get_string(void *dev, int index, int langid, char *buf, size_t buflen) =item libusb_get_string_simple(void *dev, int index, char *buf, size_t buflen) =item libusb_get_descriptor(void *dev, unsigned char type, unsigned char index, char *buf, int size) =item libusb_get_descriptor_by_endpoint(void *dev, int ep, unsigned char type, unsigned char index, char *buf, int size) =item libusb_bulk_write(void *dev, int ep, char *bytes, int size, int timeout) =item libusb_bulk_read(void *dev, int ep, char *bytes, int size, int timeout) =item libusb_interrupt_write(void *dev, int ep, char *bytes, int size, int timeout) =item libusb_interrupt_read(void *dev, int ep, char *bytes, int size, int timeout) =item lib_get_usb_busses() Return the complete list of information after finding busses and devices. Before calling this function, remember to call find_busses and find_devices. returns a reference to an array of busses. =item lib_list_busses() Return the complete list of information after finding busses and devices. By using this function, you do not need to do the find_* calls yourself. returns a reference to an array of busses. =item lib_find_usb_device( int vendor, int product ) Find a particular device vendor - the vendor id product - product id for that vendor returns a pointer to the device if it is found, NULL otherwise. =item lib_debug_mode( int unsafe_level ) Set debugging level: 0: off, 1: some messages, 2: verbose Values outside range are forced into range. =back =head1 DIAGNOSTICS This is an explanation of the diagnostic and error messages this module can generate. =head1 DEPENDENCIES This module depends on the Carp, Inline and Inline::C modules, as well as the strict and warnings pragmas. Obviously, libusb must be available since that is the entire reason for the module's existence. =head1 AUTHOR G. Wade Johnson (gwadej at cpan dot org) Paul Archer (paul at paularcher dot org) Houston Perl Mongers Group Original author: David Davis =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 FOR MORE INFORMATION The project is hosted at github L. More information on the project, including installation help is avaliable on the Wiki. =head1 LIMITATIONS So far, this module has only been tested on Linux. It should work on any OS that supports the libusb library. Several people have reported problems compiling the module on Windows. In theory, it should be possible to make the library work with LibUsb-Win32 L. Without access to a Windows development system, I can't make those changes. The Interfaces and Endpoints are not yet proper objects. The code to extract this information is not yet written. =head1 ACKNOWLEDGEMENTS Thanks go to various members of the Houston Perl Mongers group for input on the module. But thanks mostly go to Paul Archer who proposed the project and helped with the development. Thanks to Josep Monés Teixidor for fixing the C bug. Thanks to Mike McCauley for support of C and C. Thanks to Vadim Mikhailov for fixing a compile problem with VC6 on Windows and then chipping in again for VS 2005 on Windows, and yet again to fix warnings on C99-compliant compilers. Thanks to John R. Hogheruis for information about modifying the Inline parameters for compiling with Strawberry Perl on Windows. Thanks to Tony Shadwick for helping me resolve a problem with bulk_read and interrupt_read. =head1 COPYRIGHT & LICENSE Copyright 2006-2013 Houston Perl Mongers This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; __DATA__ __C__ #include static unsigned debugLevel = 0; unsigned DeviceUSBDebugLevel() { return debugLevel; } void libusb_init() { usb_init(); } int libusb_find_busses() { return usb_find_busses(); } int libusb_find_devices() { return usb_find_devices(); } void *libusb_get_busses() { return usb_get_busses(); } void *libusb_open(void *dev) { return usb_open( (struct usb_device*)dev ); } int libusb_close(void *dev) { return usb_close((usb_dev_handle *)dev); } int libusb_set_configuration(void *dev, int configuration) { if(DeviceUSBDebugLevel()) { printf( "libusb_set_configuration( %d )\n", configuration ); } return usb_set_configuration((usb_dev_handle *)dev, configuration); } int libusb_set_altinterface(void *dev, int alternate) { if(DeviceUSBDebugLevel()) { printf( "libusb_set_altinterface( %d )\n", alternate ); } return usb_set_altinterface((usb_dev_handle *)dev, alternate); } int libusb_clear_halt(void *dev, unsigned int ep) { if(DeviceUSBDebugLevel()) { printf( "libusb_clear_halt( %d )\n", ep ); } return usb_clear_halt((usb_dev_handle *)dev, ep); } int libusb_reset(void *dev) { return usb_reset((usb_dev_handle *)dev); } int libusb_get_driver_np(void *dev, int interface, char *name, unsigned int namelen) { int ret = 0; if(DeviceUSBDebugLevel()) { printf( "libusb_get_driver_np( %d )\n", interface ); } #if LIBUSB_HAS_GET_DRIVER_NP ret = usb_get_driver_np((usb_dev_handle *)dev, interface, name, namelen); if (ret >= 0) return strlen(name); return ret; #else return 0; #endif } int libusb_detach_kernel_driver_np(void *dev, int interface) { if(DeviceUSBDebugLevel()) { printf( "libusb_detach_kernel_driver_np( %d )\n", interface ); } #if LIBUSB_HAS_DETACH_KERNEL_DRIVER_NP return usb_detach_kernel_driver_np((usb_dev_handle *)dev, interface); #else return 0; #endif } int libusb_claim_interface(void *dev, int interface) { if(DeviceUSBDebugLevel()) { printf( "libusb_claim_interface( %d )\n", interface ); } return usb_claim_interface((usb_dev_handle *)dev, interface); } int libusb_release_interface(void *dev, int interface) { if(DeviceUSBDebugLevel()) { printf( "libusb_release_interface( %d )\n", interface ); } return usb_release_interface((usb_dev_handle *)dev, interface); } void libusb_control_msg(void *dev, int requesttype, int request, int value, int index, char *bytes, int size, int timeout) { int i = 0; int retval = 0; Inline_Stack_Vars; if(DeviceUSBDebugLevel()) { printf( "libusb_control_msg( %#04x, %#04x, %#04x, %#04x, %p, %d, %d )\n", requesttype, request, value, index, bytes, size, timeout ); /* maybe need to add support for printing the bytes string. */ } retval = usb_control_msg((usb_dev_handle *)dev, requesttype, request, value, index, bytes, size, timeout); if(DeviceUSBDebugLevel()) { printf( "\t => %d\n",retval ); } /* quiet compiler warnings. */ (void)i; (void)ax; (void)items; /* * For some reason, I could not get this string transferred back to the Perl side * through a direct copy like in get_simple_string. So, I resorted to returning * it on the stack and doing the fixup on the Perl side. */ Inline_Stack_Reset; Inline_Stack_Push(sv_2mortal(newSViv(retval))); if(retval > 0) { Inline_Stack_Push(sv_2mortal(newSVpv(bytes, retval))); } else { Inline_Stack_Push(sv_2mortal(newSVpv(bytes, 0))); } Inline_Stack_Done; } int libusb_get_string(void *dev, int index, int langid, char *buf, size_t buflen) { if(DeviceUSBDebugLevel()) { printf( "libusb_get_string( %d, %d, %p, %lu )\n", index, langid, buf, (unsigned long)buflen ); } return usb_get_string((usb_dev_handle *)dev, index, langid, buf, buflen); } int libusb_get_string_simple(void *dev, int index, char *buf, size_t buflen) { if(DeviceUSBDebugLevel()) { printf( "libusb_get_string_simple( %d, %p, %lu )\n", index, buf, (unsigned long)buflen ); } return usb_get_string_simple((usb_dev_handle *)dev, index, buf, buflen); } int libusb_get_descriptor(void *dev, unsigned char type, unsigned char index, char *buf, int size) { return usb_get_descriptor((usb_dev_handle *)dev, type, index, buf, size); } int libusb_get_descriptor_by_endpoint(void *dev, int ep, unsigned char type, unsigned char index, char *buf, int size) { return usb_get_descriptor_by_endpoint((usb_dev_handle *)dev, ep, type, index, buf, size); } int libusb_bulk_write(void *dev, int ep, char *bytes, int size, int timeout) { return usb_bulk_write((usb_dev_handle *)dev, ep, bytes, size, timeout); } int libusb_bulk_read(void *dev, int ep, char *bytes, int size, int timeout) { return usb_bulk_read((usb_dev_handle *)dev, ep, bytes, size, timeout); } int libusb_interrupt_write(void *dev, int ep, char *bytes, int size, int timeout) { return usb_interrupt_write((usb_dev_handle *)dev, ep, bytes, size, timeout); } int libusb_interrupt_read(void *dev, int ep, char *bytes, int size, int timeout) { return usb_interrupt_read((usb_dev_handle *)dev, ep, bytes, size, timeout); } /* ------------------------------------------------------------ * Provide Perl-ish interface for accessing busses and devices. */ /* * Utility function to store BCD encoded number as an appropriate string * in a hash under the supplied key. */ static void hashStoreBcd( HV *hash, const char *key, long value ) { int major = (value >> 8) & 0xff; int minor = (value >> 4) & 0xf; int subminor = value & 0xf; // should not be able to exceed 6. char buffer[10] = ""; sprintf( buffer, "%d.%d%d", major, minor, subminor ); (void) hv_store( hash, key, strlen( key ), newSVpv( buffer, strlen( buffer ) ), 0 ); } /* * Utility function to store an integer value in a hash under the supplied key. */ static void hashStoreInt( HV *hash, const char *key, long value ) { (void) hv_store( hash, key, strlen( key ), newSViv( value ), 0 ); } /* * Utility function to store a C-style string in a hash under the supplied key. */ static void hashStoreString( HV *hash, const char *key, const char *value ) { (void) hv_store( hash, key, strlen( key ), newSVpv( value, strlen( value ) ), 0 ); } /* * Utility function to store an SV in a hash under the supplied key. */ static void hashStoreSV( HV *hash, const char *key, SV *value ) { (void) hv_store( hash, key, strlen( key ), value, 0 ); } /* * Given a pointer to an array of usb_device, create a hash * reference containing the descriptor information. */ static SV* build_descriptor(struct usb_device *dev) { HV* hash = newHV(); hashStoreInt( hash, "bDescriptorType", dev->descriptor.bDescriptorType ); hashStoreBcd( hash, "bcdUSB", dev->descriptor.bcdUSB ); hashStoreInt( hash, "bDeviceClass", dev->descriptor.bDeviceClass ); hashStoreInt( hash, "bDeviceSubClass", dev->descriptor.bDeviceSubClass ); hashStoreInt( hash, "bDeviceProtocol", dev->descriptor.bDeviceProtocol ); hashStoreInt( hash, "bMaxPacketSize0", dev->descriptor.bMaxPacketSize0 ); hashStoreInt( hash, "idVendor", dev->descriptor.idVendor ); hashStoreInt( hash, "idProduct", dev->descriptor.idProduct ); hashStoreBcd( hash, "bcdDevice", dev->descriptor.bcdDevice ); hashStoreInt( hash, "iManufacturer", dev->descriptor.iManufacturer ); hashStoreInt( hash, "iProduct", dev->descriptor.iProduct ); hashStoreInt( hash, "iSerialNumber", dev->descriptor.iSerialNumber ); hashStoreInt( hash, "bNumConfigurations", dev->descriptor.bNumConfigurations ); return newRV_noinc( (SV*)hash ); } /* * Given a pointer to a usb_endpoint_descriptor struct, create a reference * to a Device::USB::DevEndpoint object that represents it. */ static SV* build_endpoint( struct usb_endpoint_descriptor* endpt ) { HV* hash = newHV(); hashStoreInt( hash, "bDescriptorType", endpt->bDescriptorType ); hashStoreInt( hash, "bEndpointAddress", endpt->bEndpointAddress ); hashStoreInt( hash, "bmAttributes", endpt->bmAttributes ); hashStoreInt( hash, "wMaxPacketSize", endpt->wMaxPacketSize ); hashStoreInt( hash, "bInterval", endpt->bInterval ); hashStoreInt( hash, "bRefresh", endpt->bRefresh ); hashStoreInt( hash, "bSynchAddress", endpt->bSynchAddress ); return sv_bless( newRV_noinc( (SV*)hash ), gv_stashpv( "Device::USB::DevEndpoint", 1 ) ); } /* * Given a pointer to an array of usb_endpoint_descriptor structs, create a * reference to a Perl array containing the same data. */ static SV* list_endpoints( struct usb_endpoint_descriptor* endpt, unsigned count ) { AV* array = newAV(); unsigned i = 0; for(i=0; i < count; ++i) { av_push( array, build_endpoint( endpt+i ) ); } return newRV_noinc( (SV*)array ); } /* * Build the object that contains the interface descriptor. * * inter - the usb_interface_descriptor describing this interface. * * returns the appropriate pointer to a reference. */ static SV* build_interface( struct usb_interface_descriptor* inter ) { HV* hash = newHV(); hashStoreInt( hash, "bDescriptorType", inter->bDescriptorType ); hashStoreInt( hash, "bInterfaceNumber", inter->bInterfaceNumber ); hashStoreInt( hash, "bAlternateSetting", inter->bAlternateSetting ); hashStoreInt( hash, "bNumEndpoints", inter->bNumEndpoints ); hashStoreInt( hash, "bInterfaceClass", inter->bInterfaceClass ); hashStoreInt( hash, "bInterfaceSubClass", inter->bInterfaceSubClass ); hashStoreInt( hash, "bInterfaceProtocol", inter->bInterfaceProtocol ); hashStoreInt( hash, "iInterface", inter->iInterface ); hashStoreSV( hash, "endpoints", list_endpoints( inter->endpoint, inter->bNumEndpoints ) ); /* TODO: handle the 'extra' data */ return sv_bless( newRV_noinc( (SV*)hash ), gv_stashpv( "Device::USB::DevInterface", 1 ) ); } /* * Given a pointer to an array of usb_interface structs, create a * reference to a Perl array containing the same data. */ static SV* list_interfaces( struct usb_interface* ints, unsigned count ) { AV* array = newAV(); unsigned i = 0; for(i=0; i < count; ++i) { AV* inters = newAV(); unsigned j = 0; for(j=0; j < ints[i].num_altsetting; ++j) { av_push( inters, build_interface( (ints[i].altsetting+j) ) ); } av_push( array, newRV_noinc( (SV*)inters ) ); } return newRV_noinc( (SV*)array ); } /* * Given a pointer to a usb_config_descriptor struct, create a Perl * object that contains the same data. */ static SV* build_configuration( struct usb_config_descriptor *cfg ) { HV* hash = newHV(); hashStoreInt( hash, "bDescriptorType", cfg->bDescriptorType ); hashStoreInt( hash, "wTotalLength", cfg->wTotalLength ); hashStoreInt( hash, "bNumInterfaces", cfg->bNumInterfaces ); hashStoreInt( hash, "bConfigurationValue", cfg->bConfigurationValue ); hashStoreInt( hash, "iConfiguration", cfg->iConfiguration ); hashStoreInt( hash, "bmAttributes", cfg->bmAttributes ); hashStoreInt( hash, "MaxPower", cfg->MaxPower*2 ); hashStoreSV( hash, "interfaces", list_interfaces( cfg->interface, cfg->bNumInterfaces ) ); return sv_bless( newRV_noinc( (SV*)hash ), gv_stashpv( "Device::USB::DevConfig", 1 ) ); } /* * Given a pointer to an array of usb_config_descriptor structs, create a * reference to a Perl array containing the same data. */ static SV* list_configurations(struct usb_config_descriptor *cfg, unsigned count ) { AV* array = newAV(); unsigned i = 0; for(i=0; i < count; ++i) { av_push( array, build_configuration( (cfg+i) ) ); } return newRV_noinc( (SV*)array ); } /* * Given a pointer to a usb device structure, return a reference to a * Perl object containing the same data. */ static SV* build_device(struct usb_device *dev) { HV* hash = newHV(); hashStoreString( hash, "filename", dev->filename ); hashStoreSV( hash, "descriptor", build_descriptor( dev ) ); hashStoreSV( hash, "config", list_configurations( dev->config, dev->descriptor.bNumConfigurations ) ); hashStoreInt( hash, "device", (unsigned long)dev ); return sv_bless( newRV_noinc( (SV*)hash ), gv_stashpv( "Device::USB::Device", 1 ) ); } /* * Given a pointer to a list of devices, return a reference to a * Perl array of device objects. */ static SV* list_devices(struct usb_device *dev) { AV* array = newAV(); for(; 0 != dev; dev = dev->next) { av_push( array, build_device( dev ) ); } return newRV_noinc( (SV*) array ); } static SV* build_bus( struct usb_bus *bus ) { HV *hash = newHV(); hashStoreString( hash, "dirname", bus->dirname ); hashStoreInt( hash, "location", bus->location ); hashStoreSV( hash, "devices", list_devices( bus->devices ) ); return sv_bless( newRV_noinc( (SV*)hash ), gv_stashpv( "Device::USB::Bus", 1 ) ); } /* * Return the complete list of information after finding busses and devices. * * Before calling this function, remember to call find_busses and find_devices. * * returns a reference to an array of busses. */ SV* lib_get_usb_busses() { AV* array = newAV(); struct usb_bus *bus = 0; for(bus = usb_busses; 0 != bus; bus = bus->next) { av_push( array, build_bus( bus ) ); } return newRV_noinc( (SV*) array ); } /* * Return the complete list of information after finding busses and devices. * * By using this function, you do not need to do the find_* calls yourself. * * returns a reference to an array of busses. */ SV* lib_list_busses() { usb_find_busses(); usb_find_devices(); return lib_get_usb_busses(); } /* * Find a particular device * * vendor - the vendor id * product - product id for that vendor * * returns a pointer to the device if it is found, NULL otherwise. */ SV *lib_find_usb_device( int vendor, int product ) { struct usb_bus *bus = 0; usb_find_busses(); usb_find_devices(); for(bus = usb_busses; 0 != bus; bus = bus->next) { struct usb_device *dev = 0; for(dev = bus->devices; 0 != dev; dev = dev->next) { if((dev->descriptor.idVendor == vendor) && (dev->descriptor.idProduct == product)) { return build_device( dev ); } } } return &PL_sv_undef; } /* * Set debugging level: 0: off, 1: some messages, 2: verbose * Values outside range are forced into range. */ void lib_debug_mode( int unsafe_level ) { static char* level_str[] = { "off", "on", "verbose" }; int level = unsafe_level; if(level < 0) { level = 0; } else if(level > 2) { level = 2; } printf( "Debugging: %s\n", level_str[level] ); usb_set_debug(level); debugLevel = level; } Device-USB-0.38/META.json0000644000175000017500000000206013510122743014173 0ustar gwadejgwadej{ "abstract" : "Use libusb to access USB devices. (DEPRECATED)", "author" : [ "G. Wade Johnson " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Device-USB", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "Inline::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Inline" : "0", "Inline::C" : "0" } } }, "release_status" : "stable", "resources" : {}, "version" : 0.38, "x_deprecated" : 1, "x_serialization_backend" : "JSON::PP version 4.02" } Device-USB-0.38/xt/0000755000175000017500000000000013510122743013207 5ustar gwadejgwadejDevice-USB-0.38/xt/pod.t0000644000175000017500000000120212473354762014170 0ustar gwadejgwadej#!/usr/bin/perl # Test that the syntax of our POD documentation is valid use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'Pod::Simple 3.07', 'Test::Pod 1.26', ); # Don't run tests during end-user installs use Test::More; plan( skip_all => 'Author tests not required for installation' ) unless ( $ENV{RELEASE_TESTING} or $ENV{AUTOMATED_TESTING} ); # Load the testing modules foreach my $MODULE ( @MODULES ) { eval "use $MODULE"; if ( $@ ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } all_pod_files_ok(); 1; Device-USB-0.38/xt/podcoverage.t0000644000175000017500000000112112473354762015704 0ustar gwadejgwadej#!/usr/bin/perl # Ensure pod coverage in your distribution use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'Test::Pod::Coverage 1.08', ); # Don't run tests during end-user installs use Test::More; plan( skip_all => 'Author tests not required for installation' ) unless ( $ENV{RELEASE_TESTING} ); # Load the testing modules foreach my $MODULE ( @MODULES ) { eval "use $MODULE"; if ( $@ ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } all_pod_coverage_ok(); 1; Device-USB-0.38/xt/boilerplate.t0000644000175000017500000000254612473356050015714 0ustar gwadejgwadej#!perl -T use Test::More; use Carp; use strict; use warnings; plan( skip_all => 'Author tests not required for installation' ) unless ( $ENV{RELEASE_TESTING} ); plan( tests => 3 ); sub not_in_file_ok { my ($filename, %regex) = @_; open my $fh, "<", $filename or croak "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } return; } not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); return; } module_boilerplate_ok('lib/Device/USB.pm'); Device-USB-0.38/xt/hasversion.t0000644000175000017500000000115312473354762015574 0ustar gwadejgwadej#!/usr/bin/perl # Test that all modules have a version number use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'Test::HasVersion 0.012', ); # Don't run tests during end-user installs use Test::More; plan( skip_all => 'Author tests not required for installation' ) unless ( $ENV{RELEASE_TESTING} or $ENV{AUTOMATED_TESTING} ); # Load the testing modules foreach my $MODULE ( @MODULES ) { eval "use $MODULE"; if ( $@ ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } all_pm_version_ok(); 1; Device-USB-0.38/xt/critic.t0000644000175000017500000000113712473354762014672 0ustar gwadejgwadej#!/usr/bin/perl # Test that the module passes perlcritic use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'Perl::Critic 1.098', 'Test::Perl::Critic 1.01', ); # Don't run tests during end-user installs use Test::More; plan( skip_all => 'Author tests not required for installation' ) unless ( $ENV{RELEASE_TESTING} ); # Load the testing modules foreach my $MODULE ( @MODULES ) { eval "use $MODULE"; if ( $@ ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } all_critic_ok(); 1; Device-USB-0.38/MANIFEST.SKIP0000644000175000017500000000023712512033547014460 0ustar gwadejgwadej_Inline.* .*\.svn.* pm_to_blib .*\.old .*\.bak .*\.swp blib/.* images/.* bin/usb-sh .*\.inl ^Makefile$ ^synchtest.pl$ ^Device-USB-.*\.tar\.gz$ \d+_local_ .git Device-USB-0.38/Changes0000644000175000017500000001163213106203645014054 0ustar gwadejgwadejRevision history for Device-USB 0.37 2017-05-14 - Deprecate module - Correct usage of Inline::C - Convert to xt-based author tests for non-installation tests. - Fix failing author tests. - Move code to github and cleanup repo. 0.36 2013-10-24 - Correct my author email address. 0.35 2010-07-21 - Re-examined typecasting patch from release 0.32, thanks to a bug report from Magnus Sulland. Some of the wrong void* parameters were changed to char* and a few were missed that should have been changed. Should prevent segfaults. 0.34 2010-07-05 - Apply patch from Vadim Mikhailov that silences warnings on C99-compliant compilers. 0.33 2010-03-22 - Correct a unit test that failed on FreeBSD. 0.32 2010-03-21 - Corrected a unit test that was too strict, identified by H. Merljn Brand. - Added 64-bit lib directories to the dependency check. Thanks to H. Merljn Brand. - Corrected typecasting as found by Stephen Cliffe. 0.31 2009-12-22 - R. Barrabas modified Makefile.PL to better support building on Strawberry Perl. 0.30 2009-12-16 - Updated to support the Device::USB::Win32Async module. 0:29 2009-04-02 - Corrected handling of reads when passed uninitialized 'bytes' variables. Thanks to William King for finding this one. 0.28 2009-02-12 - Thanks to Vadim Mikhailov for patches supporting the ActiveState 5.10 version, including upgrading to VS 2005. 0.27 2008-11-08 - Add dependency on Inline:MakeMaker to help CPAN Testers builds. - Update documentation to reference the Google Code project. 0.26 2008-11-02 - Correct skip count on test 13 to fix FreeBSD tests. 0.25 2008-10-10 - Yet another modification to try to get the tests cleaned up for the CPAN Testers. Modify tests 13 and 14 to skip if no USB busses are found instead of failing. 0.24 2008-10-09 - Undo a modification to the parameter handling on bulk_read and interrupt read. The change broke the methods completely. Thanks to Tony Shadwick for pointing it out. 0.23 2008-10-04 - More documentation cleanup, including correcting the spelling of John Hogerhuis's name. - Correcting tests 15, 16, and 17 to skip if no devices are found instead of failing. 0.22 2008-10-02 - Perform cleanup of tests for Mac OSX, as well as changes to clean code for newer Perl::Critic policies. - Correction to documentation of Device::USB::Device methods bulk_write and interrupt_write (reported by John R. Hogerhuis). - Modified the Inline attributes to make building under systems other than Linux a bit easier. (thanks to John R. Hogheruis for the insight). - Make creation of makefile fail if Windows and environment not properly set up. 0.21 2007-04-16 - Thanks to Vadim Mikhailov for spotting a problem with use of the macro Inline_Stack_Vars that prevented compilation under Windows. Applied Vadim's patch. 0.20 2006-11-18 - Added support for interface objects and corrected the code returning the code. Previous versions had only returned the first setting of the interface. - Deprecate the Device::USB::Device::config method as badly named and incomplete. Replaced with Device::USB::Device::configurations and Device::USB::Device::get_configuration. 0.19 2006-09-18 - Modified Inline::C code to be correct C. (reported by Craig DeForest.) - Changes Device::USB::Device interface to automatically open the USB device if needed, as requested by Ray Brinzer. 0.18 2006-09-17 - Added CLASS_* constants to the Device::USB module. - Added class support for the configuration objects. - Try again to fix assumption in tests, this time found by Ray Brinzer. 0.17 2006-09-04 - Added FAQ document. Added new Device::USB::list_devices_if() and Device::USB::find_device_if() methods for more flexible device searching. Minor documentation cleanup. 0.16 2006-09-01 - Modified Device::USB::list_devices() to support listing all devices. Thanks to Tony Awtrey for pointing this out. He also spotted an invalid assumption in the tests; that has been corrected. 0.15 2006-08-08 - Applied patch from Mike McCauley that adds Device::USB::Device::get_driver_np() and Device::USB::Device::detach_kernel_driver_np() methods, as well as extending the debugging modes. 0.14 2006-07-10 - Corrected the bInterfaceClass field in the interface descriptor. Thanks to Josep Monés Teixidor for spotting it. 0.13 2006-05-18 - Added debug mode to simplify debugging VSI module. 0.12 2006-05-08 - Fixed a bug that prevented Device::USB::Device::control_msg() from returning data. 0.11 2006-04-05 - Correct some typing errors in the documentation. - Correct return code on Device::USB::Device::open(). 0.10 2006-04-01 - Build test suite and shake out bugs with testing. 0.03 2006-03-27 - Rename to Device::USB with permission of the owner of that module. (Not released) 0.02 2006-03-25 - Mostly complete first version available for limited distribution. Device-USB-0.38/META.yml0000644000175000017500000000120213510122743014020 0ustar gwadejgwadej--- abstract: 'Use libusb to access USB devices. (DEPRECATED)' author: - 'G. Wade Johnson ' build_requires: Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' Inline::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Device-USB no_index: directory: - t - inc requires: Carp: '0' Inline: '0' Inline::C: '0' resources: {} version: 0.38 x_deprecated: 1 x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Device-USB-0.38/bin/0000755000175000017500000000000013510122743013324 5ustar gwadejgwadejDevice-USB-0.38/bin/dump_usb.pl0000644000175000017500000000606413106204141015477 0ustar gwadejgwadej#!/usr/bin/perl use Device::USB; use Data::Dumper; use Carp; use strict; use warnings; =head1 NAME dump_usb.pl - Use Device::USB to list USB devices. =head1 VERSION Version 0.37 =cut our $VERSION=0.37; =head1 SYNOPSIS The C program provides a relatively crude dump of the information available from any USB devices installed on the system. =head1 DESCRIPTION This module provides a Perl interface to the C library libusb. This library supports a relatively full set of functionality to access a USB device. In addition to the libusb, functioality, Device::USB provides a few convenience features that are intended to produce a more Perl-ish interface. If called without arguments, the program lists all installed USB devices on all busses. This is just a Data::Dumper dump of the structures, so it is not the most user friendly output in the world. (However, the program was only intended as a I to verify that Device::USB was working.) If called with arguments, they are expected to be a vendor id and a product id. (These arguments can be in hex if you precede them with C<0x>.) The program searches for a device that matches that vendor id and product id. If it finds one, the device I is printed, along with the vendor and product ids. If the program can open the device, it will also print the manufacture name and product name as reported by the device. =cut my $usb = Device::USB->new(); $Data::Dumper::Indent = 1; ## no critic(ProhibitPackageVars) if(@ARGV) { my $dev = $usb->find_device( map { /^0/xm ? oct( $_ ) : $_ } @ARGV[0,1] ); croak "Device not found.\n" unless defined $dev; print "Device found: ", $dev->filename(), ": "; printf "ID %04x:%04x\n", $dev->idVendor(), $dev->idProduct(); if($dev->open()) { print "\t", $dev->manufacturer(), ": ", $dev->product(), "\n"; print Dumper( $dev ); } else { print "Unable to open device.\n"; } } else { print Dumper( [ $usb->list_busses() ] ); } =head1 DEPENDENCIES This module depends on the Device::USB and Data::Dumper modules, as well as the strict and warnings pragmas. Obviously, libusb must be available for Device::USB to function. =head1 AUTHOR G. Wade Johnson (wade at anomaly dot org) Paul Archer (paul at paularcher dot org) Houston Perl Mongers Group =head1 BUGS The output format is extremely non-friendly. The program only returns the first matching USB device. Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS Thanks go to various members of the Houston Perl Mongers group for input on the module. But thanks mostly go to Paul Archer who proposed the project and helped with the development. =head1 COPYRIGHT & LICENSE Copyright 2006 Houston Perl Mongers This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Device-USB-0.38/README0000644000175000017500000000345113510122161013431 0ustar gwadejgwadejDevice-USB This module is deprecated as of version 0.37. I have not had the time or need to update the module, and no one has been willing to take it over. This module has been superceded by USB::LibUSB, which supports the 1.0 version of the libusb API. This module provides a relatively complete Perl wrapper on the libusb library. Using this module provides an object-oriented interface to any installed USB devices. Obviously, the module requires a copy of the libusb library compiled for the target system. The module also requires a C compiler compatible with the Perl installation, because it uses the Inline::C module to create the interface to libusb. TODO The current version of the library does not fully support 'get_descriptor'. This method currently returns a binary string containing the data, the code to create a reasonable data structure has not yet been written. The device objects also do not contain pointers back to their busses at this time. This feature will be added once I am certain that it will not leak memory. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Device::USB You can also look for information at: Search CPAN http://search.cpan.org/dist/Device-USB CPAN Request Tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Device-USB AnnoCPAN, annotated CPAN documentation: http://annocpan.org/dist/Device-USB CPAN Ratings: http://cpanratings.perl.org/d/Device-USB COPYRIGHT AND LICENCE Copyright (C) 2006 G. Wade Johnson This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Device-USB-0.38/Makefile.PL0000644000175000017500000000542613510121760014533 0ustar gwadejgwadejuse strict; use warnings; use Inline::MakeMaker; if($^O eq 'MSWin32') { if(!$ENV{LIBUSB_LIBDIR} or !$ENV{LIBUSB_INCDIR}) { die <<'END'; ERROR: Missing required environment variables to compile under Windows. LIBUSB_LIBDIR should contain the path to the libusb libraries LIBUSB_INCDIR should contain the path to the libusb include files END } } unless(header_found()) { die <<"END"; ERROR: Can't find usb.h header. If the library is not installed, you will need to install it. If it is installed somewhere other than /usr or /usr/local, you need to set the following environment variables: LIBUSB_LIBDIR should contain the path to the libusb libraries LIBUSB_INCDIR should contain the path to the libusb include files END } unless(lib_found()) { die <<"END"; ERROR: Can't find libusb library. If the library is not installed, you will need to install it. If it is installed somewhere other than /usr or /usr/local, you need to set the following environment variables: LIBUSB_LIBDIR should contain the path to the libusb libraries LIBUSB_INCDIR should contain the path to the libusb include files END } WriteMakefile( NAME => 'Device::USB', AUTHOR => 'G. Wade Johnson ', VERSION_FROM => 'lib/Device/USB.pm', ABSTRACT_FROM => 'lib/Device/USB.pm', LICENSE => 'perl', EXE_FILES => [ 'bin/dump_usb.pl' ], PL_FILES => {}, CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, 'Inline::MakeMaker' => 0, }, BUILD_REQUIRES => { 'Test::More' => 0, }, PREREQ_PM => { 'Inline' => 0, 'Inline::C' => 0, 'Carp' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Device-USB-* USB.inl _Inline' }, META_MERGE => { x_deprecated => 1, resources => { repository => { type => 'git', url => 'https://github.com/gwadej/perl-device-usb.git', web => 'https://github.com/gwadej/perl-device-usb', }, }, }, test => { TESTS => 't/*.t xt/*.t', }, ); sub header_found { return 1 if $^O eq 'linux'; foreach my $dir (qw(/usr/include /usr/local/include), $ENV{LIBUSB_INCDIR}) { return 1 if defined $dir && -e "$dir/usb.h"; } return; } sub lib_found { return 1 if $^O eq 'linux'; foreach my $dir (qw(/usr/local/lib64 /usr/lib64 /lib64 /usr/lib /usr/local/lib), $ENV{LIBUSB_LIBDIR}) { return 1 if defined $dir && ($^O =~ /win/i ? (-e "$dir/libusb.lib" || -e "$dir/libusb.a") : -e "$dir/libusb.so") ; } return; }