File Coverage

blib/lib/Blockchain/Ethereum/ABI/Type.pm
Criterion Covered Total %
statement 112 114 98.2
branch 33 34 97.0
condition 8 8 100.0
subroutine 26 28 92.8
pod 6 8 75.0
total 185 192 96.3


line stmt bran cond sub pod time code
1             package Blockchain::Ethereum::ABI::Type;
2              
3 5     5   62 use v5.26;
  5         18  
4 5     5   28 use strict;
  5         20  
  5         111  
5 5     5   30 use warnings;
  5         12  
  5         138  
6              
7 5     5   37 use Carp;
  5         11  
  5         284  
8 5     5   2367 use Module::Load;
  5         5946  
  5         31  
9 5     5   306 use constant NOT_IMPLEMENTED => 'Method not implemented';
  5         12  
  5         7642  
10              
11             sub new {
12 164     164 0 537 my ($class, %params) = @_;
13              
14 164         402 my $self = bless {}, $class;
15 164         456 $self->{signature} = $params{signature};
16 164         304 $self->{data} = $params{data};
17              
18 164         473 $self->_configure();
19              
20 164         784 return $self;
21             }
22              
23       111     sub _configure { }
24              
25             sub encode {
26 0     0 1 0 croak NOT_IMPLEMENTED;
27             }
28              
29             sub decode {
30 0     0 1 0 croak NOT_IMPLEMENTED;
31             }
32              
33             sub _static {
34 663   100 663   2044 return shift->{static} //= [];
35             }
36              
37             sub _push_static {
38 122     122   221 my ($self, $data) = @_;
39 122 100       223 push($self->_static->@*, ref $data eq 'ARRAY' ? $data->@* : $data);
40             }
41              
42             sub _dynamic {
43 607   100 607   1796 return shift->{dynamic} //= [];
44             }
45              
46             sub _push_dynamic {
47 66     66   532 my ($self, $data) = @_;
48 66 100       124 push($self->_dynamic->@*, ref $data eq 'ARRAY' ? $data->@* : $data);
49             }
50              
51             sub _signature {
52 733     733   4633 return shift->{signature};
53             }
54              
55             sub _data {
56 234     234   1338 return shift->{data};
57             }
58              
59             sub fixed_length {
60 42     42 1 68 my $self = shift;
61 42 100       76 if ($self->_signature =~ /[a-z](\d+)/) {
62 28         148 return $1;
63             }
64 14         44 return undef;
65             }
66              
67             sub pad_right {
68 16     16 1 38 my ($self, $data) = @_;
69              
70 16         28 my @chunks;
71 16         115 push(@chunks, $_ . '0' x (64 - length $_)) for unpack("(A64)*", $data);
72              
73 16         62 return \@chunks;
74             }
75              
76             sub pad_left {
77 42     42 1 3364 my ($self, $data) = @_;
78              
79 42         73 my @chunks;
80 42         254 push(@chunks, sprintf("%064s", $_)) for unpack("(A64)*", $data);
81              
82 42         180 return \@chunks;
83              
84             }
85              
86             sub _encode_length {
87 23     23   52 my ($self, $length) = @_;
88 23         131 return sprintf("%064s", sprintf("%x", $length));
89             }
90              
91             sub _encode_offset {
92 25     25   55 my ($self, $offset) = @_;
93 25         137 return sprintf("%064s", sprintf("%x", $offset * 32));
94             }
95              
96             sub _encoded {
97 541     541   782 my $self = shift;
98 541         895 my @data = ($self->_static->@*, $self->_dynamic->@*);
99 541 100       1830 return scalar @data ? \@data : undef;
100             }
101              
102             sub is_dynamic {
103 359 100   359 0 671 return shift->_signature =~ /(bytes|string)(?!\d+)|(\[\])/ ? 1 : 0;
104             }
105              
106             sub new_type {
107 144     144 1 409 my (%params) = @_;
108              
109 144         260 my $signature = $params{signature};
110              
111 144         212 my $module;
112 144 100       1068 if ($signature =~ /\[(\d+)?\]$/gm) {
    100          
    100          
    100          
    100          
    100          
113 20         43 $module = "Array";
114             } elsif ($signature =~ /^\(.*\)/) {
115 12         25 $module = "Tuple";
116             } elsif ($signature =~ /^address$/) {
117 22         53 $module = "Address";
118             } elsif ($signature =~ /^(u)?(int|bool)(\d+)?$/) {
119 63         123 $module = "Int";
120             } elsif ($signature =~ /^(?:bytes)(\d+)?$/) {
121 21         47 $module = "Bytes";
122             } elsif ($signature =~ /^string$/) {
123 5         15 $module = "String";
124             } else {
125 1         94 croak "Module not found for the given parameter signature $signature";
126             }
127              
128             # this is just to avoid `use module` for every new type included
129 143         213 my $_package = __PACKAGE__;
130 143         521 my $package = sprintf("%s::%s", $_package, $module);
131 143         486 load $package;
132             return $package->new(
133             signature => $signature,
134 143         7984 data => $params{data});
135             }
136              
137             sub _instances {
138 391   100 391   8153 return shift->{instances} //= [];
139             }
140              
141             # get the first index where data is set to the encoded value
142             # skipping the prefixed indexes
143             sub _get_initial_offset {
144 38     38   71 my $self = shift;
145 38         55 my $offset = 0;
146 38         84 for my $param ($self->_instances->@*) {
147 88         283 my $encoded = $param->encode;
148 82 100       202 if ($param->is_dynamic) {
149 25         77 $offset += 1;
150             } else {
151 57         113 $offset += scalar $param->_encoded->@*;
152             }
153             }
154              
155 32         80 return $offset;
156             }
157              
158             sub _static_size {
159 66     66   145 return 1;
160             }
161              
162             # read the data at the encoded stack
163             sub _read_stack_set_data {
164 14     14   22 my $self = shift;
165              
166 14         31 my @data = $self->_data->@*;
167 14         25 my @offsets;
168 14         20 my $current_offset = 0;
169              
170             # Since at this point we don't information about the chunks of data it is_dynamic
171             # needed to get all the offsets in the static header, so the dynamic values can
172             # be retrieved based in between the current and the next offsets
173 14         29 for my $instance ($self->_instances->@*) {
174 39 100       84 if ($instance->is_dynamic) {
175 8         28 push @offsets, hex($data[$current_offset]) / 32;
176             }
177              
178 39         64 my $size = 1;
179 39 100       62 $size = $instance->_static_size unless $instance->is_dynamic;
180 39         71 $current_offset += $size;
181             }
182              
183 14         24 $current_offset = 0;
184 14         20 my %response;
185             # Dynamic data must to be set first since the full_size method
186             # will need to use the data offset related to the size of the item
187 14         32 for (my $i = 0; $i < $self->_instances->@*; $i++) {
188 39         111 my $instance = $self->_instances->[$i];
189 39 100       71 next unless $instance->is_dynamic;
190 8         17 my $offset_start = shift @offsets;
191 8   100     56 my $offset_end = $offsets[0] // scalar @data - 1;
192 8         54 my @range = @data[$offset_start .. $offset_end];
193 8         22 $instance->{data} = \@range;
194 8         13 $current_offset += scalar @range;
195 8         28 $response{$i} = $instance->decode();
196             }
197              
198 14         23 $current_offset = 0;
199              
200 14         28 for (my $i = 0; $i < $self->_instances->@*; $i++) {
201 39         70 my $instance = $self->_instances->[$i];
202              
203 39 100       75 if ($instance->is_dynamic) {
204 8         12 $current_offset++;
205 8         54 next;
206             }
207              
208 31         53 my $size = 1;
209 31 50       56 $size = $instance->_static_size unless $instance->is_dynamic;
210 31         99 my @range = @data[$current_offset .. $current_offset + $size - 1];
211 31         62 $instance->{data} = \@range;
212 31         53 $current_offset += $size;
213              
214 31         85 $response{$i} = $instance->decode();
215             }
216              
217 14         22 my @array_response;
218             # the given order of type signatures needs to be strict followed
219 14         30 push(@array_response, $response{$_}) for 0 .. scalar $self->_instances->@* - 1;
220 14         67 return \@array_response;
221             }
222              
223             1;
224              
225             __END__