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   59 use v5.26;
  5         19  
4 5     5   27 use strict;
  5         14  
  5         100  
5 5     5   22 use warnings;
  5         10  
  5         144  
6 5     5   25 no indirect;
  5         10  
  5         66  
7              
8 5     5   274 use Carp;
  5         11  
  5         338  
9 5     5   2489 use Module::Load;
  5         6018  
  5         31  
10 5     5   311 use constant NOT_IMPLEMENTED => 'Method not implemented';
  5         11  
  5         10925  
11              
12             sub new {
13 164     164 0 559 my ($class, %params) = @_;
14              
15 164         364 my $self = bless {}, $class;
16 164         459 $self->{signature} = $params{signature};
17 164         330 $self->{data} = $params{data};
18              
19 164         515 $self->configure();
20              
21 164         817 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 2162 return shift->{static} //= [];
36             }
37              
38             sub push_static {
39 122     122 0 242 my ($self, $data) = @_;
40 122 100       228 push($self->static->@*, ref $data eq 'ARRAY' ? $data->@* : $data);
41             }
42              
43             sub dynamic {
44 607   100 607 0 1822 return shift->{dynamic} //= [];
45             }
46              
47             sub push_dynamic {
48 66     66 0 137 my ($self, $data) = @_;
49 66 100       117 push($self->dynamic->@*, ref $data eq 'ARRAY' ? $data->@* : $data);
50             }
51              
52             sub signature {
53 733     733 1 4356 return shift->{signature};
54             }
55              
56             sub data {
57 234     234 1 1340 return shift->{data};
58             }
59              
60             sub fixed_length {
61 42     42 0 75 my $self = shift;
62 42 100       80 if ($self->signature =~ /[a-z](\d+)/) {
63 28         127 return $1;
64             }
65 14         45 return undef;
66             }
67              
68             sub pad_right {
69 16     16 0 44 my ($self, $data) = @_;
70              
71 16         28 my @chunks;
72 16         144 push(@chunks, $_ . '0' x (64 - length $_)) for unpack("(A64)*", $data);
73              
74 16         65 return \@chunks;
75             }
76              
77             sub pad_left {
78 42     42 0 3358 my ($self, $data) = @_;
79              
80 42         68 my @chunks;
81 42         300 push(@chunks, sprintf("%064s", $_)) for unpack("(A64)*", $data);
82              
83 42         177 return \@chunks;
84              
85             }
86              
87             sub encode_length {
88 23     23 0 58 my ($self, $length) = @_;
89 23         147 return sprintf("%064s", sprintf("%x", $length));
90             }
91              
92             sub encode_offset {
93 25     25 0 72 my ($self, $offset) = @_;
94 25         138 return sprintf("%064s", sprintf("%x", $offset * 32));
95             }
96              
97             sub encoded {
98 541     541 0 860 my $self = shift;
99 541         978 my @data = ($self->static->@*, $self->dynamic->@*);
100 541 100       1892 return scalar @data ? \@data : undef;
101             }
102              
103             sub is_dynamic {
104 359 100   359 0 678 return shift->signature =~ /(bytes|string)(?!\d+)|(\[\])/ ? 1 : 0;
105             }
106              
107             sub new_type {
108 144     144 1 427 my (%params) = @_;
109              
110 144         265 my $signature = $params{signature};
111              
112 144         229 my $module;
113 144 100       1110 if ($signature =~ /\[(\d+)?\]$/gm) {
    100          
    100          
    100          
    100          
    100          
114 20         43 $module = "Array";
115             } elsif ($signature =~ /^\(.*\)/) {
116 12         30 $module = "Tuple";
117             } elsif ($signature =~ /^address$/) {
118 22         43 $module = "Address";
119             } elsif ($signature =~ /^(u)?(int|bool)(\d+)?$/) {
120 63         133 $module = "Int";
121             } elsif ($signature =~ /^(?:bytes)(\d+)?$/) {
122 21         45 $module = "Bytes";
123             } elsif ($signature =~ /^string$/) {
124 5         12 $module = "String";
125             } else {
126 1         93 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         240 my $_package = __PACKAGE__;
131 143         505 my $package = sprintf("%s::%s", $_package, $module);
132 143         452 load $package;
133             return $package->new(
134             signature => $signature,
135 143         7909 data => $params{data});
136             }
137              
138             sub instances {
139 391   100 391 0 7886 return shift->{instances} //= [];
140             }
141              
142             sub get_initial_offset {
143 38     38 0 77 my $self = shift;
144 38         64 my $offset = 0;
145 38         97 for my $param ($self->instances->@*) {
146 88         278 my $encoded = $param->encode;
147 82 100       208 if ($param->is_dynamic) {
148 25         70 $offset += 1;
149             } else {
150 57         127 $offset += scalar $param->encoded->@*;
151             }
152             }
153              
154 32         116 return $offset;
155             }
156              
157             sub static_size {
158 66     66 0 144 return 1;
159             }
160              
161             sub read_stack_set_data {
162 14     14 0 27 my $self = shift;
163              
164 14         32 my @data = $self->data->@*;
165 14         25 my @offsets;
166 14         26 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       93 if ($instance->is_dynamic) {
173 8         30 push @offsets, hex($data[$current_offset]) / 32;
174             }
175              
176 39         69 my $size = 1;
177 39 100       69 $size = $instance->static_size unless $instance->is_dynamic;
178 39         79 $current_offset += $size;
179             }
180              
181 14         25 $current_offset = 0;
182 14         23 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         35 for (my $i = 0; $i < $self->instances->@*; $i++) {
186 39         68 my $instance = $self->instances->[$i];
187 39 100       74 next unless $instance->is_dynamic;
188 8         21 my $offset_start = shift @offsets;
189 8   100     32 my $offset_end = $offsets[0] // scalar @data - 1;
190 8         43 my @range = @data[$offset_start .. $offset_end];
191 8         25 $instance->{data} = \@range;
192 8         13 $current_offset += scalar @range;
193 8         36 $response{$i} = $instance->decode();
194             }
195              
196 14         29 $current_offset = 0;
197              
198 14         30 for (my $i = 0; $i < $self->instances->@*; $i++) {
199 39         102 my $instance = $self->instances->[$i];
200              
201 39 100       81 if ($instance->is_dynamic) {
202 8         13 $current_offset++;
203 8         19 next;
204             }
205              
206 31         58 my $size = 1;
207 31 50       60 $size = $instance->static_size unless $instance->is_dynamic;
208 31         131 my @range = @data[$current_offset .. $current_offset + $size - 1];
209 31         63 $instance->{data} = \@range;
210 31         50 $current_offset += $size;
211              
212 31         110 $response{$i} = $instance->decode();
213             }
214              
215 14         23 my @array_response;
216             # the given order of type signatures needs to be strict followed
217 14         29 push(@array_response, $response{$_}) for 0 .. scalar $self->instances->@* - 1;
218 14         81 return \@array_response;
219             }
220              
221             1;
222              
223             __END__
224              
225             =pod
226              
227             =encoding UTF-8
228              
229             =head1 NAME
230              
231             Blockchain::Contract::Solidity::ABI::Type - Interface for solidity variable types
232              
233             =head1 SYNOPSIS
234              
235             Allows you to define and instantiate a solidity variable type:
236              
237             my $type = Blockchain::Contract::Solidity::ABI::Type::new_type(
238             signature => $signature,
239             data => $value
240             );
241              
242             $type->encode();
243             ...
244              
245             In most cases you don't want to use this directly, use instead:
246              
247             =over 4
248              
249             =item * B<Encoder>: L<Blockchain::Contract::Solidity::ABI::Encoder>
250              
251             =item * B<Decoder>: L<Blockchain::Contract::Solidity::ABI::Decoder>
252              
253             =back
254              
255             =head1 METHODS
256              
257             =head2 new_type
258              
259             Create a new L<Blockchain::Contract::Solidity::ABI::Type> instance based
260             in the given signature.
261              
262             Usage:
263              
264             new_type(signature => signature, data => value) -> L<Blockchain::Contract::Solidity::ABI::Type::*>
265              
266             =over 4
267              
268             =item * C<%params> signature and data key values
269              
270             =back
271              
272             Returns an new instance of one of the sub modules for L<Blockchain::Contract::Solidity::ABI::Type>
273              
274             =head1 AUTHOR
275              
276             Reginaldo Costa, C<< <refeco at cpan.org> >>
277              
278             =head1 BUGS
279              
280             Please report any bugs or feature requests to L<https://github.com/refeco/perl-ABI>
281              
282             =head1 SUPPORT
283              
284             You can find documentation for this module with the perldoc command.
285              
286             perldoc Blockchain::Contract::Solidity::ABI::Type
287              
288             =head1 LICENSE AND COPYRIGHT
289              
290             This software is Copyright (c) 2022 by Reginaldo Costa.
291              
292             This is free software, licensed under:
293              
294             The Artistic License 2.0 (GPL Compatible)
295              
296             =cut
297