line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package CryptoTron::JsonHttp; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Load the Perl pragmas. |
4
|
1
|
|
|
1
|
|
16
|
use 5.008008; |
|
1
|
|
|
|
|
3
|
|
5
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
21
|
|
6
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
44
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# Load the Perl pragma Exporter. |
9
|
1
|
|
|
1
|
|
7
|
use vars qw(@ISA @EXPORT @EXPORT_OK); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
50
|
|
10
|
1
|
|
|
1
|
|
5
|
use Exporter 'import'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
99
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Base class of this (tron_addr) module. |
13
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Exporting the implemented subroutine. |
16
|
|
|
|
|
|
|
our @EXPORT = qw( |
17
|
|
|
|
|
|
|
HTTP_Request |
18
|
|
|
|
|
|
|
encode_data |
19
|
|
|
|
|
|
|
json_data |
20
|
|
|
|
|
|
|
format_output |
21
|
|
|
|
|
|
|
payload_standard |
22
|
|
|
|
|
|
|
%SERVICES |
23
|
|
|
|
|
|
|
$API_URL |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# Set the package version. |
27
|
|
|
|
|
|
|
our $VERSION = '0.14'; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# Load the required Perl modules or packages. |
30
|
1
|
|
|
1
|
|
855
|
use JSON::PP; |
|
1
|
|
|
|
|
19057
|
|
|
1
|
|
|
|
|
70
|
|
31
|
1
|
|
|
1
|
|
623
|
use URI; |
|
1
|
|
|
|
|
5404
|
|
|
1
|
|
|
|
|
30
|
|
32
|
1
|
|
|
1
|
|
671
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
45214
|
|
|
1
|
|
|
|
|
47
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Load the required modules. |
35
|
1
|
|
|
1
|
|
573
|
use CryptoTron::AddressCheck; |
|
1
|
|
|
|
|
291668
|
|
|
1
|
|
|
|
|
844
|
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Set api url and api path. |
38
|
|
|
|
|
|
|
our $API_URL = 'https://api.trongrid.io'; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Define the hash with the services. |
41
|
|
|
|
|
|
|
our %SERVICES = ( |
42
|
|
|
|
|
|
|
'GetNextMaintenanceTime' => ['/wallet/getnextmaintenancetime', 'GET'], |
43
|
|
|
|
|
|
|
'BroadcastTransaction' => ['/wallet/broadcasttransaction', 'POST'], |
44
|
|
|
|
|
|
|
'FreezeBalance' => ['/wallet/freezebalance', 'POST'], |
45
|
|
|
|
|
|
|
'GetAccount' => ['/walletsolidity/getaccount', 'POST'], |
46
|
|
|
|
|
|
|
'GetBrokerage' => ['/wallet/getBrokerage', 'POST'], |
47
|
|
|
|
|
|
|
'GetAccountBalance' => ['/wallet/getaccountbalance', 'POST'], |
48
|
|
|
|
|
|
|
'GetAccountNet' => ['/wallet/getaccountnet', 'POST'], |
49
|
|
|
|
|
|
|
'GetAccountResource' => ['/wallet/getaccountresource', 'POST'], |
50
|
|
|
|
|
|
|
'GetReward' => ['/wallet/getReward', 'POST'], |
51
|
|
|
|
|
|
|
'UnfreezeBalance' => ['/wallet/unfreezebalance', 'POST'], |
52
|
|
|
|
|
|
|
'WithdrawBalance' => ['/wallet/withdrawbalance', 'POST'] |
53
|
|
|
|
|
|
|
); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# Configure a new JSON:PP object. |
56
|
|
|
|
|
|
|
our $indent_enable = "true"; |
57
|
|
|
|
|
|
|
our $indent_spaces = 4; |
58
|
|
|
|
|
|
|
our $JSON; |
59
|
|
|
|
|
|
|
$JSON = 'JSON::PP'->new->pretty; |
60
|
|
|
|
|
|
|
$JSON = $JSON->indent($indent_enable); |
61
|
|
|
|
|
|
|
$JSON = $JSON->indent_length($indent_spaces); |
62
|
|
|
|
|
|
|
$JSON = $JSON->allow_unknown("true"); |
63
|
|
|
|
|
|
|
$JSON = $JSON->allow_blessed("true"); |
64
|
|
|
|
|
|
|
$JSON = $JSON->allow_singlequote("true"); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
67
|
|
|
|
|
|
|
# Subroutine payload_standard() # |
68
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
69
|
|
|
|
|
|
|
sub payload_standard { |
70
|
|
|
|
|
|
|
# Assign the subroutine arguments to the local array. |
71
|
0
|
|
|
0
|
0
|
|
my ($args) = @_; |
72
|
|
|
|
|
|
|
# Set the local variables. |
73
|
0
|
|
|
|
|
|
my $addr = $args->{PublicKey}; |
74
|
0
|
|
|
|
|
|
my $flag = $args->{VisibleFlag}; |
75
|
0
|
|
|
|
|
|
my $chk = $args->{ControlFlag}; |
76
|
|
|
|
|
|
|
# Check if the the local variables are defined. |
77
|
0
|
0
|
|
|
|
|
$addr = (defined $addr ? $addr : ""); |
78
|
0
|
0
|
|
|
|
|
$chk = (defined $chk ? $chk : "True"); |
79
|
0
|
0
|
|
|
|
|
$flag = (defined $flag ? $flag : "True"); |
80
|
|
|
|
|
|
|
# Initialise the local variable $payload. |
81
|
0
|
|
|
|
|
|
my $payload = ""; |
82
|
|
|
|
|
|
|
# Check if the $address is not empty. |
83
|
0
|
0
|
|
|
|
|
if ($addr ne "") { |
84
|
0
|
0
|
|
|
|
|
if ($chk eq "True") { |
85
|
|
|
|
|
|
|
# Check variable $visible. |
86
|
|
|
|
|
|
|
#my $isBase58Addr = ($flag eq "True" && chk_base58_addr($addr) != 1); |
87
|
|
|
|
|
|
|
#my $isHexAddr = ($flag eq "False" && chk_hex_addr($addr) != 1); |
88
|
0
|
0
|
0
|
|
|
|
if ($flag eq "True" && chk_base58_addr($addr) != 1) { |
|
|
0
|
0
|
|
|
|
|
89
|
0
|
|
|
|
|
|
$flag = "False"; |
90
|
|
|
|
|
|
|
} elsif ($flag eq "False" && chk_hex_addr($addr) != 1) { |
91
|
0
|
|
|
|
|
|
$flag = "True"; |
92
|
|
|
|
|
|
|
}; |
93
|
|
|
|
|
|
|
}; |
94
|
|
|
|
|
|
|
# Create the payload from the address. |
95
|
0
|
|
|
|
|
|
$payload = "\{\"address\":\"${addr}\",\"visible\":\"${flag}\"\}"; |
96
|
|
|
|
|
|
|
}; |
97
|
|
|
|
|
|
|
# Return the payload string. |
98
|
0
|
|
|
|
|
|
return $payload; |
99
|
|
|
|
|
|
|
}; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
102
|
|
|
|
|
|
|
# Subroutine json_data() # |
103
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
104
|
|
|
|
|
|
|
sub json_data { |
105
|
|
|
|
|
|
|
# Assign the arguments to the local array. |
106
|
0
|
|
|
0
|
0
|
|
my ($args) = @_; |
107
|
|
|
|
|
|
|
# Set the local variables. |
108
|
0
|
0
|
|
|
|
|
my $outfmt = (defined $args->{OutputFormat} ? $args->{OutputFormat} : "RAW"); |
109
|
|
|
|
|
|
|
# Get the name of the calling module. |
110
|
0
|
|
|
|
|
|
my $module_name = $args->{ModuleName}; |
111
|
|
|
|
|
|
|
# Get the payload string. |
112
|
0
|
|
|
|
|
|
my $payload = $args->{PayloadString}; |
113
|
|
|
|
|
|
|
# Get service url and related method. |
114
|
0
|
|
|
|
|
|
my $service_url = $API_URL.$SERVICES{$module_name}[0]; |
115
|
0
|
|
|
|
|
|
my $method = $SERVICES{$module_name}[1]; |
116
|
0
|
|
|
|
|
|
my $content = ""; |
117
|
|
|
|
|
|
|
# Initialise the return variable. |
118
|
0
|
|
|
|
|
|
my $output_data = "{}"; |
119
|
|
|
|
|
|
|
# Get the content from the service url. |
120
|
0
|
|
|
|
|
|
($content, undef, undef, undef) = HTTP_Request($service_url, $method, $payload); |
121
|
|
|
|
|
|
|
# Format the content for the output. |
122
|
0
|
|
|
|
|
|
$output_data = format_output($content, $outfmt); |
123
|
|
|
|
|
|
|
# Return the JSON data raw or formatted. |
124
|
0
|
|
|
|
|
|
return $output_data; |
125
|
|
|
|
|
|
|
}; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
128
|
|
|
|
|
|
|
# Subroutine format_output() # |
129
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
130
|
|
|
|
|
|
|
sub format_output { |
131
|
|
|
|
|
|
|
# Assign the subroutine arguments to the local variables. |
132
|
0
|
|
|
0
|
0
|
|
my ($content, $outflag) = @_; |
133
|
|
|
|
|
|
|
# Declare the return variable. |
134
|
0
|
|
|
|
|
|
my $output; |
135
|
|
|
|
|
|
|
# Format the content for the output. |
136
|
0
|
0
|
|
|
|
|
if ($outflag eq "RAW") { |
137
|
|
|
|
|
|
|
# Use the content as it is. |
138
|
0
|
|
|
|
|
|
$output = $content; |
139
|
|
|
|
|
|
|
} else { |
140
|
|
|
|
|
|
|
# Encode the content. |
141
|
0
|
|
|
|
|
|
$output = encode_data($content); |
142
|
|
|
|
|
|
|
}; |
143
|
|
|
|
|
|
|
# Return formatted output. |
144
|
0
|
|
|
|
|
|
return $output; |
145
|
|
|
|
|
|
|
}; |
146
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
147
|
|
|
|
|
|
|
# Subroutine encode_data() # |
148
|
|
|
|
|
|
|
# # |
149
|
|
|
|
|
|
|
# Description: # |
150
|
|
|
|
|
|
|
# At first glance, it is not obvious why the response should be decoded and # |
151
|
|
|
|
|
|
|
# then encoded back again. However, if one assumes that the response can have # |
152
|
|
|
|
|
|
|
# any structure, this procedure makes sense. Decoding creates a Perl data # |
153
|
|
|
|
|
|
|
# structure from the response. Encoding then creates a formatted string from # |
154
|
|
|
|
|
|
|
# the Perl data structure. # |
155
|
|
|
|
|
|
|
# # |
156
|
|
|
|
|
|
|
# @argument $content Content from response (scalar) # |
157
|
|
|
|
|
|
|
# @return $encoded Encoded formatted content (scalar) # |
158
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
159
|
|
|
|
|
|
|
sub encode_data { |
160
|
|
|
|
|
|
|
# Assign the subroutine argument to the local variable. |
161
|
0
|
|
|
0
|
0
|
|
my $content = $_[0]; |
162
|
|
|
|
|
|
|
# Decode the content of the response using 'JSON:PP'. |
163
|
0
|
|
|
|
|
|
my $decoded = $JSON->decode($content); |
164
|
|
|
|
|
|
|
# Encode the content of the response using 'JSON:PP'. |
165
|
0
|
|
|
|
|
|
my $encoded = $JSON->encode($decoded); |
166
|
|
|
|
|
|
|
# Return the encoded formatted JSON content. |
167
|
0
|
|
|
|
|
|
return $encoded; |
168
|
|
|
|
|
|
|
}; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
171
|
|
|
|
|
|
|
# Subroutine HTTP_Request() # |
172
|
|
|
|
|
|
|
# # |
173
|
|
|
|
|
|
|
# Description: # |
174
|
|
|
|
|
|
|
# The subroutine is using the HTTP methods GET or POST to send a request to a # |
175
|
|
|
|
|
|
|
# known servive url of the FULL-NODE HTTP API. On success a content in form of # |
176
|
|
|
|
|
|
|
# JSON data is returned. # |
177
|
|
|
|
|
|
|
# # |
178
|
|
|
|
|
|
|
# @argument $service_url Service url (scalar) # |
179
|
|
|
|
|
|
|
# @return $content Response content (scalar) # |
180
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- # |
181
|
|
|
|
|
|
|
sub HTTP_Request { |
182
|
|
|
|
|
|
|
# Assign the subroutine arguments to the local variables. |
183
|
0
|
|
|
0
|
0
|
|
my ($service_url, $method, $payload) = @_; |
184
|
|
|
|
|
|
|
# Initialise the local variables. |
185
|
0
|
|
|
|
|
|
my $content = ""; |
186
|
0
|
|
|
|
|
|
my $response = ""; |
187
|
0
|
|
|
|
|
|
my $errcode = ""; |
188
|
0
|
|
|
|
|
|
my $errmsg = ""; |
189
|
|
|
|
|
|
|
# Create a new uri object from the service url. |
190
|
0
|
|
|
|
|
|
my $uri = URI->new($service_url); |
191
|
|
|
|
|
|
|
# Create a new user agent object. |
192
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new(); |
193
|
|
|
|
|
|
|
# Set the default header of the request. |
194
|
0
|
|
|
|
|
|
$ua->default_header('Accept' => 'application/json'); |
195
|
0
|
|
|
|
|
|
$ua->default_header('Content_Type' => 'application/json'); |
196
|
|
|
|
|
|
|
# Get the response from the uri based on the given HTTP method. |
197
|
0
|
0
|
|
|
|
|
if ($method eq 'POST') { |
|
|
0
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
$response = $ua->post($uri, 'Content' => $payload); |
199
|
|
|
|
|
|
|
} elsif ($method eq 'GET') { |
200
|
0
|
|
|
|
|
|
$response = $ua->get($uri, 'Content' => $payload); |
201
|
|
|
|
|
|
|
}; |
202
|
|
|
|
|
|
|
# Get error code and error message. |
203
|
0
|
|
|
|
|
|
$errcode = $response->code; |
204
|
0
|
|
|
|
|
|
$errmsg = $response->message; |
205
|
|
|
|
|
|
|
# Check success of operation. |
206
|
0
|
0
|
|
|
|
|
if ($response->is_success) { |
207
|
|
|
|
|
|
|
# Get the content from the response. |
208
|
0
|
|
|
|
|
|
$content = $response->content; |
209
|
|
|
|
|
|
|
} else { |
210
|
|
|
|
|
|
|
# Set the content to an empty string. |
211
|
0
|
|
|
|
|
|
$content = ""; |
212
|
|
|
|
|
|
|
}; |
213
|
|
|
|
|
|
|
# Return content, error code, error message and service url. |
214
|
0
|
|
|
|
|
|
return ($content, $errcode, $errmsg, $service_url); |
215
|
|
|
|
|
|
|
}; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
1; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
__END__ |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head1 NAME |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
CryptoTron::JsonHttp - Perl extension for use with the blockchain of the crypto coin Tron. |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head1 SYNOPSIS |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
None |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head1 DESCRIPTION |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
None |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head1 SEE ALSO |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
Try::Catch |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
POSIX |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
URI |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
LWP::UserAgent |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
JSON::PP |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head1 AUTHOR |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Dr. Peter Netz, E<lt>ztenretep@cpan.orgE<gt> |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
Copyright (C) 2022 by Dr. Peter Netz |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
The MIT License |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person |
256
|
|
|
|
|
|
|
obtaining a copy of this software and associated |
257
|
|
|
|
|
|
|
documentation files (the "Software"), to deal in the Software |
258
|
|
|
|
|
|
|
without restriction, including without limitation the rights to |
259
|
|
|
|
|
|
|
use, copy, modify, merge, publish, distribute, sublicense, |
260
|
|
|
|
|
|
|
and/or sell copies of the Software, and to permit persons to |
261
|
|
|
|
|
|
|
whom the Software is furnished to do so, subject to the |
262
|
|
|
|
|
|
|
following conditions: |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall |
265
|
|
|
|
|
|
|
be included in all copies or substantial portions of the |
266
|
|
|
|
|
|
|
Software. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT |
269
|
|
|
|
|
|
|
WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, |
270
|
|
|
|
|
|
|
INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF |
271
|
|
|
|
|
|
|
MERCHANTABILITY, FITNESS FOR A PARTICULAR |
272
|
|
|
|
|
|
|
PURPOSE AND NONINFRINGEMENT. IN NO EVENT |
273
|
|
|
|
|
|
|
SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE |
274
|
|
|
|
|
|
|
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
275
|
|
|
|
|
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, |
276
|
|
|
|
|
|
|
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN |
277
|
|
|
|
|
|
|
CONNECTION WITH THE SOFTWARE OR THE USE OR |
278
|
|
|
|
|
|
|
OTHER DEALINGS IN THE SOFTWARE. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=cut |