line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Spp::Builtin; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
27
|
use 5.012; |
|
2
|
|
|
|
|
4
|
|
4
|
2
|
|
|
2
|
|
44
|
no warnings "experimental"; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
55
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
9
|
use Exporter; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
150
|
|
7
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
8
|
|
|
|
|
|
|
our @EXPORT = qw(End In Out True False Qstr Qint Blank |
9
|
|
|
|
|
|
|
clean first string strings sort_array to_json from_json |
10
|
|
|
|
|
|
|
is_exists first_char last_char rest_str tail rest |
11
|
|
|
|
|
|
|
is_string is_int is_array Chop add uuid |
12
|
|
|
|
|
|
|
error read_file write_file len trim subarray |
13
|
|
|
|
|
|
|
is_space is_upper is_lower is_digit is_xdigit |
14
|
|
|
|
|
|
|
is_alpha is_words is_hspace is_vspace |
15
|
|
|
|
|
|
|
start_with end_with to_end get_time change_sufix |
16
|
|
|
|
|
|
|
get_file_mtime is_update tidy_perl find_wanted |
17
|
|
|
|
|
|
|
to_int copy is_false is_true croak |
18
|
|
|
|
|
|
|
estr estr_ints is_str is_bool is_estr is_blank |
19
|
|
|
|
|
|
|
cons cons_atom is_atom); |
20
|
|
|
|
|
|
|
|
21
|
2
|
|
|
2
|
|
523
|
use File::Find::Wanted qw(find_wanted); |
|
2
|
|
|
|
|
410
|
|
|
2
|
|
|
|
|
107
|
|
22
|
2
|
|
|
2
|
|
563
|
use Time::Piece; |
|
2
|
|
|
|
|
17835
|
|
|
2
|
|
|
|
|
10
|
|
23
|
2
|
|
|
2
|
|
153
|
use File::Basename qw(fileparse); |
|
2
|
|
|
|
|
13
|
|
|
2
|
|
|
|
|
143
|
|
24
|
2
|
|
|
2
|
|
6505
|
use Perl::Tidy; |
|
2
|
|
|
|
|
297116
|
|
|
2
|
|
|
|
|
261
|
|
25
|
2
|
|
|
2
|
|
17
|
use File::Copy qw(copy); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
98
|
|
26
|
2
|
|
|
2
|
|
667
|
use String::Random; |
|
2
|
|
|
|
|
5011
|
|
|
2
|
|
|
|
|
141
|
|
27
|
2
|
|
|
2
|
|
876
|
use JSON::XS qw(decode_json encode_json); |
|
2
|
|
|
|
|
7320
|
|
|
2
|
|
|
|
|
109
|
|
28
|
2
|
|
|
2
|
|
14
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
145
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
use constant { |
31
|
2
|
|
|
|
|
3921
|
End => chr(0), |
32
|
|
|
|
|
|
|
In => chr(1), |
33
|
|
|
|
|
|
|
Out => chr(2), |
34
|
|
|
|
|
|
|
True => chr(3), |
35
|
|
|
|
|
|
|
False => chr(4), |
36
|
|
|
|
|
|
|
Qstr => chr(5), |
37
|
|
|
|
|
|
|
Qint => chr(6), |
38
|
|
|
|
|
|
|
Blank => (chr(1) . chr(2)), |
39
|
2
|
|
|
2
|
|
11
|
}; |
|
2
|
|
|
|
|
3
|
|
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub cons { |
42
|
50
|
|
|
50
|
0
|
97
|
my @args = @_; |
43
|
50
|
|
|
|
|
80
|
my $estr = join '', map { cons_atom($_) } @args; |
|
114
|
|
|
|
|
155
|
|
44
|
50
|
|
|
|
|
201
|
return (In . $estr . Out); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub cons_atom { |
48
|
114
|
|
|
114
|
0
|
128
|
my $atom = shift; |
49
|
114
|
100
|
|
|
|
153
|
if (is_estr($atom)) { return $atom } |
|
69
|
|
|
|
|
156
|
|
50
|
45
|
50
|
|
|
|
75
|
if (is_str($atom)) { return (Qstr . $atom) } |
|
45
|
|
|
|
|
100
|
|
51
|
0
|
|
|
|
|
0
|
say "|$atom|"; |
52
|
0
|
|
|
|
|
0
|
croak("not estr or str or int??"); |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub estr { |
56
|
15
|
|
|
15
|
0
|
19
|
my $estr_array = shift; |
57
|
15
|
50
|
|
|
|
22
|
if (is_string($estr_array)) { croak('trace it...') } |
|
0
|
|
|
|
|
0
|
|
58
|
15
|
|
|
|
|
22
|
return cons(@{$estr_array}); |
|
15
|
|
|
|
|
24
|
|
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub estr_ints { |
62
|
14
|
|
|
14
|
0
|
20
|
my $ints = shift; |
63
|
14
|
|
|
|
|
28
|
my @estrs = map { (Qint . $_) } @{$ints}; |
|
28
|
|
|
|
|
92
|
|
|
14
|
|
|
|
|
36
|
|
64
|
14
|
|
|
|
|
68
|
return In . join('', @estrs) . Out; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub is_str { |
68
|
1089
|
|
|
1089
|
0
|
1282
|
my $str = shift; |
69
|
1089
|
50
|
|
|
|
1409
|
if (is_string($str)) { |
70
|
1089
|
|
|
|
|
1524
|
my $char = substr($str, 0, 1); |
71
|
1089
|
100
|
|
|
|
1807
|
if (ord($char) > 6) { return 1 } |
|
89
|
|
|
|
|
178
|
|
72
|
|
|
|
|
|
|
} |
73
|
1000
|
|
|
|
|
2137
|
return 0; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub is_bool { |
77
|
131
|
|
|
131
|
0
|
179
|
my $char = shift; |
78
|
131
|
100
|
|
|
|
240
|
if (is_false($char)) { return 1 } |
|
117
|
|
|
|
|
264
|
|
79
|
14
|
50
|
|
|
|
39
|
if (is_true($char)) { return 1 } |
|
0
|
|
|
|
|
0
|
|
80
|
14
|
|
|
|
|
33
|
return 0; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub is_estr { |
84
|
117
|
|
|
117
|
0
|
128
|
my $str = shift; |
85
|
117
|
|
|
|
|
244
|
return substr($str, 0, 1) eq In; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub is_blank { |
89
|
0
|
|
|
0
|
0
|
0
|
my $estr = shift; |
90
|
0
|
|
|
|
|
0
|
return $estr eq Blank; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
|
0
|
0
|
0
|
sub error { say @_; exit() } |
|
0
|
|
|
|
|
0
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub to_json { |
96
|
0
|
|
|
0
|
0
|
0
|
my $data = shift; |
97
|
0
|
|
|
|
|
0
|
return encode_json($data); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub from_json { |
101
|
0
|
|
|
0
|
0
|
0
|
my $data = shift; |
102
|
0
|
|
|
|
|
0
|
return decode_json($data); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub clean { |
106
|
0
|
|
|
0
|
0
|
0
|
my $stack = shift; |
107
|
0
|
|
|
|
|
0
|
@{$stack} = (); |
|
0
|
|
|
|
|
0
|
|
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub string { |
111
|
0
|
|
|
0
|
0
|
0
|
my $stack = shift; |
112
|
0
|
|
|
|
|
0
|
return join '', @{$stack}; |
|
0
|
|
|
|
|
0
|
|
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub first { |
116
|
0
|
|
|
0
|
0
|
0
|
my $stack = shift; |
117
|
0
|
0
|
|
|
|
0
|
if (is_array($stack)) { |
118
|
0
|
|
|
|
|
0
|
return $stack->[0]; |
119
|
|
|
|
|
|
|
} |
120
|
0
|
|
|
|
|
0
|
croak("Could not first not Array"); |
121
|
0
|
|
|
|
|
0
|
return False |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub strings { |
125
|
0
|
|
|
0
|
0
|
0
|
my $stack = shift; |
126
|
0
|
|
|
|
|
0
|
return $stack; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub sort_array { |
130
|
0
|
|
|
0
|
0
|
0
|
my $array = shift; |
131
|
0
|
|
|
|
|
0
|
return [reverse sort @{$array}]; |
|
0
|
|
|
|
|
0
|
|
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub uuid { |
135
|
0
|
|
|
0
|
0
|
0
|
my $gen = String::Random->new; |
136
|
0
|
|
|
|
|
0
|
return $gen->randregex('[A-Z]{5}'); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub is_exists { |
140
|
0
|
|
|
0
|
0
|
0
|
my $file = shift; |
141
|
0
|
|
|
|
|
0
|
return (-e $file); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub first_char { |
145
|
2
|
|
|
2
|
0
|
4
|
my $data = shift; |
146
|
2
|
50
|
|
|
|
4
|
if (is_string($data)) { |
147
|
2
|
|
|
|
|
5
|
return substr $data, 0, 1; |
148
|
|
|
|
|
|
|
} |
149
|
0
|
|
|
|
|
0
|
croak("could not first No Str"); |
150
|
0
|
|
|
|
|
0
|
return True |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub last_char { |
154
|
2
|
|
|
2
|
0
|
4
|
my $str = shift; |
155
|
2
|
50
|
|
|
|
4
|
if (is_string($str)) { |
156
|
2
|
|
|
|
|
7
|
return substr $str, -1; |
157
|
|
|
|
|
|
|
} |
158
|
0
|
|
|
|
|
0
|
croak("Could not last-char Array"); |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub rest_str { |
162
|
3
|
|
|
3
|
0
|
5
|
my $data = shift; |
163
|
3
|
50
|
|
|
|
8
|
return substr($data, 1) if is_string($data); |
164
|
0
|
|
|
|
|
0
|
croak("rest_str only could do str"); |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub tail { |
168
|
0
|
|
|
0
|
0
|
0
|
my $data = shift; |
169
|
0
|
0
|
|
|
|
0
|
if (is_array($data)) { |
170
|
0
|
|
|
|
|
0
|
return $data->[-1]; |
171
|
|
|
|
|
|
|
} |
172
|
0
|
|
|
|
|
0
|
croak("Could not tail not Array"); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub rest { |
176
|
3
|
|
|
3
|
0
|
6
|
my $data = shift; |
177
|
3
|
50
|
|
|
|
7
|
if (is_array($data)) { |
178
|
3
|
|
|
|
|
5
|
my @array = @{$data}; |
|
3
|
|
|
|
|
8
|
|
179
|
3
|
|
|
|
|
17
|
return [splice(@array, 1)]; |
180
|
|
|
|
|
|
|
} |
181
|
0
|
|
|
|
|
0
|
croak("rest only could do array"); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub is_string { |
185
|
2090
|
|
|
2090
|
0
|
2254
|
my $x = shift; |
186
|
2090
|
|
|
|
|
4124
|
return (ref($x) eq ref('')); |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub is_int { |
190
|
0
|
|
|
0
|
0
|
0
|
my $int = shift; |
191
|
0
|
|
|
|
|
0
|
return ($int ^ $int) eq '0'; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub is_array { |
195
|
979
|
|
|
979
|
0
|
1014
|
my $x = shift; |
196
|
979
|
|
|
|
|
1957
|
return (ref($x) eq ref([])); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub Chop { |
200
|
1
|
|
|
1
|
0
|
2
|
my $str = shift; |
201
|
1
|
|
|
|
|
5
|
return substr($str, 0, -1); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub add { |
205
|
34
|
|
|
34
|
0
|
86
|
my @strs = @_; |
206
|
34
|
|
|
|
|
135
|
return join '', @strs; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub read_file { |
210
|
0
|
|
|
0
|
0
|
0
|
my $file = shift; |
211
|
0
|
0
|
|
|
|
0
|
error("file: $file not exists") if not(-e $file); |
212
|
0
|
|
|
|
|
0
|
local $/; |
213
|
0
|
0
|
|
|
|
0
|
open my ($fh), '<:encoding(UTF-8)', $file or die $!; |
214
|
0
|
|
|
|
|
0
|
return <$fh>; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub write_file { |
218
|
0
|
|
|
0
|
0
|
0
|
my ($file, $str) = @_; |
219
|
0
|
0
|
|
|
|
0
|
open my ($fh), '>:encoding(UTF-8)', $file or die $!; |
220
|
0
|
|
|
|
|
0
|
print {$fh} $str; |
|
0
|
|
|
|
|
0
|
|
221
|
|
|
|
|
|
|
# say "write file: $file ok!"; |
222
|
0
|
|
|
|
|
0
|
return $file; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub len { |
226
|
979
|
|
|
979
|
0
|
1153
|
my $data = shift; |
227
|
979
|
100
|
|
|
|
1282
|
return length($data) if is_string($data); |
228
|
976
|
50
|
|
|
|
1440
|
return scalar(@{$data}) if is_array($data); |
|
976
|
|
|
|
|
2175
|
|
229
|
0
|
|
|
|
|
0
|
croak("len only make array"); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub trim { |
233
|
0
|
|
|
0
|
0
|
0
|
my $str = shift; |
234
|
0
|
0
|
|
|
|
0
|
if (is_string($str)) { |
235
|
0
|
|
|
|
|
0
|
$str =~ s/^\s+|\s+$//g; |
236
|
0
|
|
|
|
|
0
|
return $str; |
237
|
|
|
|
|
|
|
} |
238
|
0
|
|
|
|
|
0
|
croak("trim only make string"); |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub subarray { |
242
|
0
|
|
|
0
|
0
|
0
|
my ($array, $from, $to) = @_; |
243
|
0
|
|
|
|
|
0
|
my @array = @{$array}; |
|
0
|
|
|
|
|
0
|
|
244
|
0
|
0
|
|
|
|
0
|
if (is_array($array)) { |
245
|
0
|
0
|
|
|
|
0
|
if ($to > 0) { |
246
|
0
|
|
|
|
|
0
|
my $len = $to - $from + 1; |
247
|
0
|
|
|
|
|
0
|
my $sub_array = [splice @array, $from, $len]; |
248
|
0
|
|
|
|
|
0
|
return $sub_array; |
249
|
|
|
|
|
|
|
} |
250
|
0
|
0
|
|
|
|
0
|
if (defined $to) { |
251
|
0
|
|
|
|
|
0
|
return [splice @array, $from, $to]; |
252
|
|
|
|
|
|
|
} |
253
|
0
|
|
|
|
|
0
|
return [splice @array, $from]; |
254
|
|
|
|
|
|
|
} |
255
|
0
|
|
|
|
|
0
|
croak("subarray only could process array"); |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub is_space { |
259
|
34
|
|
|
34
|
0
|
40
|
my $r = shift; |
260
|
34
|
|
|
|
|
141
|
return $r ~~ ["\n", "\t", "\r", ' ']; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub is_upper { |
264
|
2
|
|
|
2
|
0
|
5
|
my $r = shift; |
265
|
2
|
|
|
|
|
34
|
return $r ~~ ['A' .. 'Z']; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub is_lower { |
269
|
2
|
|
|
2
|
0
|
4
|
my $r = shift; |
270
|
2
|
|
|
|
|
34
|
return $r ~~ ['a' .. 'z']; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub is_digit { |
274
|
1110
|
|
|
1110
|
0
|
1239
|
my $r = shift; |
275
|
1110
|
|
|
|
|
5458
|
return $r ~~ ['0' .. '9']; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub is_xdigit { |
279
|
0
|
|
|
0
|
0
|
0
|
my $char = shift; |
280
|
0
|
0
|
|
|
|
0
|
return 1 if is_digit($char); |
281
|
0
|
0
|
|
|
|
0
|
return 1 if $char ~~ ['a' .. 'f']; |
282
|
0
|
0
|
|
|
|
0
|
return 1 if $char ~~ ['A' .. 'F']; |
283
|
0
|
|
|
|
|
0
|
return 0; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub is_alpha { |
287
|
34
|
|
|
34
|
0
|
65
|
my $r = shift; |
288
|
34
|
|
|
|
|
506
|
return $r ~~ ['a' .. 'z', 'A' .. 'Z', '_']; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub is_words { |
292
|
0
|
|
|
0
|
0
|
0
|
my $r = shift; |
293
|
0
|
0
|
|
|
|
0
|
return 1 if is_digit($r); |
294
|
0
|
0
|
|
|
|
0
|
return 1 if is_alpha($r); |
295
|
0
|
|
|
|
|
0
|
return 0; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub is_hspace { |
299
|
0
|
|
|
0
|
0
|
0
|
my $h = shift; |
300
|
0
|
|
|
|
|
0
|
return $h ~~ [' ', "\t"]; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
sub is_vspace { |
304
|
0
|
|
|
0
|
0
|
0
|
my $v = shift; |
305
|
0
|
|
|
|
|
0
|
return $v ~~ ["\r", "\n"]; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub start_with { |
309
|
0
|
|
|
0
|
0
|
0
|
my ($str, $start) = @_; |
310
|
0
|
0
|
|
|
|
0
|
return 1 if index($str, $start) == 0; |
311
|
0
|
|
|
|
|
0
|
return 0; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub end_with { |
315
|
0
|
|
|
0
|
0
|
0
|
my ($str, $end) = @_; |
316
|
0
|
|
|
|
|
0
|
my $len = length($end); |
317
|
0
|
|
|
|
|
0
|
return substr($str, -$len) eq $end; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub to_end { |
321
|
0
|
|
|
0
|
0
|
0
|
my $str = shift; |
322
|
0
|
|
|
|
|
0
|
my $index = index($str, "\n"); |
323
|
0
|
|
|
|
|
0
|
return substr($str, 0, $index); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub get_time { |
327
|
0
|
|
|
0
|
0
|
0
|
my $t = localtime; |
328
|
0
|
|
|
|
|
0
|
return $t->hms('-'); |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub change_sufix { |
332
|
0
|
|
|
0
|
0
|
0
|
my ($file, $from_sufix, $to_sufix) = @_; |
333
|
0
|
|
|
|
|
0
|
my @sufix = ($from_sufix); |
334
|
0
|
|
|
|
|
0
|
my ($name, $path) = fileparse($file, @sufix); |
335
|
0
|
|
|
|
|
0
|
return $path . $name . $to_sufix; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
sub get_file_mtime { |
339
|
0
|
|
|
0
|
0
|
0
|
my $file = shift; |
340
|
0
|
0
|
|
|
|
0
|
if (not(-e $file)) { |
341
|
0
|
|
|
|
|
0
|
say "$file is not exists!"; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
else { |
344
|
0
|
|
|
|
|
0
|
return (stat($file))[9]; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
sub is_update { |
349
|
0
|
|
|
0
|
0
|
0
|
my ($file, $to_file) = @_; |
350
|
0
|
|
|
|
|
0
|
my $file_mtime = get_file_mtime($file); |
351
|
0
|
|
|
|
|
0
|
my $to_file_mtime = get_file_mtime($to_file); |
352
|
0
|
|
|
|
|
0
|
return ($file_mtime < $to_file_mtime); |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub to_int { |
356
|
0
|
|
|
0
|
0
|
0
|
my $str = shift; |
357
|
0
|
|
|
|
|
0
|
return 0 + $str; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub is_false { |
361
|
672
|
|
|
672
|
0
|
764
|
my $char = shift; |
362
|
672
|
|
|
|
|
1322
|
return $char eq False; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
sub is_true { |
366
|
167
|
|
|
167
|
0
|
192
|
my $char = shift; |
367
|
167
|
|
|
|
|
333
|
return $char eq True; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub is_atom { |
371
|
52
|
|
|
52
|
0
|
71
|
my $estr = shift; |
372
|
52
|
|
|
|
|
147
|
return substr($estr, 0, 2) eq (In . Qstr); |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
sub tidy_perl { |
376
|
0
|
|
|
0
|
0
|
|
my $source_string = shift; |
377
|
0
|
|
|
|
|
|
my $dest_string; |
378
|
|
|
|
|
|
|
my $stderr_string; |
379
|
0
|
|
|
|
|
|
my $errorfile_string; |
380
|
0
|
|
|
|
|
|
my $argv = "-i=2 -l=60 -vt=2 -pt=2 -bt=1 -sbt=2 -bbt=1"; |
381
|
0
|
|
|
|
|
|
my $error = Perl::Tidy::perltidy( |
382
|
|
|
|
|
|
|
argv => $argv, |
383
|
|
|
|
|
|
|
source => \$source_string, |
384
|
|
|
|
|
|
|
destination => \$dest_string, |
385
|
|
|
|
|
|
|
stderr => \$stderr_string, |
386
|
|
|
|
|
|
|
errorfile => \$errorfile_string, |
387
|
|
|
|
|
|
|
); |
388
|
|
|
|
|
|
|
|
389
|
0
|
0
|
|
|
|
|
if ($error) { |
390
|
0
|
|
|
|
|
|
print "<<STDERR>>\n$stderr_string\n"; |
391
|
|
|
|
|
|
|
} |
392
|
0
|
|
|
|
|
|
return $dest_string; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
1; |