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


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2014-2015 -- leonerd@leonerd.org.uk
5              
6             package Device::Chip::AVR_HVSP::FuseInfo;
7              
8 1     1   1324 use v5.26;
  1         4  
9 1     1   5 use warnings;
  1         4  
  1         43  
10              
11             our $VERSION = '0.05';
12              
13 1     1   5 use Carp;
  1         2  
  1         58  
14              
15 1     1   6 use Struct::Dumb qw( readonly_struct );
  1         2  
  1         5  
16              
17             readonly_struct Fuse => [qw( name offset mask caption values )];
18             readonly_struct FuseEnumValue => [qw( name value caption )];
19              
20             my %info_for;
21              
22             =head1 NAME
23              
24             C - information about device fuses
25              
26             =head1 DESCRIPTION
27              
28             Objects in this class contain information about the configuration fuses of a
29             single F HVSP-programmable device. These instances may be useful for
30             encoding and decoding the fuse bytes, for display or other purposes in some
31             user-interactive manner.
32              
33             =cut
34              
35             =head1 CONSTRUCTOR
36              
37             =head2 $fuseinfo = Device::Chip::AVR_HVSP::FuseInfo->for_part( $part )
38              
39             Returns a new C instance containing
40             information about the fuses for the given part name.
41              
42             =cut
43              
44             sub for_part
45             {
46 0     0 1   my $class = shift;
47 0           my ( $part ) = @_;
48              
49 0 0         $info_for{$part} or croak "No defined fuses for $part";
50              
51 0           return bless { %{ $info_for{$part} } }, $class;
  0            
52             }
53              
54             =head1 METHODS
55              
56             =cut
57              
58             =head2 @fuses = $fuseinfo->fuses
59              
60             Returns a list of objects, each one representing a single configuration fuse.
61             Each has the following fields:
62              
63             $fuse->name
64             $fuse->offset
65             $fuse->mask
66             $fuse->caption
67             @values = $fuse->values
68              
69             If the C method gives a non-empty list of values, then the fuse is an
70             enumeration; otherwise it is a simple boolean true/false flag. For enumeration
71             fuses, each value item has the following fields:
72              
73             $value->name
74             $value->value
75             $value->caption
76              
77             =cut
78              
79             sub fuses
80             {
81 0     0 1   my $self = shift;
82 0           return @{ $self->{fuses} };
  0            
83             }
84              
85             =head2 %fields = $fuseinfo->unpack( $bytes )
86              
87             Given a byte string containing all the fuses read from the device, unpacks
88             them and returns a key-value list giving the current value of every fuse.
89              
90             =cut
91              
92             sub unpack
93             {
94 0     0 1   my $self = shift;
95 0           my ( $bytes ) = @_;
96              
97 0           my %ret;
98 0           foreach my $f ( $self->fuses ) {
99 0           my $bits = ord( substr $bytes, $f->offset, 1 ) & $f->mask;
100              
101 0           $ret{$f->name} = $bits;
102             }
103              
104 0           return %ret;
105             }
106              
107             =head2 $bytes = $fuseinfo->pack( %fields )
108              
109             Given a key-value list containing fuse values, packs them into a byte string
110             suitable to write onto the device and returns it.
111              
112             =cut
113              
114             sub pack
115             {
116 0     0 1   my $self = shift;
117 0           my %fuses = @_;
118              
119 0           my $bytes = ~$self->{mask};
120 0           foreach my $f ( $self->fuses ) {
121 0           my $v = $fuses{$f->name};
122              
123 0 0         if( $f->values ) {
124             # Value check enum fuse
125 0 0         croak "Invalid value for ${\$f->name}: $v" if $v & ~$f->mask;
  0            
126             }
127             else {
128 0 0         $v = $f->mask if $v;
129             }
130              
131 0           substr( $bytes, $f->offset, 1 ) |= chr( $f->mask & $v );
132             }
133              
134 0           return $bytes;
135             }
136              
137             my $info;
138              
139             LINE: while( my $line = ) {
140             if( $line =~ m/^DEVICE name=(\S+)$/ ) {
141             $info = {} if keys %$info; # new device
142             $info_for{$1} = $info;
143             }
144             elsif( $line =~ m/^MASK (\d+) (\d+)$/ ) {
145             $info->{mask} ||= "";
146             $info->{mask} .= "\0" until length $info->{mask} >= $1;
147             substr( $info->{mask}, $1, 1 ) = chr $2;
148             }
149             elsif( $line =~ m/^BIT (\S+) (\d+) (\d+): (.*)$/ ) {
150             push @{ $info->{fuses} }, Fuse( $1, $2, $3+0, $4, undef );
151             }
152             elsif( $line =~ m/^ENUM (\S+) (\d+) (\d+): (.*)$/ ) {
153             my $values = [];
154             push @{ $info->{fuses} }, Fuse( $1, $2, $3+0, $4, $values );
155              
156             while( $line = ) {
157             $line =~ m/^ VALUE (\S+) (\d+): (.*)$/ or redo LINE;
158             push @$values, FuseEnumValue( $1, $2, $3 );
159             }
160             }
161             }
162              
163             =head1 AUTHOR
164              
165             Paul Evans
166              
167             =cut
168              
169             0x55AA;
170              
171             __DATA__