package USB::Descriptor::Configuration; use strict; use warnings; use USB::Descriptor::Interface; our $VERSION = '1'; use overload '@{}' => \&bytes; use constant fields => qw( bLength bDescriptorType wTotalLength bNumInterfaces bConfigurationValue iConfiguration bmAttributes bMaxPower ); =head1 NAME USB::Descriptor::Configuration - USB Interface Descriptor =head1 VERSION Version 1 =head1 SYNOPSIS An object representation of a USB configuration descriptor. use USB::Descriptor::Configuration; my $configuration = USB::Descriptor::Configuration->new( description => 'My First Configuration' ); $configuration->max_current(100); # Max current in mA $configuration->self_powered(1); # Self-powered device $configuration->interfaces( [ USB::Descriptor::Interface->new() ] ); ... =head1 DESCRIPTION L<USB::Descriptor::Configuration> represents a USB configuration descriptor. When added to the descriptor tree of a L<USB::Descriptor::Device> object it can be used to generate the data structures needed to compile the firmware for a USB device. =head1 CONSTRUCTOR =over =item $configuration = USB::Descriptor::Configuration->new(description=>$description, ...); Constructs and returns a new L<USB::Descriptor::Configuration> object using the passed options. Each option key is the name of an accessor method. =back =cut sub new { my ($this, %options) = @_; my $class = ref($this) || $this; my $self = { 'attributes' => 0x80, # Bit 7 is reserved and set 'max_current' => 0, 'value' => 0, }; bless $self, $class; while( my ($key, $value) = each %options ) { $self->$key($value); } return $self; } =head1 Arrayification =over =item $configuration->bytes (or @{$configuration} ) Returns an array of bytes containing all of the fields in the configuration descriptor fields as well as all of the child interface descriptors. =back =cut sub bytes { my $s = shift; my @bytes; push @bytes, 9; # Configuration descriptors are 9 bytes long push @bytes, 0x02; # bDescriptorType push @bytes, 0; # Placeholder for wTotalLength low push @bytes, 0; # Placeholder for wTotalLength high my $numInterfaces = $s->{'interfaces'} ? @{$s->{'interfaces'}} : 0; push @bytes, $numInterfaces; # bNumInterfaces push @bytes, $s->value; # bConfigurationValue my $stringIndex = defined($s->parent) ? $s->parent->index_for_string($s->description) : 0; push @bytes, $stringIndex; # iConfiguration push @bytes, $s->attributes; # bmAttributes push @bytes, int($s->max_current/2) & 0xFF; # bMaxPower warn "Configuration descriptor length is wrong" unless $bytes[0] == scalar @bytes; # Append the interface descriptors push @bytes, @{$_->bytes} for @{$s->{'interfaces'}}; # Update wTotalLength my $wTotalLength = scalar @bytes; $bytes[2] = $wTotalLength & 0xFF; # wTotalLength low $bytes[3] = ($wTotalLength >> 8) & 0xFF; # wTotalLength high return \@bytes; } =head1 ATTRIBUTES =over =item $interface->description Get/Set the configuration's description string. A string descriptor index (iConfiguration) will be automatically assigned when arrayified by L<USB::Descriptor::Configuration>. =item $interface->interfaces Get/Set the array of L<USB::Descriptor::Interface> objects. All of the interfaces in the passed array will be arrayified when the configuration object is arrayified by L<USB::Descriptor::Device>. =item $interface->max_current Get/Set the configuration's max current draw in milliamps (bMaxPower). Defaults to 0. =item $interface->remote_wakeup Get/Set the configuration's remote wakeup attribute (bmAttributes). =item $interface->self_powered Get/Set the configuration's self-powered attribute (bmAttributes). =item $interface->value Get/Set the configuration's configuration value (bConfigurationValue). =back =cut sub attributes { my $s = shift; $s->{'attributes'} = int(shift) & 0xFF if scalar @_; $s->{'attributes'}; } sub description { my $s = shift; $s->{'description'} = shift if scalar @_; $s->{'description'}; } sub interfaces { my $s = shift; if( scalar(@_) and (ref($_[0]) eq 'ARRAY') ) { # Convert hash reference arguments into Interface objects my @interfaces = map { if( ref($_) eq 'HASH' ) # Hash reference? { USB::Descriptor::Interface->new(%{$_}); } elsif( ref($_) ) # Reference to something else? { $_; # Use it } } @{$_[0]}; $s->{'interfaces'} = \@interfaces; # Reparent the new interface descriptors $_->parent($s) for @{$s->{'interfaces'}}; } $s->{'interfaces'}; } sub max_current { my $s = shift; $s->{'max_current'} = int(shift) & 0xFF if scalar @_; $s->{'max_current'}; } sub remote_wakeup { my $s = shift; if( scalar @_ ) { if( $_[0] ) { $s->{'attributes'} |= 0x20; } else { $s->{'attributes'} &= ~0x20; } } $s->{'attributes'} & 0x20; } sub self_powered { my $s = shift; if( scalar @_ ) { if( $_[0] ) { $s->{'attributes'} |= 0x40; } else { $s->{'attributes'} &= ~0x40; } } $s->{'attributes'} & 0x40; } sub value { my $s = shift; $s->{'value'} = int(shift) & 0xFF if scalar @_; $s->{'value'}; } # --- String Descriptor support --- # Called by children during arrayification sub index_for_string { my ($s, $string) = @_; if( defined($string) and length($string) and defined($s->parent) ) { return $s->parent->index_for_string($string); } return 0; } # Get/Set the object parent sub parent { my $s = shift; $s->{'parent'} = shift if scalar(@_) && $_[0]->can('index_for_string'); $s->{'parent'}; } 1; =head1 AUTHOR Brandon Fosdick, C<< <bfoz at bfoz.net> >> =head1 BUGS Please report any bugs or feature requests to C<bug-usb-descriptor-configuration at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=USB-Descriptor-Configuration>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc USB::Descriptor::Configuration You can also look for information at: =over 4 =item * RT: CPAN's request tracker (report bugs here) L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=USB-Descriptor-Configuration> =item * AnnoCPAN: Annotated CPAN documentation L<http://annocpan.org/dist/USB-Descriptor-Configuration> =item * CPAN Ratings L<http://cpanratings.perl.org/d/USB-Descriptor-Configuration> =item * Search CPAN L<http://search.cpan.org/dist/USB-Descriptor-Configuration/> =back =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2011 Brandon Fosdick. This program is released under the terms of the BSD License. =cut