File Coverage

blib/lib/Blockchain/Contract/Solidity/ABI/Type.pm
Criterion Covered Total %
statement 115 117 98.2
branch 33 34 97.0
condition 8 8 100.0
subroutine 27 29 93.1
pod 3 22 13.6
total 186 210 88.5


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