line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IO::Iron::Common; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
## no critic (Documentation::RequirePodAtEnd) |
4
|
|
|
|
|
|
|
## no critic (Documentation::RequirePodSections) |
5
|
|
|
|
|
|
|
## no critic (Subroutines::RequireArgUnpacking) |
6
|
|
|
|
|
|
|
|
7
|
8
|
|
|
8
|
|
700
|
use 5.010_000; |
|
8
|
|
|
|
|
27
|
|
8
|
8
|
|
|
8
|
|
45
|
use strict; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
161
|
|
9
|
8
|
|
|
8
|
|
38
|
use warnings; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
183
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Global creator |
12
|
|
|
|
8
|
|
|
BEGIN { |
13
|
|
|
|
|
|
|
# No exports |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Global destructor |
17
|
|
|
|
8
|
|
|
END { |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# ABSTRACT: Common routines for Client Libraries to Iron services IronCache, IronMQ and IronWorker. |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = '0.12_01'; # TRIAL VERSION: generated by DZP::OurPkgVersion |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
8
|
|
|
8
|
|
6596
|
use Path::Tiny qw{path}; |
|
8
|
|
|
|
|
89958
|
|
|
8
|
|
|
|
|
494
|
|
28
|
8
|
|
|
8
|
|
583
|
use Try::Tiny; |
|
8
|
|
|
|
|
1979
|
|
|
8
|
|
|
|
|
423
|
|
29
|
8
|
|
|
8
|
|
542
|
use Log::Any qw{$log}; |
|
8
|
|
|
|
|
8151
|
|
|
8
|
|
|
|
|
59
|
|
30
|
|
|
|
|
|
|
require JSON::MaybeXS; |
31
|
8
|
|
|
8
|
|
3753
|
use File::Spec (); |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
121
|
|
32
|
8
|
|
|
8
|
|
3304
|
use File::HomeDir (); |
|
8
|
|
|
|
|
35008
|
|
|
8
|
|
|
|
|
244
|
|
33
|
8
|
|
|
8
|
|
560
|
use Hash::Util 0.06 qw{lock_keys unlock_keys}; |
|
8
|
|
|
|
|
2869
|
|
|
8
|
|
|
|
|
71
|
|
34
|
8
|
|
|
8
|
|
1098
|
use Carp::Assert::More; |
|
8
|
|
|
|
|
4367
|
|
|
8
|
|
|
|
|
1243
|
|
35
|
8
|
|
|
8
|
|
499
|
use English '-no_match_vars'; |
|
8
|
|
|
|
|
1747
|
|
|
8
|
|
|
|
|
78
|
|
36
|
8
|
|
|
8
|
|
3572
|
use Params::Validate qw(:all); |
|
8
|
|
|
|
|
6565
|
|
|
8
|
|
|
|
|
7761
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub IRON_CONFIG_KEYS { |
42
|
|
|
|
|
|
|
return ( |
43
|
|
|
|
|
|
|
# Iron.io standard: |
44
|
12
|
|
|
12
|
1
|
53
|
'project_id', # The ID of the project to use for requests. |
45
|
|
|
|
|
|
|
'token', # The OAuth token that should be used to authenticate requests. Can be found in the HUD. |
46
|
|
|
|
|
|
|
'host', # The domain name the API can be located at. Defaults to a product-specific value, but always using Amazon's cloud. |
47
|
|
|
|
|
|
|
'protocol', # The protocol that will be used to communicate with the API. Defaults to "https", which should be sufficient for 99% of users. |
48
|
|
|
|
|
|
|
'port', # The port to connect to the API through. Defaults to 443, which should be sufficient for 99% of users. |
49
|
|
|
|
|
|
|
'api_version', # The version of the API to connect through. Defaults to the version supported by the client. End-users should probably never change this. Except: IronMQ service upgraded from v2 to v3 in 2015! |
50
|
|
|
|
|
|
|
# IO::Iron additions: |
51
|
|
|
|
|
|
|
'timeout', # REST client timeout (for REST calls accessing IronMQ). N.B. This is not a IronMQ config option! It only configures client this client. |
52
|
|
|
|
|
|
|
'policies', # Filename of JSON file containing policies. |
53
|
|
|
|
|
|
|
); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub IRON_CLIENT_PARAMETERS { |
58
|
|
|
|
|
|
|
return ( |
59
|
3
|
|
|
3
|
1
|
12
|
IRON_CONFIG_KEYS(), |
60
|
|
|
|
|
|
|
'config', # The config file name. |
61
|
|
|
|
|
|
|
'connector', # Reference to a preinitiated connector object. |
62
|
|
|
|
|
|
|
# 'policy', # Reference to a preinitiated policy hash. |
63
|
|
|
|
|
|
|
); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub get_config { ## no critic (Subroutines::RequireArgUnpacking) |
68
|
|
|
|
|
|
|
my %params = validate( |
69
|
|
|
|
|
|
|
@_, { |
70
|
3
|
|
|
3
|
1
|
9
|
map { $_ => { type => SCALAR, optional => 1 }, } IRON_CONFIG_KEYS(), ## no critic (ValuesAndExpressions::ProhibitCommaSeparatedStatements) |
|
30
|
|
|
|
|
171
|
|
71
|
|
|
|
|
|
|
'config' => { type => SCALAR, optional => 1, }, |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
); |
74
|
3
|
|
|
|
|
40
|
$log->tracef('Entering get_config(%s)', \%params); |
75
|
3
|
|
|
|
|
483
|
my %config = ( map { $_ => undef } IRON_CONFIG_KEYS() ); ## preset config keys. |
|
24
|
|
|
|
|
50
|
|
76
|
3
|
|
|
|
|
22
|
lock_keys(%config, IRON_CONFIG_KEYS()); |
77
|
3
|
|
|
|
|
287
|
_read_iron_config_file(\%config, File::Spec->catfile(File::HomeDir->my_home, '.iron.json')); # Homedir |
78
|
3
|
|
|
|
|
28
|
_read_iron_config_env_vars(\%config); # Global envs |
79
|
3
|
|
|
|
|
48
|
_read_iron_config_file(\%config, File::Spec->catfile(File::Spec->curdir(), 'iron.json')); # current dir |
80
|
3
|
100
|
|
|
|
21
|
if(defined $params{'config'}) { # config file specified when creating the class, if given. |
81
|
|
|
|
|
|
|
_read_iron_config_file(\%config, |
82
|
|
|
|
|
|
|
File::Spec->file_name_is_absolute($params{'config'}) |
83
|
1
|
50
|
|
|
|
20
|
? $params{'config'} : File::Spec->catfile(File::Spec->curdir(), $params{'config'}) |
84
|
|
|
|
|
|
|
); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
# The parameters given when the object was created, except 'config' |
87
|
3
|
|
|
|
|
10
|
my @copy_param_keys = grep { !/^config$/msx} keys %params; |
|
5
|
|
|
|
|
22
|
|
88
|
3
|
|
|
|
|
15
|
@config{@copy_param_keys} = @params{@copy_param_keys}; |
89
|
|
|
|
|
|
|
|
90
|
3
|
|
|
|
|
10
|
$log->tracef('Exiting get_config: %s', \%config); |
91
|
3
|
|
|
|
|
498
|
return \%config; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# Replace the existing values in $config if new environment variables found. |
95
|
|
|
|
|
|
|
# Vars: |
96
|
|
|
|
|
|
|
# $config->{'project_id'} = $ENV{'IRON_PROJECT_ID'} |
97
|
|
|
|
|
|
|
# $config->{'token'} = $ENV{'IRON_TOKEN'} |
98
|
|
|
|
|
|
|
# $config->{'host'} = $ENV{'IRON_HOST'} |
99
|
|
|
|
|
|
|
# $config->{'protocol'} = $ENV{'IRON_PROTOCOL'} |
100
|
|
|
|
|
|
|
# $config->{'port'} = $ENV{'IRON_PORT'} |
101
|
|
|
|
|
|
|
# $config->{'api_version'} = $ENV{'IRON_API_VERSION'} |
102
|
|
|
|
|
|
|
# $config->{'timeout'} = $ENV{'IRON_TIMEOUT'} |
103
|
|
|
|
|
|
|
sub _read_iron_config_env_vars { |
104
|
3
|
|
|
3
|
|
8
|
my ($config) = @_; |
105
|
3
|
|
|
|
|
19
|
$log->tracef('Entering _read_iron_config_env_vars(%s)', $config); |
106
|
3
|
|
|
|
|
483
|
foreach my $config_key (keys %{$config}) { |
|
3
|
|
|
|
|
13
|
|
107
|
24
|
100
|
|
|
|
82
|
if (defined $ENV{'IRON_' . uc $config_key}) { |
108
|
6
|
|
|
|
|
14
|
$config->{$config_key} = $ENV{'IRON_' . uc $config_key}; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
} |
111
|
3
|
|
|
|
|
12
|
$log->tracef('Exiting _read_iron_config_env_vars: %s', $config); |
112
|
3
|
|
|
|
|
526
|
return $config; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# Try to read the file given as second parameter. (if undef, fail). |
117
|
|
|
|
|
|
|
# If fails, gracefully return 0; if succeed, change configuration (first parameter) and return 1. |
118
|
|
|
|
|
|
|
sub _read_iron_config_file { |
119
|
7
|
|
|
7
|
|
195
|
my ($config, $full_path_name) = @_; |
120
|
7
|
|
|
|
|
32
|
$log->tracef('Entering _read_iron_config_file(%s, %s)', $full_path_name, $config); |
121
|
|
|
|
|
|
|
|
122
|
7
|
|
|
|
|
1110
|
assert_nonblank( $full_path_name, 'full_path_name is not defined or is blank.' ); |
123
|
|
|
|
|
|
|
|
124
|
7
|
|
|
|
|
130
|
my $read_config; |
125
|
|
|
|
|
|
|
my $rval; |
126
|
7
|
|
|
|
|
25
|
my $file = path($full_path_name); |
127
|
7
|
100
|
|
|
|
256
|
if ($file->is_file) { |
128
|
2
|
|
|
|
|
50
|
$log->tracef('File %s exists', $full_path_name); |
129
|
2
|
|
|
|
|
8
|
my $file_contents; |
130
|
2
|
|
|
2
|
|
35
|
try { $file_contents = $file->slurp_utf8 }; |
|
2
|
|
|
|
|
70
|
|
131
|
2
|
50
|
|
|
|
1382
|
if($file_contents) { |
132
|
2
|
|
|
|
|
9
|
$log->tracef('Slurped file %s', $full_path_name); |
133
|
2
|
|
|
|
|
17
|
my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1); |
134
|
2
|
|
|
|
|
55
|
$read_config = $json->decode($file_contents); |
135
|
2
|
|
|
|
|
6
|
foreach my $config_key (keys %{$config}) { |
|
2
|
|
|
|
|
8
|
|
136
|
16
|
100
|
|
|
|
39
|
if (defined $read_config->{$config_key}) { |
137
|
8
|
|
|
|
|
19
|
$config->{$config_key} = $read_config->{$config_key}; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
2
|
|
|
|
|
10
|
$rval = 1; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
else { |
143
|
0
|
|
|
|
|
0
|
$log->debugf('Could not read file %s', $full_path_name); |
144
|
0
|
|
|
|
|
0
|
$rval = 0; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
else { |
148
|
5
|
|
|
|
|
226
|
$log->tracef('File %s does not exist', $full_path_name); |
149
|
5
|
|
|
|
|
415
|
$rval = 0; |
150
|
|
|
|
|
|
|
} |
151
|
7
|
|
|
|
|
27
|
$log->tracef('Exiting _read_iron_config_file: %s', $config); |
152
|
7
|
|
|
|
|
1028
|
return $rval; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#my $GEN_DELIMS = q{!} . q{$} . q{&} . q{'} . q{(} . q{)} |
157
|
|
|
|
|
|
|
# . q{*} . q{+} . q{,} . q{;} . q{=}; |
158
|
|
|
|
|
|
|
#my $SUB_DELIMS = q{:} . q{/} . q{?} . q{#} . q{[} . q{]} . q{@}; |
159
|
|
|
|
|
|
|
#my $RESERVED_CHARACTERS = $GEN_DELIMS . $SUB_DELIMS; |
160
|
|
|
|
|
|
|
#my $RFC_3986_RESERVED_CHARACTERS =~ s/(.{1})/\\$1/sg; # Escape every character. |
161
|
|
|
|
|
|
|
sub contains_rfc_3986_res_chars { |
162
|
11
|
|
|
11
|
1
|
689
|
my @params = validate_pos( @_, { type => SCALAR } ); |
163
|
|
|
|
|
|
|
## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars) |
164
|
11
|
|
|
|
|
39
|
my $rfc_3986_reserved_characters = q{\!\$\&\'\(\)\*\+\,\;\=\:\/\?\#\[\]\@}; |
165
|
|
|
|
|
|
|
## critic (ValuesAndExpressions::RequireInterpolationOfMetachars) |
166
|
11
|
100
|
|
|
|
156
|
return ($params[0] =~ m/[$rfc_3986_reserved_characters]{1,}/msx) ? 1 : 0; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
1; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
__END__ |