File Coverage

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