File Coverage

blib/lib/Device/Chip/AVR_HVSP/FuseInfo.pm

Criterion	Covered	Total	%
statement	11	37	29.7
branch	0	8	0.0
condition			n/a
subroutine	4	8	50.0
pod	4	4	100.0
total	19	57	33.3

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2014-2015 -- [e-mail]

package Device::Chip::AVR_HVSP::FuseInfo 0.06;

use v5.26;
use warnings;

use Carp;

use Struct::Dumb qw( readonly_struct );

readonly_struct Fuse => [qw( name offset mask caption values )];
readonly_struct FuseEnumValue => [qw( name value caption )];

my %info_for;

=head1 NAME

C - information about device fuses

=head1 DESCRIPTION

Objects in this class contain information about the configuration fuses of a
single F HVSP-programmable device. These instances may be useful for
encoding and decoding the fuse bytes, for display or other purposes in some
user-interactive manner.

=cut

=head1 CONSTRUCTOR

=head2 for_part

   $fuseinfo = Device::Chip::AVR_HVSP::FuseInfo->for_part( $part )

Returns a new C instance containing
information about the fuses for the given part name.

=cut

sub for_part
{
   my $class = shift;
   my ( $part ) = @_;

   $info_for{$part} or croak "No defined fuses for $part";

   return bless { %{ $info_for{$part} } }, $class;
}

=head1 METHODS

=cut

=head2 fuses

   @fuses = $fuseinfo->fuses

Returns a list of objects, each one representing a single configuration fuse.
Each has the following fields:

   $fuse->name
   $fuse->offset
   $fuse->mask
   $fuse->caption
   @values = $fuse->values

If the C method gives a non-empty list of values, then the fuse is an
enumeration; otherwise it is a simple boolean true/false flag. For enumeration
fuses, each value item has the following fields:

   $value->name
   $value->value
   $value->caption

=cut

sub fuses
{
   my $self = shift;
   return @{ $self->{fuses} };
}

=head2 unpack

   %fields = $fuseinfo->unpack( $bytes )

Given a byte string containing all the fuses read from the device, unpacks
them and returns a key-value list giving the current value of every fuse.

=cut

sub unpack
{
   my $self = shift;
   my ( $bytes ) = @_;

   my %ret;
   foreach my $f ( $self->fuses ) {
      my $bits = ord( substr $bytes, $f->offset, 1 ) & $f->mask;

      $ret{$f->name} = $bits;
   }

   return %ret;
}

=head2 pack

   $bytes = $fuseinfo->pack( %fields )

Given a key-value list containing fuse values, packs them into a byte string
suitable to write onto the device and returns it.

=cut

sub pack
{
   my $self = shift;
   my %fuses = @_;

   my $bytes = ~$self->{mask};
   foreach my $f ( $self->fuses ) {
      my $v = $fuses{$f->name};

      if( $f->values ) {
         # Value check enum fuse
         croak "Invalid value for ${\$f->name}: $v" if $v & ~$f->mask;
      }
      else {
         $v = $f->mask if $v;
      }

      substr( $bytes, $f->offset, 1 ) |= chr( $f->mask & $v );
   }

   return $bytes;
}

my $info;

LINE: while( my $line =  ) {
   if( $line =~ m/^DEVICE name=(\S+)$/ ) {
      $info = {} if keys %$info; # new device
      $info_for{$1} = $info;
   }
   elsif( $line =~ m/^MASK (\d+) (\d+)$/ ) {
      $info->{mask} ||= "";
      $info->{mask} .= "\0" until length $info->{mask} >= $1;
      substr( $info->{mask}, $1, 1 ) = chr $2;
   }
   elsif( $line =~ m/^BIT (\S+) (\d+) (\d+): (.*)$/ ) {
      push @{ $info->{fuses} }, Fuse( $1, $2, $3+0, $4, undef );
   }
   elsif( $line =~ m/^ENUM (\S+) (\d+) (\d+): (.*)$/ ) {
      my $values = [];
      push @{ $info->{fuses} }, Fuse( $1, $2, $3+0, $4, $values );

      while( $line =  ) {
         $line =~ m/^  VALUE (\S+) (\d+): (.*)$/ or redo LINE;
         push @$values, FuseEnumValue( $1, $2, $3 );
      }
   }
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;

__DATA__