line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Makefile::Parser; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
719
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
39
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
9
|
use File::Spec; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
20
|
|
7
|
1
|
|
|
1
|
|
4
|
use Cwd qw/ realpath /; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
66
|
|
8
|
1
|
|
|
1
|
|
809
|
use List::MoreUtils qw( uniq pairwise ) ; |
|
1
|
|
|
|
|
1299
|
|
|
1
|
|
|
|
|
82
|
|
9
|
1
|
|
|
1
|
|
1616
|
use Text::Balanced qw( gen_extract_tagged ); |
|
1
|
|
|
|
|
21840
|
|
|
1
|
|
|
|
|
6489
|
|
10
|
|
|
|
|
|
|
#use Smart::Comments; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
#our $Debug = 0; |
13
|
|
|
|
|
|
|
our $Strict = 0; |
14
|
|
|
|
|
|
|
our $VERSION = '0.215'; |
15
|
|
|
|
|
|
|
our $Error; |
16
|
|
|
|
|
|
|
our $Runtime = undef; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# usage: $class->new; |
19
|
|
|
|
|
|
|
sub new { |
20
|
10
|
|
|
10
|
1
|
109
|
my $proto = shift; |
21
|
10
|
|
66
|
|
|
55
|
my $class = ref $proto || $proto; |
22
|
10
|
|
|
|
|
91
|
my $self = bless { |
23
|
|
|
|
|
|
|
_vars => {}, # all the definitions of variables |
24
|
|
|
|
|
|
|
_tars => undef, # all the targets |
25
|
|
|
|
|
|
|
_default => undef, # default target |
26
|
|
|
|
|
|
|
_depends => {}, # all the dependencies |
27
|
|
|
|
|
|
|
_imps => [], # targets in implicit rules |
28
|
|
|
|
|
|
|
}, $class; |
29
|
10
|
|
|
|
|
31
|
return $self; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $extract_interp_1 = gen_extract_tagged('\$[(]', '[)]', ''); |
33
|
|
|
|
|
|
|
my $extract_interp_2 = gen_extract_tagged('\$[{]', '[}]', ''); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub _extract_interp { |
36
|
3589
|
|
|
3589
|
|
9416
|
my ($res) = $extract_interp_1->($_[0]); |
37
|
3589
|
100
|
|
|
|
347834
|
if (!$res) { |
38
|
2374
|
|
|
|
|
6395
|
($res) = $extract_interp_2->($_[0]); |
39
|
|
|
|
|
|
|
} |
40
|
3589
|
|
|
|
|
130845
|
$res; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# usage: $obj->parse($filename); |
44
|
|
|
|
|
|
|
sub parse { |
45
|
15
|
|
|
15
|
1
|
69
|
my ($self, $file, $vars) = @_; |
46
|
15
|
|
100
|
|
|
47
|
$file ||= 'Makefile'; |
47
|
15
|
50
|
|
|
|
33
|
my %init_vars = %$vars if $vars; |
48
|
|
|
|
|
|
|
|
49
|
15
|
|
|
|
|
40
|
$self->{_file} = $file; |
50
|
15
|
|
|
|
|
104
|
$self->{_vars} = { |
51
|
|
|
|
|
|
|
MAKE => $0, |
52
|
|
|
|
|
|
|
CC => 'cc', |
53
|
|
|
|
|
|
|
SHELL => 'sh', |
54
|
|
|
|
|
|
|
%init_vars, |
55
|
|
|
|
|
|
|
}; |
56
|
15
|
|
|
|
|
70
|
undef $self->{_tars}; |
57
|
15
|
|
|
|
|
129
|
undef $self->{_default}; |
58
|
15
|
|
|
|
|
54
|
$self->{_depends} = {}; |
59
|
15
|
|
|
|
|
93
|
$self->{_imps} = []; |
60
|
|
|
|
|
|
|
|
61
|
15
|
|
|
|
|
30
|
my $rvars = $self->{_vars}; |
62
|
15
|
|
|
|
|
21
|
my $in; |
63
|
15
|
100
|
|
|
|
817
|
unless (open $in, $file) { |
64
|
2
|
|
|
|
|
39
|
$Error = "Cannot open $file for reading: $!"; |
65
|
2
|
|
|
|
|
14
|
return undef; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
13
|
|
|
|
|
31
|
my $state = 'S_IDLE'; |
69
|
13
|
|
|
|
|
17
|
my ($var, $value, $tar_name, $tar, $colon_type, $depends, $cmd); |
70
|
0
|
|
|
|
|
0
|
my @cmds; |
71
|
0
|
|
|
|
|
0
|
my %tars; |
72
|
|
|
|
|
|
|
#%$rvars = (); |
73
|
13
|
|
|
|
|
18
|
my $first_tar = 1; |
74
|
13
|
|
|
|
|
483
|
while (<$in>) { |
75
|
3247
|
100
|
66
|
|
|
10798
|
next if /^\s*#/ and $state ne 'S_IN_VAL'; |
76
|
2883
|
100
|
100
|
|
|
13176
|
next if /^\s*$/ and $state ne 'S_IN_VAL'; |
77
|
|
|
|
|
|
|
#$tar_name = '' unless defined $var; |
78
|
|
|
|
|
|
|
#warn "(tar: $tar_name) Switching to tate $state with $_"; |
79
|
|
|
|
|
|
|
#warn $state if $state ne 'S_IDLE'; |
80
|
1902
|
|
|
|
|
2624
|
chomp; |
81
|
|
|
|
|
|
|
#if (/TEST_VERBOSE=/) { |
82
|
|
|
|
|
|
|
#### line: $_ |
83
|
|
|
|
|
|
|
#### state: $state |
84
|
|
|
|
|
|
|
#} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# expand the value of use-defined variables: |
87
|
|
|
|
|
|
|
#s/\$[\{\(](\w+)[\}\)]/exists $rvars->{$1} ? $rvars->{$1} : $&/ge; |
88
|
1902
|
|
|
|
|
3621
|
$_ = $self->_process_refs($_); |
89
|
|
|
|
|
|
|
|
90
|
1902
|
100
|
100
|
|
|
40929
|
if (($state eq 'S_IDLE' or $state eq 'S_CMD') and /^(\w+) \s* :?= \s* (.*)$/xo) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
0
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
91
|
271
|
|
|
|
|
497
|
$var = $1; |
92
|
271
|
|
|
|
|
437
|
$value = $2; |
93
|
|
|
|
|
|
|
#warn "matched $var = $value\n"; |
94
|
271
|
100
|
|
|
|
723
|
if ($value =~ m{\\\s*$}) { |
95
|
29
|
|
|
|
|
51
|
$value .= "\n"; |
96
|
29
|
|
|
|
|
145
|
$state = 'S_IN_VAL' ; |
97
|
|
|
|
|
|
|
} else { |
98
|
242
|
|
|
|
|
418
|
$value =~ s/#.*//m; |
99
|
242
|
|
|
|
|
557
|
$rvars->{$var} = $value; |
100
|
|
|
|
|
|
|
### variable: $var |
101
|
|
|
|
|
|
|
### value: $value |
102
|
242
|
|
|
|
|
1076
|
$state = 'S_IDLE'; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
#warn "$1 * $2 * $3"; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
} elsif ($state eq 'S_IN_VAL') { |
107
|
|
|
|
|
|
|
#warn $1; |
108
|
58
|
|
|
|
|
80
|
my $line = $_; |
109
|
|
|
|
|
|
|
#warn "adding value line $line\n"; |
110
|
58
|
|
|
|
|
111
|
$value .= "$line\n"; |
111
|
58
|
100
|
|
|
|
350
|
if ($line !~ m{\\\s*$}) { |
112
|
29
|
|
|
|
|
47
|
$state = 'S_IDLE' ; |
113
|
|
|
|
|
|
|
#warn "Processing value '$value'\n"; |
114
|
29
|
|
|
|
|
373
|
$value =~ s/[ \t]*\\\n[ \t]*/ /sg; |
115
|
29
|
|
|
|
|
63
|
$value =~ s/#.*//smg; |
116
|
|
|
|
|
|
|
#warn "Finale value '$value'\n"; |
117
|
29
|
|
|
|
|
80
|
$value =~ s/\n//gs; |
118
|
29
|
|
|
|
|
588
|
$value =~ s/^\s+|\s+$//gs; |
119
|
29
|
|
|
|
|
205
|
$rvars->{$var} = $value; |
120
|
|
|
|
|
|
|
#warn "$var <=> $value\n"; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
} elsif (($state eq 'S_IDLE' or $state eq 'S_CMD') and /^(\.\w+) (\.\w+) \s* (::?)\s*$/xo) { |
124
|
2
|
|
|
|
|
9
|
$_ = "%$2 $3 %$1\n"; |
125
|
|
|
|
|
|
|
#warn $_; |
126
|
2
|
|
|
|
|
3
|
redo; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
} elsif (($state eq 'S_IDLE' or $state eq 'S_CMD') and /^(\S[^:]*) (::?) \s* (.*)$/xo) { |
129
|
599
|
|
|
|
|
1399
|
$tar_name = $1; |
130
|
599
|
|
|
|
|
997
|
$colon_type = $2; |
131
|
599
|
|
|
|
|
863
|
$depends = $3; |
132
|
599
|
|
|
|
|
3401
|
$tar_name =~ s/^\s+|\s+$//g; |
133
|
|
|
|
|
|
|
|
134
|
599
|
|
|
|
|
997
|
my $cmd; |
135
|
599
|
50
|
|
|
|
1719
|
if ($depends =~ s/;(.*)//) { |
136
|
0
|
|
|
|
|
0
|
$cmd = $1; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# Ignore .SUFFIXES currently: |
140
|
599
|
100
|
|
|
|
1274
|
next if $tar_name eq '.SUFFIXES'; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
#warn "Adding target $tar_name...\n"; |
143
|
598
|
|
|
|
|
1803
|
$tar = Makefile::Target->new($tar_name, $colon_type); |
144
|
598
|
100
|
|
|
|
1334
|
if (my $old_tars = $tars{$tar_name}) { |
145
|
3
|
100
|
|
|
|
7
|
if ($colon_type eq ':') { |
146
|
2
|
|
|
|
|
6
|
$tar->add_prereq($old_tars->[0]->prereqs); |
147
|
2
|
100
|
|
|
|
7
|
if (my @cmd = $old_tars->[0]->commands) { |
148
|
1
|
|
|
|
|
3
|
$tar->add_command(@cmd); |
149
|
|
|
|
|
|
|
} |
150
|
2
|
|
|
|
|
7
|
@$old_tars = $tar; |
151
|
|
|
|
|
|
|
} else { |
152
|
1
|
|
|
|
|
3
|
push @$old_tars, $tar; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} else { |
155
|
595
|
|
|
|
|
1754
|
$tars{$tar_name} = [$tar]; |
156
|
|
|
|
|
|
|
} |
157
|
598
|
100
|
|
|
|
1359
|
if ($tar_name =~ m/%/) { |
158
|
9
|
|
|
|
|
11
|
push @{$self->{_imps}}, $tar_name; |
|
9
|
|
|
|
|
23
|
|
159
|
|
|
|
|
|
|
} |
160
|
598
|
100
|
|
|
|
1215
|
if ($first_tar) { |
161
|
13
|
|
|
|
|
19
|
$self->{_default} = $tar; |
162
|
13
|
|
|
|
|
25
|
$first_tar = 0; |
163
|
|
|
|
|
|
|
} |
164
|
598
|
100
|
|
|
|
1128
|
if ($depends =~ s/\s+\\$//o) { |
165
|
14
|
|
|
|
|
26
|
$state = 'S_IN_DEPENDS'; |
166
|
|
|
|
|
|
|
} else { |
167
|
584
|
|
|
|
|
719
|
$depends =~ s/\^\\$/\\/; |
168
|
584
|
|
|
|
|
708
|
$state = 'S_CMD'; |
169
|
|
|
|
|
|
|
} |
170
|
598
|
|
|
|
|
2241
|
my @depends = split /\s+/, $depends; |
171
|
598
|
|
|
|
|
931
|
map { $self->{_depends}->{$_} = 1 } @depends; |
|
1735
|
|
|
|
|
4615
|
|
172
|
598
|
|
|
|
|
1310
|
$tar->add_depend(@depends); |
173
|
598
|
50
|
|
|
|
8220
|
$tar->add_command($cmd) if defined $cmd; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
elsif ($state eq 'S_IN_DEPENDS' and /^\s+ (.*)$/xo) { |
176
|
14
|
|
|
|
|
29
|
$depends = $1; |
177
|
14
|
50
|
|
|
|
51
|
if ($depends !~ s/\s+\\$//o) { |
178
|
14
|
|
|
|
|
35
|
$depends =~ s/\^\\$/\\/; |
179
|
14
|
|
|
|
|
48
|
my @depends = split /\s+/, $depends; |
180
|
14
|
|
|
|
|
25
|
map { $self->{_depends}->{$_} = 1 } @depends; |
|
35
|
|
|
|
|
110
|
|
181
|
14
|
|
|
|
|
33
|
$tar->add_depend(@depends); |
182
|
14
|
|
|
|
|
74
|
$state = 'S_CMD'; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
elsif ($state eq 'S_CMD' and /^\s+(.*)/o) { |
186
|
825
|
|
|
|
|
1794
|
$cmd = $1; |
187
|
825
|
100
|
|
|
|
1610
|
if ($cmd =~ s/\s+\\$//o) { |
188
|
35
|
|
|
|
|
307
|
$state = 'S_IN_CMD'; |
189
|
|
|
|
|
|
|
} else { |
190
|
790
|
|
|
|
|
1874
|
$tar->add_command($cmd); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
elsif ($state eq 'S_IN_CMD' and /^\s+(.*)/o) { |
194
|
133
|
|
|
|
|
397
|
$cmd .= " $1"; |
195
|
133
|
100
|
|
|
|
1360
|
if ($cmd !~ s/\s+\\$//o) { |
196
|
35
|
|
|
|
|
84
|
$tar->add_command($cmd); |
197
|
35
|
|
|
|
|
180
|
$state = 'S_CMD'; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
elsif ($Strict) { |
201
|
0
|
|
|
|
|
0
|
$Error = "syntax error: line $.: $_\n"; |
202
|
0
|
|
|
|
|
0
|
return undef; |
203
|
|
|
|
|
|
|
} else { |
204
|
0
|
|
|
|
|
0
|
warn "I dunno how to do with it: $_\n"; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
} |
207
|
13
|
|
|
|
|
33
|
$self->{_tars} = \%tars; |
208
|
13
|
|
|
|
|
52
|
$self->post_parse; |
209
|
|
|
|
|
|
|
#warn Data::Dumper->Dump([\%tars], ['TARGETS']); |
210
|
13
|
|
|
|
|
498
|
close $in; |
211
|
13
|
|
|
|
|
104
|
return $self; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
sub post_parse { |
215
|
13
|
|
|
13
|
1
|
20
|
my $self = shift; |
216
|
13
|
|
|
|
|
25
|
my $rdepends = $self->{_depends}; |
217
|
13
|
|
|
|
|
22
|
my $rimps = $self->{_imps}; |
218
|
13
|
|
|
|
|
311
|
for (keys %$rdepends) { |
219
|
942
|
100
|
|
|
|
1712
|
next if /%/; |
220
|
|
|
|
|
|
|
#warn "Trying to match implicit rules one by one against $_...\n"; |
221
|
933
|
|
|
|
|
1441
|
$self->solve_imp($_); |
222
|
|
|
|
|
|
|
} |
223
|
13
|
|
|
|
|
81
|
for (@$rimps) { |
224
|
9
|
|
|
|
|
40
|
delete $self->{_tars}->{$_}; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub solve_imp { |
229
|
948
|
|
|
948
|
1
|
1009
|
my ($self, $depend) = @_; |
230
|
948
|
|
|
|
|
1071
|
my $rimps = $self->{_imps}; |
231
|
948
|
|
|
|
|
1653
|
for my $imp (@$rimps) { |
232
|
72
|
|
|
|
|
140
|
my $obj = $self->target($imp); |
233
|
72
|
50
|
33
|
|
|
144
|
die "Rules for $imp not found" unless $obj and ref $obj; |
234
|
72
|
|
|
|
|
143
|
my $regex = quotemeta($imp); |
235
|
72
|
|
|
|
|
176
|
$regex =~ s/\\%/(.+)/; # `%' can match any nonempty substring |
236
|
|
|
|
|
|
|
#warn "Processing regex $regex...\n"; |
237
|
72
|
100
|
|
|
|
1027
|
if ($depend =~ m/^$regex$/) { |
238
|
|
|
|
|
|
|
#warn "Succeeded to match $imp against $depend!\n"; |
239
|
15
|
|
|
|
|
33
|
my $matched_part = $1; |
240
|
15
|
|
|
|
|
40
|
my $tar = Makefile::Target->new($depend, $obj->colon_type); |
241
|
15
|
|
|
|
|
23
|
my $dep; |
242
|
15
|
|
|
|
|
42
|
my @deps = map { |
243
|
15
|
|
|
|
|
32
|
s/%/$matched_part/; |
244
|
15
|
|
|
|
|
45
|
$self->{_depends}->{$_} = 1; |
245
|
|
|
|
|
|
|
#warn "Recursively solving dependent gole $_...\n"; |
246
|
15
|
|
|
|
|
48
|
$self->solve_imp($_); |
247
|
15
|
|
|
|
|
22
|
$dep = $_; |
248
|
15
|
|
|
|
|
42
|
$_ |
249
|
|
|
|
|
|
|
} $obj->depends; |
250
|
15
|
|
|
|
|
38
|
$tar->add_depend(@deps); |
251
|
15
|
|
|
|
|
45
|
my @cmds = map { |
252
|
15
|
|
|
|
|
31
|
s/\$$dep/g; |
253
|
15
|
|
|
|
|
63
|
s/\$\*/$matched_part/g; |
254
|
15
|
|
|
|
|
37
|
$_ |
255
|
|
|
|
|
|
|
} $obj->commands; |
256
|
15
|
|
|
|
|
36
|
$tar->add_command(@cmds); |
257
|
15
|
|
|
|
|
83
|
$self->{_tars}->{$depend} = [$tar]; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub var { |
263
|
26
|
|
|
26
|
1
|
323
|
my ($self, $var) = @_; |
264
|
26
|
100
|
|
|
|
74
|
$self->parse if !defined $self->{_file}; |
265
|
26
|
|
|
|
|
136
|
return $self->{_vars}->{$var}; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub vars { |
269
|
2
|
|
|
2
|
1
|
275
|
my $self = shift; |
270
|
2
|
100
|
|
|
|
11
|
$self->parse if !defined $self->{_file}; |
271
|
2
|
|
|
|
|
5
|
return keys %{$self->{_vars}}; |
|
2
|
|
|
|
|
21
|
|
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub target { |
275
|
96
|
|
|
96
|
1
|
445
|
my ($self, $tar_name) = @_; |
276
|
96
|
100
|
|
|
|
250
|
$self->parse if !defined $self->{_file}; |
277
|
96
|
100
|
|
|
|
177
|
return $self->{_default} if !defined $tar_name; |
278
|
94
|
|
|
|
|
163
|
my $tars = $self->{_tars}->{$tar_name}; |
279
|
94
|
|
50
|
|
|
162
|
$tars ||= []; |
280
|
94
|
100
|
|
|
|
249
|
wantarray ? @$tars : $tars->[0]; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub targets { |
284
|
5
|
|
|
5
|
1
|
310
|
my $self = shift; |
285
|
5
|
100
|
|
|
|
19
|
$self->parse if !defined $self->{_file}; |
286
|
5
|
|
|
|
|
11
|
return map { @$_ } values %{$self->{_tars}}; |
|
185
|
|
|
|
|
650
|
|
|
5
|
|
|
|
|
39
|
|
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub roots { |
290
|
6
|
|
|
6
|
1
|
93
|
my $self = shift; |
291
|
6
|
100
|
|
|
|
29
|
$self->parse if !defined $self->{_file}; |
292
|
6
|
|
|
|
|
11
|
my %depends = %{$self->{_depends}}; |
|
6
|
|
|
|
|
198
|
|
293
|
6
|
|
|
|
|
27
|
my %tars = %{$self->{_tars}}; |
|
6
|
|
|
|
|
112
|
|
294
|
6
|
|
|
|
|
21
|
my @roots = (); |
295
|
6
|
|
|
|
|
9
|
my ($key, $val); |
296
|
6
|
|
|
|
|
34
|
while (($key, $val) = each %tars) { |
297
|
|
|
|
|
|
|
#next if $key =~ m/%/; |
298
|
187
|
100
|
|
|
|
542
|
next if $depends{$key}; |
299
|
25
|
|
|
|
|
65
|
push @roots, $key; |
300
|
|
|
|
|
|
|
} |
301
|
6
|
|
|
|
|
306
|
return @roots; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub error { |
305
|
3
|
|
|
3
|
1
|
20
|
return $Error; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub _solve_refs_in_tokens ($$) { |
309
|
1902
|
|
|
1902
|
|
2729
|
my ($self, $tokens) = @_; |
310
|
1902
|
50
|
|
|
|
3576
|
return '' if !$tokens; |
311
|
1902
|
|
|
|
|
3046
|
my $rvars = $self->{_vars}; |
312
|
1902
|
|
|
|
|
2030
|
my @new_tokens; |
313
|
1902
|
|
|
|
|
3471
|
for my $token (@$tokens) { |
314
|
5276
|
100
|
|
|
|
22647
|
if ($token =~ /^\$[{(](.*)[)}]$/) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
315
|
1217
|
|
|
|
|
2590
|
my $s = $1; |
316
|
1217
|
50
|
|
|
|
5944
|
if ($s =~ /^([-\w]+)\s+(.*)$/) { |
|
|
50
|
|
|
|
|
|
317
|
0
|
|
|
|
|
0
|
my $res = $self->_process_func_ref($1, $2); |
318
|
0
|
0
|
|
|
|
0
|
if (defined $res) { |
319
|
0
|
|
|
|
|
0
|
push @new_tokens, $res; |
320
|
0
|
|
|
|
|
0
|
next; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
} elsif ($s =~ /^(\S+?):(\S+?)=(\S+)$/) { |
323
|
0
|
|
|
|
|
0
|
my ($var, $from, $to) = ($1, $2, $3); |
324
|
0
|
|
|
|
|
0
|
my $res = $self->_process_func_ref( |
325
|
|
|
|
|
|
|
'patsubst', "\%$from,\%$to,\$($var)" |
326
|
|
|
|
|
|
|
); |
327
|
0
|
0
|
|
|
|
0
|
if (defined $res) { |
328
|
0
|
|
|
|
|
0
|
push @new_tokens, $res; |
329
|
0
|
|
|
|
|
0
|
next; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
} |
332
|
1217
|
100
|
|
|
|
2390
|
if (exists $rvars->{$s}) { |
333
|
1216
|
|
|
|
|
2099
|
push @new_tokens, $rvars->{$s}; |
334
|
1216
|
|
|
|
|
2320
|
next; |
335
|
|
|
|
|
|
|
} else { |
336
|
|
|
|
|
|
|
# FIXME: undefined var == '' |
337
|
|
|
|
|
|
|
#push @new_tokens, ''; |
338
|
|
|
|
|
|
|
#next; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
} elsif ($token =~ /^\$[@<|]$/) { |
341
|
|
|
|
|
|
|
# currently do nothing with the automatic vars |
342
|
|
|
|
|
|
|
} elsif ($token =~ /^\$\$$/) { |
343
|
0
|
|
|
|
|
0
|
push @new_tokens, '$'; |
344
|
0
|
|
|
|
|
0
|
next; |
345
|
|
|
|
|
|
|
} elsif ($token =~ /^\$(.)$/) { |
346
|
101
|
50
|
|
|
|
344
|
if (exists $rvars->{$1}) { |
347
|
0
|
|
|
|
|
0
|
push @new_tokens, $rvars->{$1}; |
348
|
0
|
|
|
|
|
0
|
next; |
349
|
|
|
|
|
|
|
} else { |
350
|
|
|
|
|
|
|
# FIXME: undef var == '' |
351
|
|
|
|
|
|
|
# push @new_tokens, ''; |
352
|
|
|
|
|
|
|
# next; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
### found single-letter variable: $1 |
355
|
|
|
|
|
|
|
### value: $rvars->{$1} |
356
|
|
|
|
|
|
|
### token: $token |
357
|
|
|
|
|
|
|
} |
358
|
4060
|
|
|
|
|
9592
|
push @new_tokens, $token; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
### retval: join '', @$tokens |
361
|
1902
|
|
|
|
|
9279
|
return join '', @new_tokens; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
sub _process_refs { |
365
|
1902
|
|
|
1902
|
|
3360
|
my ($self, $s) = @_; |
366
|
1902
|
|
|
|
|
3512
|
my @tokens = ''; |
367
|
1902
|
|
|
|
|
1958
|
while (1) { |
368
|
6692
|
100
|
|
|
|
20858
|
if ($s =~ /\G[^\$]+/gc) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
369
|
3103
|
|
|
|
|
8006
|
$tokens[-1] .= $&; |
370
|
|
|
|
|
|
|
} elsif (my $res = _extract_interp($s)) { |
371
|
1217
|
|
|
|
|
2739
|
push @tokens, $res, ''; |
372
|
|
|
|
|
|
|
} elsif ($s =~ /\G\$./gc) { |
373
|
470
|
|
|
|
|
1439
|
push @tokens, $&, ''; |
374
|
|
|
|
|
|
|
} elsif ($s =~ /\G./gc) { |
375
|
0
|
|
|
|
|
0
|
$tokens[-1] .= $&; |
376
|
|
|
|
|
|
|
} else { |
377
|
1902
|
|
|
|
|
2691
|
last; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
### tokens: @tokens |
381
|
1902
|
|
|
|
|
4881
|
return $self->_solve_refs_in_tokens(\@tokens); |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub _pat2re ($@) { |
385
|
0
|
|
|
0
|
|
0
|
my ($pat, $capture) = @_; |
386
|
0
|
|
|
|
|
0
|
$pat = quotemeta $pat; |
387
|
0
|
0
|
|
|
|
0
|
if ($capture) { |
388
|
0
|
|
|
|
|
0
|
$pat =~ s/\\\%/(\\S*)/g; |
389
|
|
|
|
|
|
|
} else { |
390
|
0
|
|
|
|
|
0
|
$pat =~ s/\\\%/\\S*/g; |
391
|
|
|
|
|
|
|
} |
392
|
0
|
|
|
|
|
0
|
$pat; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub _text2words ($) { |
396
|
0
|
|
|
0
|
|
0
|
my ($text) = @_; |
397
|
0
|
|
|
|
|
0
|
$text =~ s/^\s+|\s+$//g; |
398
|
0
|
|
|
|
|
0
|
split /\s+/, $text; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sub _check_numeric ($$$$) { |
402
|
0
|
|
|
0
|
|
0
|
my ($self, $func, $order, $n) = @_; |
403
|
0
|
0
|
|
|
|
0
|
if ($n !~ /^\d+$/) { |
404
|
0
|
|
|
|
|
0
|
warn $self->{_file}, ":$.: ", |
405
|
|
|
|
|
|
|
"*** non-numeric $order argument to `$func' function: '$n'. Stop.\n"; |
406
|
0
|
|
|
|
|
0
|
exit(2); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
sub _check_greater_than ($$$$$) { |
411
|
0
|
|
|
0
|
|
0
|
my ($self, $func, $order, $n, $value) = @_; |
412
|
0
|
0
|
|
|
|
0
|
if ($n <= $value) { |
413
|
0
|
|
|
|
|
0
|
warn $self->{_file}, ":$.: *** $order argument to `$func' function must be greater than $value. Stop.\n"; |
414
|
0
|
|
|
|
|
0
|
exit(2); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub _trim ($@) { |
419
|
0
|
|
|
0
|
|
0
|
for (@_) { |
420
|
0
|
|
|
|
|
0
|
s/^\s+|\s+$//g; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
sub _split_args($$$$) { |
425
|
0
|
|
|
0
|
|
0
|
my ($self, $func, $s, $m, $n) = @_; |
426
|
0
|
|
0
|
|
|
0
|
$n ||= $m; |
427
|
0
|
|
|
|
|
0
|
my @tokens = ''; |
428
|
0
|
|
|
|
|
0
|
my @args; |
429
|
|
|
|
|
|
|
### $n |
430
|
0
|
|
|
|
|
0
|
while (@args <= $n) { |
431
|
|
|
|
|
|
|
### split args: @args |
432
|
|
|
|
|
|
|
### split tokens: @tokens |
433
|
0
|
0
|
|
|
|
0
|
if ($s =~ /\G\s+/gc) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
434
|
0
|
|
|
|
|
0
|
push @tokens, $&, ''; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
elsif ($s =~ /\G[^\$,]+/gc) { |
437
|
0
|
|
|
|
|
0
|
$tokens[-1] .= $&; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
elsif ($s =~ /\G,/gc) { |
440
|
0
|
0
|
|
|
|
0
|
if (@args < $n - 1) { |
441
|
0
|
|
|
|
|
0
|
push @args, [grep { $_ ne '' } @tokens]; |
|
0
|
|
|
|
|
0
|
|
442
|
0
|
|
|
|
|
0
|
@tokens = ''; |
443
|
|
|
|
|
|
|
} else { |
444
|
0
|
|
|
|
|
0
|
$tokens[-1] .= $&; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
elsif (my $res = _extract_interp($s)) { |
448
|
0
|
|
|
|
|
0
|
push @tokens, $res, ''; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
elsif ($s =~ /\G\$./gc) { |
451
|
0
|
|
|
|
|
0
|
push @tokens, $&, ''; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
elsif ($s =~ /\G./gc) { |
454
|
0
|
|
|
|
|
0
|
$tokens[-1] .= $&; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
else { |
457
|
0
|
0
|
|
|
|
0
|
if (@args <= $n - 1) { |
458
|
0
|
|
|
|
|
0
|
push @args, [grep { $_ ne '' } @tokens]; |
|
0
|
|
|
|
|
0
|
|
459
|
|
|
|
|
|
|
} |
460
|
0
|
0
|
0
|
|
|
0
|
last if @args >= $m and @args <= $n; |
461
|
0
|
|
|
|
|
0
|
warn $self->{_file}, ":$.: ", |
462
|
|
|
|
|
|
|
"*** insufficient number of arguments (", |
463
|
|
|
|
|
|
|
scalar(@args), ") to function `$func'. Stop.\n"; |
464
|
0
|
|
|
|
|
0
|
exit(2); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} |
467
|
0
|
|
|
|
|
0
|
return @args; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
sub _trim_tokens ($) { |
471
|
0
|
|
|
0
|
|
0
|
my $tokens = shift; |
472
|
0
|
0
|
|
|
|
0
|
return if !@$tokens; |
473
|
0
|
0
|
|
|
|
0
|
if ($tokens->[0] =~ /^\s+$/) { |
474
|
0
|
|
|
|
|
0
|
shift @$tokens; |
475
|
|
|
|
|
|
|
} |
476
|
0
|
0
|
|
|
|
0
|
return if !@$tokens; |
477
|
0
|
0
|
|
|
|
0
|
if ($tokens->[-1] =~ /^\s+$/) { |
478
|
0
|
|
|
|
|
0
|
pop @$tokens; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
sub _process_func_ref ($$$) { |
483
|
0
|
|
|
0
|
|
0
|
my ($self, $name, $args) = @_; |
484
|
|
|
|
|
|
|
#### process func ref: $name |
485
|
0
|
|
|
|
|
0
|
$name = $self->_process_refs($name); |
486
|
0
|
|
|
|
|
0
|
my @args; |
487
|
0
|
|
|
|
|
0
|
my $nargs = scalar(@args); |
488
|
0
|
0
|
|
|
|
0
|
if ($name eq 'subst') { |
489
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 3); |
490
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
491
|
|
|
|
|
|
|
### arguments: @args |
492
|
0
|
|
|
|
|
0
|
my ($from, $to, $text) = @args; |
493
|
0
|
|
|
|
|
0
|
$from = quotemeta($from); |
494
|
0
|
|
|
|
|
0
|
$text =~ s/$from/$to/g; |
495
|
0
|
|
|
|
|
0
|
return $text; |
496
|
|
|
|
|
|
|
} |
497
|
0
|
0
|
|
|
|
0
|
if ($name eq 'patsubst') { |
498
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 3); |
499
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
500
|
0
|
|
|
|
|
0
|
my ($pattern, $replacement, $text) = @args; |
501
|
0
|
|
|
|
|
0
|
my $re = _pat2re($pattern, 1); |
502
|
0
|
|
|
|
|
0
|
$replacement =~ s/\%/\${1}/g; |
503
|
0
|
|
|
|
|
0
|
$replacement = qq("$replacement"); |
504
|
|
|
|
|
|
|
#### pattern: $re |
505
|
|
|
|
|
|
|
#### replacement: $replacement |
506
|
|
|
|
|
|
|
#### text: $text |
507
|
0
|
|
|
|
|
0
|
my $code = "s/^$re\$/$replacement/e"; |
508
|
|
|
|
|
|
|
#### code: $code |
509
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
510
|
0
|
|
|
|
|
0
|
map { eval $code; } @words; |
|
0
|
|
|
|
|
0
|
|
511
|
0
|
|
|
|
|
0
|
return join ' ', grep { $_ ne '' } @words; |
|
0
|
|
|
|
|
0
|
|
512
|
|
|
|
|
|
|
} |
513
|
0
|
0
|
|
|
|
0
|
if ($name eq 'strip') { |
514
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
515
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
516
|
0
|
|
|
|
|
0
|
my ($string) = @args; |
517
|
0
|
|
|
|
|
0
|
$string =~ s/^\s+|\s+$//g; |
518
|
0
|
|
|
|
|
0
|
$string =~ s/\s+/ /g; |
519
|
0
|
|
|
|
|
0
|
return $string; |
520
|
|
|
|
|
|
|
} |
521
|
0
|
0
|
|
|
|
0
|
if ($name eq 'findstring') { |
522
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 2); |
523
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
524
|
0
|
|
|
|
|
0
|
my ($find, $in) = @args; |
525
|
0
|
0
|
|
|
|
0
|
if (index($in, $find) >= 0) { |
526
|
0
|
|
|
|
|
0
|
return $find; |
527
|
|
|
|
|
|
|
} else { |
528
|
0
|
|
|
|
|
0
|
return ''; |
529
|
|
|
|
|
|
|
} |
530
|
0
|
|
|
|
|
0
|
my ($patterns, $text) = @args; |
531
|
0
|
|
|
|
|
0
|
my @regexes = map { _pat2re($_) } |
|
0
|
|
|
|
|
0
|
|
532
|
|
|
|
|
|
|
split /\s+/, $patterns; |
533
|
|
|
|
|
|
|
### regexes: @regexes |
534
|
0
|
|
|
|
|
0
|
my $regex = join '|', map { "(?:$_)" } @regexes; |
|
0
|
|
|
|
|
0
|
|
535
|
|
|
|
|
|
|
### regex: $regex |
536
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
537
|
0
|
|
|
|
|
0
|
return join ' ', grep /^$regex$/, @words; |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
} |
540
|
0
|
0
|
|
|
|
0
|
if ($name eq 'filter') { |
541
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 2); |
542
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
543
|
0
|
|
|
|
|
0
|
my ($patterns, $text) = @args; |
544
|
0
|
|
|
|
|
0
|
my @regexes = map { _pat2re($_) } |
|
0
|
|
|
|
|
0
|
|
545
|
|
|
|
|
|
|
split /\s+/, $patterns; |
546
|
|
|
|
|
|
|
### regexes: @regexes |
547
|
0
|
|
|
|
|
0
|
my $regex = join '|', map { "(?:$_)" } @regexes; |
|
0
|
|
|
|
|
0
|
|
548
|
|
|
|
|
|
|
### regex: $regex |
549
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
550
|
0
|
|
|
|
|
0
|
return join ' ', grep /^$regex$/, @words; |
551
|
|
|
|
|
|
|
} |
552
|
0
|
0
|
|
|
|
0
|
if ($name eq 'filter-out') { |
553
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 2); |
554
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
555
|
0
|
|
|
|
|
0
|
my ($patterns, $text) = @args; |
556
|
0
|
|
|
|
|
0
|
my @regexes = map { _pat2re($_) } |
|
0
|
|
|
|
|
0
|
|
557
|
|
|
|
|
|
|
split /\s+/, $patterns; |
558
|
|
|
|
|
|
|
### regexes: @regexes |
559
|
0
|
|
|
|
|
0
|
my $regex = join '|', map { "(?:$_)" } @regexes; |
|
0
|
|
|
|
|
0
|
|
560
|
|
|
|
|
|
|
### regex: $regex |
561
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
562
|
0
|
|
|
|
|
0
|
return join ' ', grep !/^$regex$/, @words; |
563
|
|
|
|
|
|
|
} |
564
|
0
|
0
|
|
|
|
0
|
if ($name eq 'sort') { |
565
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
566
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
567
|
0
|
|
|
|
|
0
|
my ($list) = @args; |
568
|
0
|
|
|
|
|
0
|
_trim($list); |
569
|
0
|
|
|
|
|
0
|
return join ' ', uniq sort split /\s+/, $list; |
570
|
|
|
|
|
|
|
} |
571
|
0
|
0
|
|
|
|
0
|
if ($name eq 'words') { |
572
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
573
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
574
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
575
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
576
|
0
|
|
|
|
|
0
|
return scalar(@words); |
577
|
|
|
|
|
|
|
} |
578
|
0
|
0
|
|
|
|
0
|
if ($name eq 'word') { |
579
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 2); |
580
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
581
|
0
|
|
|
|
|
0
|
my ($n, $text) = @args; |
582
|
0
|
|
|
|
|
0
|
_trim($n); |
583
|
0
|
|
|
|
|
0
|
$self->_check_numeric('word', 'first', $n); |
584
|
0
|
|
|
|
|
0
|
$self->_check_greater_than('word', 'first', $n, 0); |
585
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
586
|
0
|
0
|
|
|
|
0
|
return $n > @words ? '' : $words[$n - 1]; |
587
|
|
|
|
|
|
|
} |
588
|
0
|
0
|
|
|
|
0
|
if ($name eq 'wordlist') { |
589
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 3); |
590
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
591
|
0
|
|
|
|
|
0
|
my ($s, $e, $text) = @args; |
592
|
0
|
|
|
|
|
0
|
_trim($s, $e, $text); |
593
|
0
|
|
|
|
|
0
|
$self->_check_numeric('wordlist', 'first', $s); |
594
|
0
|
|
|
|
|
0
|
$self->_check_numeric('wordlist', 'second', $e); |
595
|
0
|
|
|
|
|
0
|
$self->_check_greater_than('wordlist', 'first', $s, 0); |
596
|
0
|
|
|
|
|
0
|
$self->_check_greater_than('wordlist', 'second', $s, -1); |
597
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
598
|
0
|
0
|
0
|
|
|
0
|
if ($s > $e || $s > @words || $e == 0) { |
|
|
|
0
|
|
|
|
|
599
|
0
|
|
|
|
|
0
|
return ''; |
600
|
|
|
|
|
|
|
} |
601
|
0
|
0
|
|
|
|
0
|
$e = @words if $e > @words; |
602
|
0
|
|
|
|
|
0
|
return join ' ', @words[$s-1..$e-1]; |
603
|
|
|
|
|
|
|
} |
604
|
0
|
0
|
|
|
|
0
|
if ($name eq 'firstword') { |
605
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
606
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
607
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
608
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
609
|
0
|
0
|
|
|
|
0
|
return @words > 0 ? $words[0] : ''; |
610
|
|
|
|
|
|
|
} |
611
|
0
|
0
|
|
|
|
0
|
if ($name eq 'lastword') { |
612
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
613
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
614
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
615
|
0
|
|
|
|
|
0
|
my @words = _text2words($text); |
616
|
0
|
0
|
|
|
|
0
|
return @words > 0 ? $words[-1] : ''; |
617
|
|
|
|
|
|
|
} |
618
|
0
|
0
|
|
|
|
0
|
if ($name eq 'dir') { |
619
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
620
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
621
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
622
|
0
|
|
|
|
|
0
|
my @names = _text2words($text); |
623
|
0
|
0
|
|
|
|
0
|
return join ' ', map { /.*\// ? $& : './' } @names; |
|
0
|
|
|
|
|
0
|
|
624
|
|
|
|
|
|
|
} |
625
|
0
|
0
|
|
|
|
0
|
if ($name eq 'notdir') { |
626
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
627
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
628
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
629
|
0
|
|
|
|
|
0
|
my @names = _text2words($text); |
630
|
0
|
|
|
|
|
0
|
return join ' ', map { s/.*\///; $_ } @names; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
631
|
|
|
|
|
|
|
} |
632
|
0
|
0
|
|
|
|
0
|
if ($name eq 'suffix') { |
633
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
634
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
635
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
636
|
0
|
|
|
|
|
0
|
my @names = _text2words($text); |
637
|
0
|
0
|
|
|
|
0
|
my $s = join ' ', map { /.*(\..*)/ ? $1 : '' } @names; |
|
0
|
|
|
|
|
0
|
|
638
|
0
|
|
|
|
|
0
|
$s =~ s/\s+$//g; |
639
|
0
|
|
|
|
|
0
|
return $s; |
640
|
|
|
|
|
|
|
} |
641
|
0
|
0
|
|
|
|
0
|
if ($name eq 'basename') { |
642
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
643
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
644
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
645
|
0
|
|
|
|
|
0
|
my @names = _text2words($text); |
646
|
0
|
0
|
|
|
|
0
|
my $s = join ' ', map { /(.*)\./ ? $1 : $_ } @names; |
|
0
|
|
|
|
|
0
|
|
647
|
0
|
|
|
|
|
0
|
$s =~ s/\s+$//g; |
648
|
0
|
|
|
|
|
0
|
return $s; |
649
|
|
|
|
|
|
|
} |
650
|
0
|
0
|
|
|
|
0
|
if ($name eq 'addsuffix') { |
651
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 2); |
652
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
653
|
0
|
|
|
|
|
0
|
my ($suffix, $text) = @args; |
654
|
|
|
|
|
|
|
#_trim($suffix); |
655
|
0
|
|
|
|
|
0
|
my @names = _text2words($text); |
656
|
0
|
|
|
|
|
0
|
return join ' ', map { $_ . $suffix } @names; |
|
0
|
|
|
|
|
0
|
|
657
|
|
|
|
|
|
|
} |
658
|
0
|
0
|
|
|
|
0
|
if ($name eq 'addprefix') { |
659
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 2); |
660
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
661
|
0
|
|
|
|
|
0
|
my ($suffix, $text) = @args; |
662
|
|
|
|
|
|
|
#_trim($suffix); |
663
|
0
|
|
|
|
|
0
|
my @names = _text2words($text); |
664
|
0
|
|
|
|
|
0
|
return join ' ', map { $suffix . $_ } @names; |
|
0
|
|
|
|
|
0
|
|
665
|
|
|
|
|
|
|
} |
666
|
0
|
0
|
|
|
|
0
|
if ($name eq 'join') { |
667
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 2); |
668
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
669
|
0
|
|
|
|
|
0
|
my ($list_1, $list_2) = @args; |
670
|
0
|
|
|
|
|
0
|
my @list_1 = _text2words($list_1); |
671
|
0
|
|
|
|
|
0
|
my @list_2 = _text2words($list_2); |
672
|
|
|
|
|
|
|
return join ' ', pairwise { |
673
|
1
|
|
|
1
|
|
12
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
262
|
|
674
|
0
|
|
|
0
|
|
0
|
$a . $b |
675
|
0
|
|
|
|
|
0
|
} @list_1, @list_2; |
676
|
|
|
|
|
|
|
} |
677
|
0
|
0
|
|
|
|
0
|
if ($name eq 'wildcard') { |
678
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
679
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
680
|
0
|
|
|
|
|
0
|
my ($pattern) = @args; |
681
|
0
|
|
|
|
|
0
|
return join ' ', grep { -e $_ } glob $pattern; |
|
0
|
|
|
|
|
0
|
|
682
|
|
|
|
|
|
|
} |
683
|
0
|
0
|
|
|
|
0
|
if ($name eq 'realpath') { |
684
|
1
|
|
|
1
|
|
5
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1704
|
|
685
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
686
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
687
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
688
|
0
|
|
|
|
|
0
|
my @names = _text2words($text); |
689
|
0
|
|
|
|
|
0
|
return join ' ', map { realpath($_) } @names; |
|
0
|
|
|
|
|
0
|
|
690
|
|
|
|
|
|
|
} |
691
|
0
|
0
|
|
|
|
0
|
if ($name eq 'abspath') { |
692
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
693
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
694
|
0
|
|
|
|
|
0
|
my ($text) = @args; |
695
|
0
|
|
|
|
|
0
|
my @names = _text2words($text); |
696
|
0
|
|
|
|
|
0
|
my @paths = map { File::Spec->rel2abs($_) } @names; |
|
0
|
|
|
|
|
0
|
|
697
|
0
|
|
|
|
|
0
|
for my $path (@paths) { |
698
|
0
|
|
|
|
|
0
|
my @f = split '/', $path; |
699
|
0
|
|
|
|
|
0
|
my @new_f; |
700
|
0
|
|
|
|
|
0
|
for (@f) { |
701
|
0
|
0
|
|
|
|
0
|
if ($_ eq '..') { |
702
|
0
|
|
|
|
|
0
|
pop @new_f; |
703
|
|
|
|
|
|
|
} else { |
704
|
0
|
|
|
|
|
0
|
push @new_f, $_; |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
} |
707
|
0
|
|
|
|
|
0
|
$path = join '/', @new_f; |
708
|
|
|
|
|
|
|
} |
709
|
0
|
|
|
|
|
0
|
return join ' ', @paths; |
710
|
|
|
|
|
|
|
} |
711
|
0
|
0
|
|
|
|
0
|
if ($name eq 'shell') { |
712
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1); |
713
|
0
|
|
|
|
|
0
|
map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
|
0
|
|
|
|
|
0
|
|
714
|
0
|
|
|
|
|
0
|
my ($cmd) = @args; |
715
|
0
|
|
|
|
|
0
|
my $output = `$cmd`; |
716
|
0
|
|
|
|
|
0
|
$output =~ s/(?:\r?\n)+$//g; |
717
|
0
|
|
|
|
|
0
|
$output =~ s/\r?\n/ /g; |
718
|
0
|
|
|
|
|
0
|
return $output; |
719
|
|
|
|
|
|
|
} |
720
|
0
|
0
|
|
|
|
0
|
if ($name eq 'if') { |
721
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 2, 3); |
722
|
|
|
|
|
|
|
#map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
723
|
0
|
|
|
|
|
0
|
my ($condition, $then_part, $else_part) = @args; |
724
|
0
|
|
|
|
|
0
|
_trim_tokens($condition); |
725
|
0
|
|
|
|
|
0
|
$condition = $self->_solve_refs_in_tokens($condition); |
726
|
0
|
0
|
|
|
|
0
|
return $condition eq '' ? |
727
|
|
|
|
|
|
|
$self->_solve_refs_in_tokens($else_part) |
728
|
|
|
|
|
|
|
: |
729
|
|
|
|
|
|
|
$self->_solve_refs_in_tokens($then_part); |
730
|
|
|
|
|
|
|
} |
731
|
0
|
0
|
|
|
|
0
|
if ($name eq 'or') { |
732
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1, 1000_000_000); |
733
|
|
|
|
|
|
|
#map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
734
|
0
|
|
|
|
|
0
|
for my $arg (@args) { |
735
|
0
|
|
|
|
|
0
|
_trim_tokens($arg); |
736
|
0
|
|
|
|
|
0
|
my $value = $self->_solve_refs_in_tokens($arg); |
737
|
0
|
0
|
|
|
|
0
|
return $value if $value ne ''; |
738
|
|
|
|
|
|
|
} |
739
|
0
|
|
|
|
|
0
|
return ''; |
740
|
|
|
|
|
|
|
} |
741
|
0
|
0
|
|
|
|
0
|
if ($name eq 'and') { |
742
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 1, 1000_000_000); |
743
|
|
|
|
|
|
|
#map { $_ = $self->_solve_refs_in_tokens($_) } @args; |
744
|
|
|
|
|
|
|
### arguments for 'and': @args |
745
|
0
|
|
|
|
|
0
|
my $value; |
746
|
0
|
|
|
|
|
0
|
for my $arg (@args) { |
747
|
0
|
|
|
|
|
0
|
_trim_tokens($arg); |
748
|
0
|
|
|
|
|
0
|
$value = $self->_solve_refs_in_tokens($arg); |
749
|
0
|
0
|
|
|
|
0
|
return '' if $value eq ''; |
750
|
|
|
|
|
|
|
} |
751
|
0
|
|
|
|
|
0
|
return $value; |
752
|
|
|
|
|
|
|
} |
753
|
0
|
0
|
|
|
|
0
|
if ($name eq 'foreach') { |
754
|
0
|
|
|
|
|
0
|
my @args = $self->_split_args($name, $args, 3); |
755
|
0
|
|
|
|
|
0
|
my ($var, $list, $text) = @args; |
756
|
0
|
|
|
|
|
0
|
$var = $self->_solve_refs_in_tokens($var); |
757
|
0
|
|
|
|
|
0
|
$list = $self->_solve_refs_in_tokens($list); |
758
|
0
|
|
|
|
|
0
|
my @words = _text2words($list); |
759
|
|
|
|
|
|
|
# save the original status of $var |
760
|
0
|
|
|
|
|
0
|
my $rvars = $self->{_vars}; |
761
|
0
|
|
|
|
|
0
|
my $not_exist = !exists $rvars->{$var}; |
762
|
0
|
|
|
|
|
0
|
my $old_val = $rvars->{$var}; |
763
|
|
|
|
|
|
|
|
764
|
0
|
|
|
|
|
0
|
my @results; |
765
|
0
|
|
|
|
|
0
|
for my $word (@words) { |
766
|
0
|
|
|
|
|
0
|
$rvars->{$var} = $word; |
767
|
|
|
|
|
|
|
#warn "$word"; |
768
|
0
|
|
|
|
|
0
|
push @results, $self->_solve_refs_in_tokens($text); |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
# restore the original status of $var |
772
|
0
|
0
|
|
|
|
0
|
if ($not_exist) { |
773
|
0
|
|
|
|
|
0
|
delete $rvars->{$var}; |
774
|
|
|
|
|
|
|
} else { |
775
|
0
|
|
|
|
|
0
|
$rvars->{$var} = $old_val; |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
0
|
|
|
|
|
0
|
return join ' ', @results; |
779
|
|
|
|
|
|
|
} |
780
|
0
|
0
|
|
|
|
0
|
if ($name eq 'error') { |
781
|
0
|
|
|
|
|
0
|
my ($text) = $self->_split_args($name, $args, 1); |
782
|
0
|
|
|
|
|
0
|
$text = $self->_solve_refs_in_tokens($text); |
783
|
0
|
|
|
|
|
0
|
warn $self->{_file}, ":$.: *** $text. Stop.\n"; |
784
|
0
|
0
|
|
|
|
0
|
exit(2) if $Runtime; |
785
|
0
|
|
|
|
|
0
|
return ''; |
786
|
|
|
|
|
|
|
} |
787
|
0
|
0
|
|
|
|
0
|
if ($name eq 'warning') { |
788
|
0
|
|
|
|
|
0
|
my ($text) = $self->_split_args($name, $args, 1); |
789
|
0
|
|
|
|
|
0
|
$text = $self->_solve_refs_in_tokens($text); |
790
|
0
|
|
|
|
|
0
|
warn $self->{_file}, ":$.: $text\n"; |
791
|
0
|
|
|
|
|
0
|
return ''; |
792
|
|
|
|
|
|
|
} |
793
|
0
|
0
|
|
|
|
0
|
if ($name eq 'info') { |
794
|
0
|
|
|
|
|
0
|
my ($text) = $self->_split_args($name, $args, 1); |
795
|
0
|
|
|
|
|
0
|
$text = $self->_solve_refs_in_tokens($text); |
796
|
0
|
|
|
|
|
0
|
print "$text\n"; |
797
|
0
|
|
|
|
|
0
|
return ''; |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
|
800
|
0
|
|
|
|
|
0
|
return undef; |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
####################################### |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
package Makefile::Target; |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
use overload |
808
|
274
|
|
|
274
|
|
488
|
'""' => sub { shift->name }, |
809
|
33
|
|
|
33
|
|
63
|
'cmp' => sub { my ($a,$b) = @_; "$a" cmp "$b" }, |
|
33
|
|
|
|
|
57
|
|
810
|
0
|
|
|
0
|
|
0
|
'eq' => sub { my ($a,$b) = @_; "$a" eq "$b" }, |
|
0
|
|
|
|
|
0
|
|
811
|
1
|
|
|
1
|
|
8
|
'lt' => sub { my ($a,$b) = @_; "$a" lt "$b" }; |
|
1
|
|
|
0
|
|
2
|
|
|
1
|
|
|
|
|
27
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
# usage: $class->new($name, $colon_type) |
814
|
|
|
|
|
|
|
sub new { |
815
|
613
|
|
|
613
|
|
958
|
my $class = shift; |
816
|
613
|
|
|
|
|
3040
|
my $self = { |
817
|
|
|
|
|
|
|
_name => shift, |
818
|
|
|
|
|
|
|
_colon_type => shift, |
819
|
|
|
|
|
|
|
_commands => [], |
820
|
|
|
|
|
|
|
_depends => [], |
821
|
|
|
|
|
|
|
}; |
822
|
613
|
|
|
|
|
2000
|
return bless $self, $class; |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
sub name { |
826
|
1139
|
|
|
1139
|
|
3193
|
return shift->{_name}; |
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
sub colon_type { |
830
|
22
|
|
|
22
|
|
102
|
return shift->{_colon_type}; |
831
|
|
|
|
|
|
|
} |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
sub prereqs { |
834
|
39
|
|
|
39
|
|
63
|
return @{shift->{_depends}}; |
|
39
|
|
|
|
|
161
|
|
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
*depends = \&prereqs; |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
sub add_prereq { |
840
|
629
|
|
|
629
|
|
664
|
push @{shift->{_depends}}, @_; |
|
629
|
|
|
|
|
2197
|
|
841
|
|
|
|
|
|
|
} |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
*add_depend = \&add_prereq; |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
sub commands { |
846
|
29
|
|
|
29
|
|
79
|
return @{shift->{_commands}}; |
|
29
|
|
|
|
|
299
|
|
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
sub add_command { |
850
|
841
|
|
|
841
|
|
1045
|
my $self = shift; |
851
|
841
|
|
|
|
|
1674
|
my @cmds = @_; |
852
|
841
|
|
|
|
|
1576
|
my $name = $self->name; |
853
|
841
|
100
|
|
|
|
2129
|
if ($name !~ m/%/) { |
854
|
832
|
|
|
|
|
1454
|
map { s/\$\@/$self->{_name}/g } @cmds; |
|
833
|
|
|
|
|
3863
|
|
855
|
|
|
|
|
|
|
} |
856
|
841
|
|
|
|
|
1013
|
push @{$self->{_commands}}, @cmds; |
|
841
|
|
|
|
|
6107
|
|
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
sub run_commands { |
860
|
0
|
|
|
0
|
|
|
my $self = shift; |
861
|
0
|
|
|
|
|
|
my @cmd = $self->commands; |
862
|
0
|
|
|
|
|
|
for my $cmd (@cmd) { |
863
|
0
|
|
|
|
|
|
my ($quiet, $continue); |
864
|
0
|
|
|
|
|
|
while (1) { |
865
|
0
|
0
|
|
|
|
|
if ($cmd =~ s/^\s*\@//) { |
|
|
0
|
|
|
|
|
|
866
|
0
|
|
|
|
|
|
$quiet = 1; |
867
|
|
|
|
|
|
|
} elsif ($cmd =~ s/^\s*-//) { |
868
|
0
|
|
|
|
|
|
$continue = 1; |
869
|
|
|
|
|
|
|
} else { |
870
|
0
|
|
|
|
|
|
last; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
} |
873
|
0
|
|
|
|
|
|
$cmd =~ s/^\s+|\s+$//gs; |
874
|
0
|
0
|
|
|
|
|
next if $cmd =~ /^$/; |
875
|
0
|
0
|
|
|
|
|
print "$cmd\n" unless $quiet; |
876
|
|
|
|
|
|
|
# currently only 'sh' is specified |
877
|
0
|
|
|
|
|
|
system('/bin/sh', '-c', $cmd); |
878
|
0
|
0
|
0
|
|
|
|
if ($? != 0 && !$continue) { |
879
|
0
|
|
|
|
|
|
die "$cmd returns nonzero status value: $?\n"; |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
1; |
885
|
|
|
|
|
|
|
__END__ |