Merge lp:~percona-toolkit-dev/percona-toolkit/fix-option-parser-bug-1199589-2.1 into lp:percona-toolkit/2.1
- fix-option-parser-bug-1199589-2.1
- Merge into 2.1
Proposed by
Daniel Nichter
Status: | Superseded | ||||
---|---|---|---|---|---|
Proposed branch: | lp:~percona-toolkit-dev/percona-toolkit/fix-option-parser-bug-1199589-2.1 | ||||
Merge into: | lp:percona-toolkit/2.1 | ||||
Diff against target: |
2615 lines (+1601/-86) 31 files modified
bin/pt-archiver (+51/-1) bin/pt-config-diff (+51/-1) bin/pt-deadlock-logger (+51/-1) bin/pt-diskstats (+51/-1) bin/pt-duplicate-key-checker (+51/-1) bin/pt-fifo-split (+51/-1) bin/pt-find (+51/-1) bin/pt-fingerprint (+51/-1) bin/pt-fk-error-logger (+51/-1) bin/pt-heartbeat (+51/-1) bin/pt-index-usage (+51/-1) bin/pt-kill (+51/-1) bin/pt-log-player (+51/-1) bin/pt-online-schema-change (+51/-1) bin/pt-query-advisor (+51/-1) bin/pt-query-digest (+51/-1) bin/pt-show-grants (+51/-1) bin/pt-slave-delay (+51/-1) bin/pt-slave-find (+51/-1) bin/pt-slave-restart (+51/-1) bin/pt-table-checksum (+51/-1) bin/pt-table-sync (+51/-1) bin/pt-table-usage (+57/-10) bin/pt-tcp-model (+51/-1) bin/pt-trend (+51/-1) bin/pt-upgrade (+51/-1) bin/pt-variable-advisor (+51/-1) bin/pt-visual-explain (+57/-10) lib/OptionParser.pm (+52/-40) t/lib/OptionParser.t (+53/-0) t/pt-archiver/bugs.t (+56/-0) |
||||
To merge this branch: | bzr merge lp:~percona-toolkit-dev/percona-toolkit/fix-option-parser-bug-1199589-2.1 | ||||
Related bugs: |
|
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Daniel Nichter | Approve | ||
Review via email: mp+180024@code.launchpad.net |
This proposal has been superseded by a proposal from 2013-08-14.
Commit message
Description of the change
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) : | # |
review:
Approve
Unmerged revisions
- 544. By Daniel Nichter
-
Apply t/pt-archiver/
bugs.t. - 543. By Daniel Nichter
-
Update OptionParser in all tools.
- 542. By Daniel Nichter
-
Apply fixed OptionParser.pm and tests.
Preview Diff
[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1 | === modified file 'bin/pt-archiver' | |||
2 | --- bin/pt-archiver 2013-07-18 17:31:04 +0000 | |||
3 | +++ bin/pt-archiver 2013-08-14 00:47:54 +0000 | |||
4 | @@ -65,6 +65,7 @@ | |||
5 | 65 | 65 | ||
6 | 66 | use List::Util qw(max); | 66 | use List::Util qw(max); |
7 | 67 | use Getopt::Long; | 67 | use Getopt::Long; |
8 | 68 | use Data::Dumper; | ||
9 | 68 | 69 | ||
10 | 69 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 70 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
11 | 70 | 71 | ||
12 | @@ -460,11 +461,21 @@ | |||
13 | 460 | my $long = exists $self->{opts}->{$opt} ? $opt | 461 | my $long = exists $self->{opts}->{$opt} ? $opt |
14 | 461 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 462 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
15 | 462 | : die "Getopt::Long gave a nonexistent option: $opt"; | 463 | : die "Getopt::Long gave a nonexistent option: $opt"; |
16 | 463 | |||
17 | 464 | $opt = $self->{opts}->{$long}; | 464 | $opt = $self->{opts}->{$long}; |
18 | 465 | if ( $opt->{is_cumulative} ) { | 465 | if ( $opt->{is_cumulative} ) { |
19 | 466 | $opt->{value}++; | 466 | $opt->{value}++; |
20 | 467 | } | 467 | } |
21 | 468 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
22 | 469 | my $next_opt = $1; | ||
23 | 470 | if ( exists $self->{opts}->{$next_opt} | ||
24 | 471 | || exists $self->{short_opts}->{$next_opt} ) { | ||
25 | 472 | $self->save_error("--$long requires a string value"); | ||
26 | 473 | return; | ||
27 | 474 | } | ||
28 | 475 | else { | ||
29 | 476 | $opt->{value} = $val; | ||
30 | 477 | } | ||
31 | 478 | } | ||
32 | 468 | else { | 479 | else { |
33 | 469 | $opt->{value} = $val; | 480 | $opt->{value} = $val; |
34 | 470 | } | 481 | } |
35 | @@ -1048,6 +1059,45 @@ | |||
36 | 1048 | ); | 1059 | ); |
37 | 1049 | }; | 1060 | }; |
38 | 1050 | 1061 | ||
39 | 1062 | sub set_vars { | ||
40 | 1063 | my ($self, $file) = @_; | ||
41 | 1064 | $file ||= $self->{file} || __FILE__; | ||
42 | 1065 | |||
43 | 1066 | my %user_vars; | ||
44 | 1067 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
45 | 1068 | if ( $user_vars ) { | ||
46 | 1069 | foreach my $var_val ( @$user_vars ) { | ||
47 | 1070 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
48 | 1071 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
49 | 1072 | $user_vars{$var} = { | ||
50 | 1073 | val => $val, | ||
51 | 1074 | default => 0, | ||
52 | 1075 | }; | ||
53 | 1076 | } | ||
54 | 1077 | } | ||
55 | 1078 | |||
56 | 1079 | my %default_vars; | ||
57 | 1080 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
58 | 1081 | if ( $default_vars ) { | ||
59 | 1082 | %default_vars = map { | ||
60 | 1083 | my $var_val = $_; | ||
61 | 1084 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
62 | 1085 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
63 | 1086 | $var => { | ||
64 | 1087 | val => $val, | ||
65 | 1088 | default => 1, | ||
66 | 1089 | }; | ||
67 | 1090 | } split("\n", $default_vars); | ||
68 | 1091 | } | ||
69 | 1092 | |||
70 | 1093 | my %vars = ( | ||
71 | 1094 | %default_vars, # first the tool's defaults | ||
72 | 1095 | %user_vars, # then the user's which overwrite the defaults | ||
73 | 1096 | ); | ||
74 | 1097 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
75 | 1098 | return \%vars; | ||
76 | 1099 | } | ||
77 | 1100 | |||
78 | 1051 | sub _d { | 1101 | sub _d { |
79 | 1052 | my ($package, undef, $line) = caller 0; | 1102 | my ($package, undef, $line) = caller 0; |
80 | 1053 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1103 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
81 | 1054 | 1104 | ||
82 | === modified file 'bin/pt-config-diff' | |||
83 | --- bin/pt-config-diff 2013-07-18 17:31:04 +0000 | |||
84 | +++ bin/pt-config-diff 2013-08-14 00:47:54 +0000 | |||
85 | @@ -64,6 +64,7 @@ | |||
86 | 64 | 64 | ||
87 | 65 | use List::Util qw(max); | 65 | use List::Util qw(max); |
88 | 66 | use Getopt::Long; | 66 | use Getopt::Long; |
89 | 67 | use Data::Dumper; | ||
90 | 67 | 68 | ||
91 | 68 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 69 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
92 | 69 | 70 | ||
93 | @@ -459,11 +460,21 @@ | |||
94 | 459 | my $long = exists $self->{opts}->{$opt} ? $opt | 460 | my $long = exists $self->{opts}->{$opt} ? $opt |
95 | 460 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 461 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
96 | 461 | : die "Getopt::Long gave a nonexistent option: $opt"; | 462 | : die "Getopt::Long gave a nonexistent option: $opt"; |
97 | 462 | |||
98 | 463 | $opt = $self->{opts}->{$long}; | 463 | $opt = $self->{opts}->{$long}; |
99 | 464 | if ( $opt->{is_cumulative} ) { | 464 | if ( $opt->{is_cumulative} ) { |
100 | 465 | $opt->{value}++; | 465 | $opt->{value}++; |
101 | 466 | } | 466 | } |
102 | 467 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
103 | 468 | my $next_opt = $1; | ||
104 | 469 | if ( exists $self->{opts}->{$next_opt} | ||
105 | 470 | || exists $self->{short_opts}->{$next_opt} ) { | ||
106 | 471 | $self->save_error("--$long requires a string value"); | ||
107 | 472 | return; | ||
108 | 473 | } | ||
109 | 474 | else { | ||
110 | 475 | $opt->{value} = $val; | ||
111 | 476 | } | ||
112 | 477 | } | ||
113 | 467 | else { | 478 | else { |
114 | 468 | $opt->{value} = $val; | 479 | $opt->{value} = $val; |
115 | 469 | } | 480 | } |
116 | @@ -1047,6 +1058,45 @@ | |||
117 | 1047 | ); | 1058 | ); |
118 | 1048 | }; | 1059 | }; |
119 | 1049 | 1060 | ||
120 | 1061 | sub set_vars { | ||
121 | 1062 | my ($self, $file) = @_; | ||
122 | 1063 | $file ||= $self->{file} || __FILE__; | ||
123 | 1064 | |||
124 | 1065 | my %user_vars; | ||
125 | 1066 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
126 | 1067 | if ( $user_vars ) { | ||
127 | 1068 | foreach my $var_val ( @$user_vars ) { | ||
128 | 1069 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
129 | 1070 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
130 | 1071 | $user_vars{$var} = { | ||
131 | 1072 | val => $val, | ||
132 | 1073 | default => 0, | ||
133 | 1074 | }; | ||
134 | 1075 | } | ||
135 | 1076 | } | ||
136 | 1077 | |||
137 | 1078 | my %default_vars; | ||
138 | 1079 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
139 | 1080 | if ( $default_vars ) { | ||
140 | 1081 | %default_vars = map { | ||
141 | 1082 | my $var_val = $_; | ||
142 | 1083 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
143 | 1084 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
144 | 1085 | $var => { | ||
145 | 1086 | val => $val, | ||
146 | 1087 | default => 1, | ||
147 | 1088 | }; | ||
148 | 1089 | } split("\n", $default_vars); | ||
149 | 1090 | } | ||
150 | 1091 | |||
151 | 1092 | my %vars = ( | ||
152 | 1093 | %default_vars, # first the tool's defaults | ||
153 | 1094 | %user_vars, # then the user's which overwrite the defaults | ||
154 | 1095 | ); | ||
155 | 1096 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
156 | 1097 | return \%vars; | ||
157 | 1098 | } | ||
158 | 1099 | |||
159 | 1050 | sub _d { | 1100 | sub _d { |
160 | 1051 | my ($package, undef, $line) = caller 0; | 1101 | my ($package, undef, $line) = caller 0; |
161 | 1052 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1102 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
162 | 1053 | 1103 | ||
163 | === modified file 'bin/pt-deadlock-logger' | |||
164 | --- bin/pt-deadlock-logger 2013-07-18 17:31:04 +0000 | |||
165 | +++ bin/pt-deadlock-logger 2013-08-14 00:47:54 +0000 | |||
166 | @@ -62,6 +62,7 @@ | |||
167 | 62 | 62 | ||
168 | 63 | use List::Util qw(max); | 63 | use List::Util qw(max); |
169 | 64 | use Getopt::Long; | 64 | use Getopt::Long; |
170 | 65 | use Data::Dumper; | ||
171 | 65 | 66 | ||
172 | 66 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 67 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
173 | 67 | 68 | ||
174 | @@ -457,11 +458,21 @@ | |||
175 | 457 | my $long = exists $self->{opts}->{$opt} ? $opt | 458 | my $long = exists $self->{opts}->{$opt} ? $opt |
176 | 458 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 459 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
177 | 459 | : die "Getopt::Long gave a nonexistent option: $opt"; | 460 | : die "Getopt::Long gave a nonexistent option: $opt"; |
178 | 460 | |||
179 | 461 | $opt = $self->{opts}->{$long}; | 461 | $opt = $self->{opts}->{$long}; |
180 | 462 | if ( $opt->{is_cumulative} ) { | 462 | if ( $opt->{is_cumulative} ) { |
181 | 463 | $opt->{value}++; | 463 | $opt->{value}++; |
182 | 464 | } | 464 | } |
183 | 465 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
184 | 466 | my $next_opt = $1; | ||
185 | 467 | if ( exists $self->{opts}->{$next_opt} | ||
186 | 468 | || exists $self->{short_opts}->{$next_opt} ) { | ||
187 | 469 | $self->save_error("--$long requires a string value"); | ||
188 | 470 | return; | ||
189 | 471 | } | ||
190 | 472 | else { | ||
191 | 473 | $opt->{value} = $val; | ||
192 | 474 | } | ||
193 | 475 | } | ||
194 | 465 | else { | 476 | else { |
195 | 466 | $opt->{value} = $val; | 477 | $opt->{value} = $val; |
196 | 467 | } | 478 | } |
197 | @@ -1045,6 +1056,45 @@ | |||
198 | 1045 | ); | 1056 | ); |
199 | 1046 | }; | 1057 | }; |
200 | 1047 | 1058 | ||
201 | 1059 | sub set_vars { | ||
202 | 1060 | my ($self, $file) = @_; | ||
203 | 1061 | $file ||= $self->{file} || __FILE__; | ||
204 | 1062 | |||
205 | 1063 | my %user_vars; | ||
206 | 1064 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
207 | 1065 | if ( $user_vars ) { | ||
208 | 1066 | foreach my $var_val ( @$user_vars ) { | ||
209 | 1067 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
210 | 1068 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
211 | 1069 | $user_vars{$var} = { | ||
212 | 1070 | val => $val, | ||
213 | 1071 | default => 0, | ||
214 | 1072 | }; | ||
215 | 1073 | } | ||
216 | 1074 | } | ||
217 | 1075 | |||
218 | 1076 | my %default_vars; | ||
219 | 1077 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
220 | 1078 | if ( $default_vars ) { | ||
221 | 1079 | %default_vars = map { | ||
222 | 1080 | my $var_val = $_; | ||
223 | 1081 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
224 | 1082 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
225 | 1083 | $var => { | ||
226 | 1084 | val => $val, | ||
227 | 1085 | default => 1, | ||
228 | 1086 | }; | ||
229 | 1087 | } split("\n", $default_vars); | ||
230 | 1088 | } | ||
231 | 1089 | |||
232 | 1090 | my %vars = ( | ||
233 | 1091 | %default_vars, # first the tool's defaults | ||
234 | 1092 | %user_vars, # then the user's which overwrite the defaults | ||
235 | 1093 | ); | ||
236 | 1094 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
237 | 1095 | return \%vars; | ||
238 | 1096 | } | ||
239 | 1097 | |||
240 | 1048 | sub _d { | 1098 | sub _d { |
241 | 1049 | my ($package, undef, $line) = caller 0; | 1099 | my ($package, undef, $line) = caller 0; |
242 | 1050 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1100 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
243 | 1051 | 1101 | ||
244 | === modified file 'bin/pt-diskstats' | |||
245 | --- bin/pt-diskstats 2013-07-18 17:31:04 +0000 | |||
246 | +++ bin/pt-diskstats 2013-08-14 00:47:54 +0000 | |||
247 | @@ -64,6 +64,7 @@ | |||
248 | 64 | 64 | ||
249 | 65 | use List::Util qw(max); | 65 | use List::Util qw(max); |
250 | 66 | use Getopt::Long; | 66 | use Getopt::Long; |
251 | 67 | use Data::Dumper; | ||
252 | 67 | 68 | ||
253 | 68 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 69 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
254 | 69 | 70 | ||
255 | @@ -459,11 +460,21 @@ | |||
256 | 459 | my $long = exists $self->{opts}->{$opt} ? $opt | 460 | my $long = exists $self->{opts}->{$opt} ? $opt |
257 | 460 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 461 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
258 | 461 | : die "Getopt::Long gave a nonexistent option: $opt"; | 462 | : die "Getopt::Long gave a nonexistent option: $opt"; |
259 | 462 | |||
260 | 463 | $opt = $self->{opts}->{$long}; | 463 | $opt = $self->{opts}->{$long}; |
261 | 464 | if ( $opt->{is_cumulative} ) { | 464 | if ( $opt->{is_cumulative} ) { |
262 | 465 | $opt->{value}++; | 465 | $opt->{value}++; |
263 | 466 | } | 466 | } |
264 | 467 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
265 | 468 | my $next_opt = $1; | ||
266 | 469 | if ( exists $self->{opts}->{$next_opt} | ||
267 | 470 | || exists $self->{short_opts}->{$next_opt} ) { | ||
268 | 471 | $self->save_error("--$long requires a string value"); | ||
269 | 472 | return; | ||
270 | 473 | } | ||
271 | 474 | else { | ||
272 | 475 | $opt->{value} = $val; | ||
273 | 476 | } | ||
274 | 477 | } | ||
275 | 467 | else { | 478 | else { |
276 | 468 | $opt->{value} = $val; | 479 | $opt->{value} = $val; |
277 | 469 | } | 480 | } |
278 | @@ -1047,6 +1058,45 @@ | |||
279 | 1047 | ); | 1058 | ); |
280 | 1048 | }; | 1059 | }; |
281 | 1049 | 1060 | ||
282 | 1061 | sub set_vars { | ||
283 | 1062 | my ($self, $file) = @_; | ||
284 | 1063 | $file ||= $self->{file} || __FILE__; | ||
285 | 1064 | |||
286 | 1065 | my %user_vars; | ||
287 | 1066 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
288 | 1067 | if ( $user_vars ) { | ||
289 | 1068 | foreach my $var_val ( @$user_vars ) { | ||
290 | 1069 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
291 | 1070 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
292 | 1071 | $user_vars{$var} = { | ||
293 | 1072 | val => $val, | ||
294 | 1073 | default => 0, | ||
295 | 1074 | }; | ||
296 | 1075 | } | ||
297 | 1076 | } | ||
298 | 1077 | |||
299 | 1078 | my %default_vars; | ||
300 | 1079 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
301 | 1080 | if ( $default_vars ) { | ||
302 | 1081 | %default_vars = map { | ||
303 | 1082 | my $var_val = $_; | ||
304 | 1083 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
305 | 1084 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
306 | 1085 | $var => { | ||
307 | 1086 | val => $val, | ||
308 | 1087 | default => 1, | ||
309 | 1088 | }; | ||
310 | 1089 | } split("\n", $default_vars); | ||
311 | 1090 | } | ||
312 | 1091 | |||
313 | 1092 | my %vars = ( | ||
314 | 1093 | %default_vars, # first the tool's defaults | ||
315 | 1094 | %user_vars, # then the user's which overwrite the defaults | ||
316 | 1095 | ); | ||
317 | 1096 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
318 | 1097 | return \%vars; | ||
319 | 1098 | } | ||
320 | 1099 | |||
321 | 1050 | sub _d { | 1100 | sub _d { |
322 | 1051 | my ($package, undef, $line) = caller 0; | 1101 | my ($package, undef, $line) = caller 0; |
323 | 1052 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1102 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
324 | 1053 | 1103 | ||
325 | === modified file 'bin/pt-duplicate-key-checker' | |||
326 | --- bin/pt-duplicate-key-checker 2013-07-18 17:31:04 +0000 | |||
327 | +++ bin/pt-duplicate-key-checker 2013-08-14 00:47:54 +0000 | |||
328 | @@ -979,6 +979,7 @@ | |||
329 | 979 | 979 | ||
330 | 980 | use List::Util qw(max); | 980 | use List::Util qw(max); |
331 | 981 | use Getopt::Long; | 981 | use Getopt::Long; |
332 | 982 | use Data::Dumper; | ||
333 | 982 | 983 | ||
334 | 983 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 984 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
335 | 984 | 985 | ||
336 | @@ -1374,11 +1375,21 @@ | |||
337 | 1374 | my $long = exists $self->{opts}->{$opt} ? $opt | 1375 | my $long = exists $self->{opts}->{$opt} ? $opt |
338 | 1375 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 1376 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
339 | 1376 | : die "Getopt::Long gave a nonexistent option: $opt"; | 1377 | : die "Getopt::Long gave a nonexistent option: $opt"; |
340 | 1377 | |||
341 | 1378 | $opt = $self->{opts}->{$long}; | 1378 | $opt = $self->{opts}->{$long}; |
342 | 1379 | if ( $opt->{is_cumulative} ) { | 1379 | if ( $opt->{is_cumulative} ) { |
343 | 1380 | $opt->{value}++; | 1380 | $opt->{value}++; |
344 | 1381 | } | 1381 | } |
345 | 1382 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
346 | 1383 | my $next_opt = $1; | ||
347 | 1384 | if ( exists $self->{opts}->{$next_opt} | ||
348 | 1385 | || exists $self->{short_opts}->{$next_opt} ) { | ||
349 | 1386 | $self->save_error("--$long requires a string value"); | ||
350 | 1387 | return; | ||
351 | 1388 | } | ||
352 | 1389 | else { | ||
353 | 1390 | $opt->{value} = $val; | ||
354 | 1391 | } | ||
355 | 1392 | } | ||
356 | 1382 | else { | 1393 | else { |
357 | 1383 | $opt->{value} = $val; | 1394 | $opt->{value} = $val; |
358 | 1384 | } | 1395 | } |
359 | @@ -1962,6 +1973,45 @@ | |||
360 | 1962 | ); | 1973 | ); |
361 | 1963 | }; | 1974 | }; |
362 | 1964 | 1975 | ||
363 | 1976 | sub set_vars { | ||
364 | 1977 | my ($self, $file) = @_; | ||
365 | 1978 | $file ||= $self->{file} || __FILE__; | ||
366 | 1979 | |||
367 | 1980 | my %user_vars; | ||
368 | 1981 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
369 | 1982 | if ( $user_vars ) { | ||
370 | 1983 | foreach my $var_val ( @$user_vars ) { | ||
371 | 1984 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
372 | 1985 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
373 | 1986 | $user_vars{$var} = { | ||
374 | 1987 | val => $val, | ||
375 | 1988 | default => 0, | ||
376 | 1989 | }; | ||
377 | 1990 | } | ||
378 | 1991 | } | ||
379 | 1992 | |||
380 | 1993 | my %default_vars; | ||
381 | 1994 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
382 | 1995 | if ( $default_vars ) { | ||
383 | 1996 | %default_vars = map { | ||
384 | 1997 | my $var_val = $_; | ||
385 | 1998 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
386 | 1999 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
387 | 2000 | $var => { | ||
388 | 2001 | val => $val, | ||
389 | 2002 | default => 1, | ||
390 | 2003 | }; | ||
391 | 2004 | } split("\n", $default_vars); | ||
392 | 2005 | } | ||
393 | 2006 | |||
394 | 2007 | my %vars = ( | ||
395 | 2008 | %default_vars, # first the tool's defaults | ||
396 | 2009 | %user_vars, # then the user's which overwrite the defaults | ||
397 | 2010 | ); | ||
398 | 2011 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
399 | 2012 | return \%vars; | ||
400 | 2013 | } | ||
401 | 2014 | |||
402 | 1965 | sub _d { | 2015 | sub _d { |
403 | 1966 | my ($package, undef, $line) = caller 0; | 2016 | my ($package, undef, $line) = caller 0; |
404 | 1967 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 2017 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
405 | 1968 | 2018 | ||
406 | === modified file 'bin/pt-fifo-split' | |||
407 | --- bin/pt-fifo-split 2013-07-18 17:31:04 +0000 | |||
408 | +++ bin/pt-fifo-split 2013-08-14 00:47:54 +0000 | |||
409 | @@ -36,6 +36,7 @@ | |||
410 | 36 | 36 | ||
411 | 37 | use List::Util qw(max); | 37 | use List::Util qw(max); |
412 | 38 | use Getopt::Long; | 38 | use Getopt::Long; |
413 | 39 | use Data::Dumper; | ||
414 | 39 | 40 | ||
415 | 40 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 41 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
416 | 41 | 42 | ||
417 | @@ -431,11 +432,21 @@ | |||
418 | 431 | my $long = exists $self->{opts}->{$opt} ? $opt | 432 | my $long = exists $self->{opts}->{$opt} ? $opt |
419 | 432 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 433 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
420 | 433 | : die "Getopt::Long gave a nonexistent option: $opt"; | 434 | : die "Getopt::Long gave a nonexistent option: $opt"; |
421 | 434 | |||
422 | 435 | $opt = $self->{opts}->{$long}; | 435 | $opt = $self->{opts}->{$long}; |
423 | 436 | if ( $opt->{is_cumulative} ) { | 436 | if ( $opt->{is_cumulative} ) { |
424 | 437 | $opt->{value}++; | 437 | $opt->{value}++; |
425 | 438 | } | 438 | } |
426 | 439 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
427 | 440 | my $next_opt = $1; | ||
428 | 441 | if ( exists $self->{opts}->{$next_opt} | ||
429 | 442 | || exists $self->{short_opts}->{$next_opt} ) { | ||
430 | 443 | $self->save_error("--$long requires a string value"); | ||
431 | 444 | return; | ||
432 | 445 | } | ||
433 | 446 | else { | ||
434 | 447 | $opt->{value} = $val; | ||
435 | 448 | } | ||
436 | 449 | } | ||
437 | 439 | else { | 450 | else { |
438 | 440 | $opt->{value} = $val; | 451 | $opt->{value} = $val; |
439 | 441 | } | 452 | } |
440 | @@ -1019,6 +1030,45 @@ | |||
441 | 1019 | ); | 1030 | ); |
442 | 1020 | }; | 1031 | }; |
443 | 1021 | 1032 | ||
444 | 1033 | sub set_vars { | ||
445 | 1034 | my ($self, $file) = @_; | ||
446 | 1035 | $file ||= $self->{file} || __FILE__; | ||
447 | 1036 | |||
448 | 1037 | my %user_vars; | ||
449 | 1038 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
450 | 1039 | if ( $user_vars ) { | ||
451 | 1040 | foreach my $var_val ( @$user_vars ) { | ||
452 | 1041 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
453 | 1042 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
454 | 1043 | $user_vars{$var} = { | ||
455 | 1044 | val => $val, | ||
456 | 1045 | default => 0, | ||
457 | 1046 | }; | ||
458 | 1047 | } | ||
459 | 1048 | } | ||
460 | 1049 | |||
461 | 1050 | my %default_vars; | ||
462 | 1051 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
463 | 1052 | if ( $default_vars ) { | ||
464 | 1053 | %default_vars = map { | ||
465 | 1054 | my $var_val = $_; | ||
466 | 1055 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
467 | 1056 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
468 | 1057 | $var => { | ||
469 | 1058 | val => $val, | ||
470 | 1059 | default => 1, | ||
471 | 1060 | }; | ||
472 | 1061 | } split("\n", $default_vars); | ||
473 | 1062 | } | ||
474 | 1063 | |||
475 | 1064 | my %vars = ( | ||
476 | 1065 | %default_vars, # first the tool's defaults | ||
477 | 1066 | %user_vars, # then the user's which overwrite the defaults | ||
478 | 1067 | ); | ||
479 | 1068 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
480 | 1069 | return \%vars; | ||
481 | 1070 | } | ||
482 | 1071 | |||
483 | 1022 | sub _d { | 1072 | sub _d { |
484 | 1023 | my ($package, undef, $line) = caller 0; | 1073 | my ($package, undef, $line) = caller 0; |
485 | 1024 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1074 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
486 | 1025 | 1075 | ||
487 | === modified file 'bin/pt-find' | |||
488 | --- bin/pt-find 2013-07-18 17:31:04 +0000 | |||
489 | +++ bin/pt-find 2013-08-14 00:47:54 +0000 | |||
490 | @@ -438,6 +438,7 @@ | |||
491 | 438 | 438 | ||
492 | 439 | use List::Util qw(max); | 439 | use List::Util qw(max); |
493 | 440 | use Getopt::Long; | 440 | use Getopt::Long; |
494 | 441 | use Data::Dumper; | ||
495 | 441 | 442 | ||
496 | 442 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 443 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
497 | 443 | 444 | ||
498 | @@ -833,11 +834,21 @@ | |||
499 | 833 | my $long = exists $self->{opts}->{$opt} ? $opt | 834 | my $long = exists $self->{opts}->{$opt} ? $opt |
500 | 834 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 835 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
501 | 835 | : die "Getopt::Long gave a nonexistent option: $opt"; | 836 | : die "Getopt::Long gave a nonexistent option: $opt"; |
502 | 836 | |||
503 | 837 | $opt = $self->{opts}->{$long}; | 837 | $opt = $self->{opts}->{$long}; |
504 | 838 | if ( $opt->{is_cumulative} ) { | 838 | if ( $opt->{is_cumulative} ) { |
505 | 839 | $opt->{value}++; | 839 | $opt->{value}++; |
506 | 840 | } | 840 | } |
507 | 841 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
508 | 842 | my $next_opt = $1; | ||
509 | 843 | if ( exists $self->{opts}->{$next_opt} | ||
510 | 844 | || exists $self->{short_opts}->{$next_opt} ) { | ||
511 | 845 | $self->save_error("--$long requires a string value"); | ||
512 | 846 | return; | ||
513 | 847 | } | ||
514 | 848 | else { | ||
515 | 849 | $opt->{value} = $val; | ||
516 | 850 | } | ||
517 | 851 | } | ||
518 | 841 | else { | 852 | else { |
519 | 842 | $opt->{value} = $val; | 853 | $opt->{value} = $val; |
520 | 843 | } | 854 | } |
521 | @@ -1421,6 +1432,45 @@ | |||
522 | 1421 | ); | 1432 | ); |
523 | 1422 | }; | 1433 | }; |
524 | 1423 | 1434 | ||
525 | 1435 | sub set_vars { | ||
526 | 1436 | my ($self, $file) = @_; | ||
527 | 1437 | $file ||= $self->{file} || __FILE__; | ||
528 | 1438 | |||
529 | 1439 | my %user_vars; | ||
530 | 1440 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
531 | 1441 | if ( $user_vars ) { | ||
532 | 1442 | foreach my $var_val ( @$user_vars ) { | ||
533 | 1443 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
534 | 1444 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
535 | 1445 | $user_vars{$var} = { | ||
536 | 1446 | val => $val, | ||
537 | 1447 | default => 0, | ||
538 | 1448 | }; | ||
539 | 1449 | } | ||
540 | 1450 | } | ||
541 | 1451 | |||
542 | 1452 | my %default_vars; | ||
543 | 1453 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
544 | 1454 | if ( $default_vars ) { | ||
545 | 1455 | %default_vars = map { | ||
546 | 1456 | my $var_val = $_; | ||
547 | 1457 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
548 | 1458 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
549 | 1459 | $var => { | ||
550 | 1460 | val => $val, | ||
551 | 1461 | default => 1, | ||
552 | 1462 | }; | ||
553 | 1463 | } split("\n", $default_vars); | ||
554 | 1464 | } | ||
555 | 1465 | |||
556 | 1466 | my %vars = ( | ||
557 | 1467 | %default_vars, # first the tool's defaults | ||
558 | 1468 | %user_vars, # then the user's which overwrite the defaults | ||
559 | 1469 | ); | ||
560 | 1470 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
561 | 1471 | return \%vars; | ||
562 | 1472 | } | ||
563 | 1473 | |||
564 | 1424 | sub _d { | 1474 | sub _d { |
565 | 1425 | my ($package, undef, $line) = caller 0; | 1475 | my ($package, undef, $line) = caller 0; |
566 | 1426 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1476 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
567 | 1427 | 1477 | ||
568 | === modified file 'bin/pt-fingerprint' | |||
569 | --- bin/pt-fingerprint 2013-07-18 17:31:04 +0000 | |||
570 | +++ bin/pt-fingerprint 2013-08-14 00:47:54 +0000 | |||
571 | @@ -37,6 +37,7 @@ | |||
572 | 37 | 37 | ||
573 | 38 | use List::Util qw(max); | 38 | use List::Util qw(max); |
574 | 39 | use Getopt::Long; | 39 | use Getopt::Long; |
575 | 40 | use Data::Dumper; | ||
576 | 40 | 41 | ||
577 | 41 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 42 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
578 | 42 | 43 | ||
579 | @@ -432,11 +433,21 @@ | |||
580 | 432 | my $long = exists $self->{opts}->{$opt} ? $opt | 433 | my $long = exists $self->{opts}->{$opt} ? $opt |
581 | 433 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 434 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
582 | 434 | : die "Getopt::Long gave a nonexistent option: $opt"; | 435 | : die "Getopt::Long gave a nonexistent option: $opt"; |
583 | 435 | |||
584 | 436 | $opt = $self->{opts}->{$long}; | 436 | $opt = $self->{opts}->{$long}; |
585 | 437 | if ( $opt->{is_cumulative} ) { | 437 | if ( $opt->{is_cumulative} ) { |
586 | 438 | $opt->{value}++; | 438 | $opt->{value}++; |
587 | 439 | } | 439 | } |
588 | 440 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
589 | 441 | my $next_opt = $1; | ||
590 | 442 | if ( exists $self->{opts}->{$next_opt} | ||
591 | 443 | || exists $self->{short_opts}->{$next_opt} ) { | ||
592 | 444 | $self->save_error("--$long requires a string value"); | ||
593 | 445 | return; | ||
594 | 446 | } | ||
595 | 447 | else { | ||
596 | 448 | $opt->{value} = $val; | ||
597 | 449 | } | ||
598 | 450 | } | ||
599 | 440 | else { | 451 | else { |
600 | 441 | $opt->{value} = $val; | 452 | $opt->{value} = $val; |
601 | 442 | } | 453 | } |
602 | @@ -1020,6 +1031,45 @@ | |||
603 | 1020 | ); | 1031 | ); |
604 | 1021 | }; | 1032 | }; |
605 | 1022 | 1033 | ||
606 | 1034 | sub set_vars { | ||
607 | 1035 | my ($self, $file) = @_; | ||
608 | 1036 | $file ||= $self->{file} || __FILE__; | ||
609 | 1037 | |||
610 | 1038 | my %user_vars; | ||
611 | 1039 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
612 | 1040 | if ( $user_vars ) { | ||
613 | 1041 | foreach my $var_val ( @$user_vars ) { | ||
614 | 1042 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
615 | 1043 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
616 | 1044 | $user_vars{$var} = { | ||
617 | 1045 | val => $val, | ||
618 | 1046 | default => 0, | ||
619 | 1047 | }; | ||
620 | 1048 | } | ||
621 | 1049 | } | ||
622 | 1050 | |||
623 | 1051 | my %default_vars; | ||
624 | 1052 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
625 | 1053 | if ( $default_vars ) { | ||
626 | 1054 | %default_vars = map { | ||
627 | 1055 | my $var_val = $_; | ||
628 | 1056 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
629 | 1057 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
630 | 1058 | $var => { | ||
631 | 1059 | val => $val, | ||
632 | 1060 | default => 1, | ||
633 | 1061 | }; | ||
634 | 1062 | } split("\n", $default_vars); | ||
635 | 1063 | } | ||
636 | 1064 | |||
637 | 1065 | my %vars = ( | ||
638 | 1066 | %default_vars, # first the tool's defaults | ||
639 | 1067 | %user_vars, # then the user's which overwrite the defaults | ||
640 | 1068 | ); | ||
641 | 1069 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
642 | 1070 | return \%vars; | ||
643 | 1071 | } | ||
644 | 1072 | |||
645 | 1023 | sub _d { | 1073 | sub _d { |
646 | 1024 | my ($package, undef, $line) = caller 0; | 1074 | my ($package, undef, $line) = caller 0; |
647 | 1025 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1075 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
648 | 1026 | 1076 | ||
649 | === modified file 'bin/pt-fk-error-logger' | |||
650 | --- bin/pt-fk-error-logger 2013-07-18 17:31:04 +0000 | |||
651 | +++ bin/pt-fk-error-logger 2013-08-14 00:47:54 +0000 | |||
652 | @@ -61,6 +61,7 @@ | |||
653 | 61 | 61 | ||
654 | 62 | use List::Util qw(max); | 62 | use List::Util qw(max); |
655 | 63 | use Getopt::Long; | 63 | use Getopt::Long; |
656 | 64 | use Data::Dumper; | ||
657 | 64 | 65 | ||
658 | 65 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 66 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
659 | 66 | 67 | ||
660 | @@ -456,11 +457,21 @@ | |||
661 | 456 | my $long = exists $self->{opts}->{$opt} ? $opt | 457 | my $long = exists $self->{opts}->{$opt} ? $opt |
662 | 457 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 458 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
663 | 458 | : die "Getopt::Long gave a nonexistent option: $opt"; | 459 | : die "Getopt::Long gave a nonexistent option: $opt"; |
664 | 459 | |||
665 | 460 | $opt = $self->{opts}->{$long}; | 460 | $opt = $self->{opts}->{$long}; |
666 | 461 | if ( $opt->{is_cumulative} ) { | 461 | if ( $opt->{is_cumulative} ) { |
667 | 462 | $opt->{value}++; | 462 | $opt->{value}++; |
668 | 463 | } | 463 | } |
669 | 464 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
670 | 465 | my $next_opt = $1; | ||
671 | 466 | if ( exists $self->{opts}->{$next_opt} | ||
672 | 467 | || exists $self->{short_opts}->{$next_opt} ) { | ||
673 | 468 | $self->save_error("--$long requires a string value"); | ||
674 | 469 | return; | ||
675 | 470 | } | ||
676 | 471 | else { | ||
677 | 472 | $opt->{value} = $val; | ||
678 | 473 | } | ||
679 | 474 | } | ||
680 | 464 | else { | 475 | else { |
681 | 465 | $opt->{value} = $val; | 476 | $opt->{value} = $val; |
682 | 466 | } | 477 | } |
683 | @@ -1044,6 +1055,45 @@ | |||
684 | 1044 | ); | 1055 | ); |
685 | 1045 | }; | 1056 | }; |
686 | 1046 | 1057 | ||
687 | 1058 | sub set_vars { | ||
688 | 1059 | my ($self, $file) = @_; | ||
689 | 1060 | $file ||= $self->{file} || __FILE__; | ||
690 | 1061 | |||
691 | 1062 | my %user_vars; | ||
692 | 1063 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
693 | 1064 | if ( $user_vars ) { | ||
694 | 1065 | foreach my $var_val ( @$user_vars ) { | ||
695 | 1066 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
696 | 1067 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
697 | 1068 | $user_vars{$var} = { | ||
698 | 1069 | val => $val, | ||
699 | 1070 | default => 0, | ||
700 | 1071 | }; | ||
701 | 1072 | } | ||
702 | 1073 | } | ||
703 | 1074 | |||
704 | 1075 | my %default_vars; | ||
705 | 1076 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
706 | 1077 | if ( $default_vars ) { | ||
707 | 1078 | %default_vars = map { | ||
708 | 1079 | my $var_val = $_; | ||
709 | 1080 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
710 | 1081 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
711 | 1082 | $var => { | ||
712 | 1083 | val => $val, | ||
713 | 1084 | default => 1, | ||
714 | 1085 | }; | ||
715 | 1086 | } split("\n", $default_vars); | ||
716 | 1087 | } | ||
717 | 1088 | |||
718 | 1089 | my %vars = ( | ||
719 | 1090 | %default_vars, # first the tool's defaults | ||
720 | 1091 | %user_vars, # then the user's which overwrite the defaults | ||
721 | 1092 | ); | ||
722 | 1093 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
723 | 1094 | return \%vars; | ||
724 | 1095 | } | ||
725 | 1096 | |||
726 | 1047 | sub _d { | 1097 | sub _d { |
727 | 1048 | my ($package, undef, $line) = caller 0; | 1098 | my ($package, undef, $line) = caller 0; |
728 | 1049 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1099 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
729 | 1050 | 1100 | ||
730 | === modified file 'bin/pt-heartbeat' | |||
731 | --- bin/pt-heartbeat 2013-07-18 17:31:04 +0000 | |||
732 | +++ bin/pt-heartbeat 2013-08-14 00:47:54 +0000 | |||
733 | @@ -798,6 +798,7 @@ | |||
734 | 798 | 798 | ||
735 | 799 | use List::Util qw(max); | 799 | use List::Util qw(max); |
736 | 800 | use Getopt::Long; | 800 | use Getopt::Long; |
737 | 801 | use Data::Dumper; | ||
738 | 801 | 802 | ||
739 | 802 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 803 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
740 | 803 | 804 | ||
741 | @@ -1193,11 +1194,21 @@ | |||
742 | 1193 | my $long = exists $self->{opts}->{$opt} ? $opt | 1194 | my $long = exists $self->{opts}->{$opt} ? $opt |
743 | 1194 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 1195 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
744 | 1195 | : die "Getopt::Long gave a nonexistent option: $opt"; | 1196 | : die "Getopt::Long gave a nonexistent option: $opt"; |
745 | 1196 | |||
746 | 1197 | $opt = $self->{opts}->{$long}; | 1197 | $opt = $self->{opts}->{$long}; |
747 | 1198 | if ( $opt->{is_cumulative} ) { | 1198 | if ( $opt->{is_cumulative} ) { |
748 | 1199 | $opt->{value}++; | 1199 | $opt->{value}++; |
749 | 1200 | } | 1200 | } |
750 | 1201 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
751 | 1202 | my $next_opt = $1; | ||
752 | 1203 | if ( exists $self->{opts}->{$next_opt} | ||
753 | 1204 | || exists $self->{short_opts}->{$next_opt} ) { | ||
754 | 1205 | $self->save_error("--$long requires a string value"); | ||
755 | 1206 | return; | ||
756 | 1207 | } | ||
757 | 1208 | else { | ||
758 | 1209 | $opt->{value} = $val; | ||
759 | 1210 | } | ||
760 | 1211 | } | ||
761 | 1201 | else { | 1212 | else { |
762 | 1202 | $opt->{value} = $val; | 1213 | $opt->{value} = $val; |
763 | 1203 | } | 1214 | } |
764 | @@ -1781,6 +1792,45 @@ | |||
765 | 1781 | ); | 1792 | ); |
766 | 1782 | }; | 1793 | }; |
767 | 1783 | 1794 | ||
768 | 1795 | sub set_vars { | ||
769 | 1796 | my ($self, $file) = @_; | ||
770 | 1797 | $file ||= $self->{file} || __FILE__; | ||
771 | 1798 | |||
772 | 1799 | my %user_vars; | ||
773 | 1800 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
774 | 1801 | if ( $user_vars ) { | ||
775 | 1802 | foreach my $var_val ( @$user_vars ) { | ||
776 | 1803 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
777 | 1804 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
778 | 1805 | $user_vars{$var} = { | ||
779 | 1806 | val => $val, | ||
780 | 1807 | default => 0, | ||
781 | 1808 | }; | ||
782 | 1809 | } | ||
783 | 1810 | } | ||
784 | 1811 | |||
785 | 1812 | my %default_vars; | ||
786 | 1813 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
787 | 1814 | if ( $default_vars ) { | ||
788 | 1815 | %default_vars = map { | ||
789 | 1816 | my $var_val = $_; | ||
790 | 1817 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
791 | 1818 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
792 | 1819 | $var => { | ||
793 | 1820 | val => $val, | ||
794 | 1821 | default => 1, | ||
795 | 1822 | }; | ||
796 | 1823 | } split("\n", $default_vars); | ||
797 | 1824 | } | ||
798 | 1825 | |||
799 | 1826 | my %vars = ( | ||
800 | 1827 | %default_vars, # first the tool's defaults | ||
801 | 1828 | %user_vars, # then the user's which overwrite the defaults | ||
802 | 1829 | ); | ||
803 | 1830 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
804 | 1831 | return \%vars; | ||
805 | 1832 | } | ||
806 | 1833 | |||
807 | 1784 | sub _d { | 1834 | sub _d { |
808 | 1785 | my ($package, undef, $line) = caller 0; | 1835 | my ($package, undef, $line) = caller 0; |
809 | 1786 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1836 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
810 | 1787 | 1837 | ||
811 | === modified file 'bin/pt-index-usage' | |||
812 | --- bin/pt-index-usage 2013-07-18 17:31:04 +0000 | |||
813 | +++ bin/pt-index-usage 2013-08-14 00:47:54 +0000 | |||
814 | @@ -574,6 +574,7 @@ | |||
815 | 574 | 574 | ||
816 | 575 | use List::Util qw(max); | 575 | use List::Util qw(max); |
817 | 576 | use Getopt::Long; | 576 | use Getopt::Long; |
818 | 577 | use Data::Dumper; | ||
819 | 577 | 578 | ||
820 | 578 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 579 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
821 | 579 | 580 | ||
822 | @@ -969,11 +970,21 @@ | |||
823 | 969 | my $long = exists $self->{opts}->{$opt} ? $opt | 970 | my $long = exists $self->{opts}->{$opt} ? $opt |
824 | 970 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 971 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
825 | 971 | : die "Getopt::Long gave a nonexistent option: $opt"; | 972 | : die "Getopt::Long gave a nonexistent option: $opt"; |
826 | 972 | |||
827 | 973 | $opt = $self->{opts}->{$long}; | 973 | $opt = $self->{opts}->{$long}; |
828 | 974 | if ( $opt->{is_cumulative} ) { | 974 | if ( $opt->{is_cumulative} ) { |
829 | 975 | $opt->{value}++; | 975 | $opt->{value}++; |
830 | 976 | } | 976 | } |
831 | 977 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
832 | 978 | my $next_opt = $1; | ||
833 | 979 | if ( exists $self->{opts}->{$next_opt} | ||
834 | 980 | || exists $self->{short_opts}->{$next_opt} ) { | ||
835 | 981 | $self->save_error("--$long requires a string value"); | ||
836 | 982 | return; | ||
837 | 983 | } | ||
838 | 984 | else { | ||
839 | 985 | $opt->{value} = $val; | ||
840 | 986 | } | ||
841 | 987 | } | ||
842 | 977 | else { | 988 | else { |
843 | 978 | $opt->{value} = $val; | 989 | $opt->{value} = $val; |
844 | 979 | } | 990 | } |
845 | @@ -1557,6 +1568,45 @@ | |||
846 | 1557 | ); | 1568 | ); |
847 | 1558 | }; | 1569 | }; |
848 | 1559 | 1570 | ||
849 | 1571 | sub set_vars { | ||
850 | 1572 | my ($self, $file) = @_; | ||
851 | 1573 | $file ||= $self->{file} || __FILE__; | ||
852 | 1574 | |||
853 | 1575 | my %user_vars; | ||
854 | 1576 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
855 | 1577 | if ( $user_vars ) { | ||
856 | 1578 | foreach my $var_val ( @$user_vars ) { | ||
857 | 1579 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
858 | 1580 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
859 | 1581 | $user_vars{$var} = { | ||
860 | 1582 | val => $val, | ||
861 | 1583 | default => 0, | ||
862 | 1584 | }; | ||
863 | 1585 | } | ||
864 | 1586 | } | ||
865 | 1587 | |||
866 | 1588 | my %default_vars; | ||
867 | 1589 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
868 | 1590 | if ( $default_vars ) { | ||
869 | 1591 | %default_vars = map { | ||
870 | 1592 | my $var_val = $_; | ||
871 | 1593 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
872 | 1594 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
873 | 1595 | $var => { | ||
874 | 1596 | val => $val, | ||
875 | 1597 | default => 1, | ||
876 | 1598 | }; | ||
877 | 1599 | } split("\n", $default_vars); | ||
878 | 1600 | } | ||
879 | 1601 | |||
880 | 1602 | my %vars = ( | ||
881 | 1603 | %default_vars, # first the tool's defaults | ||
882 | 1604 | %user_vars, # then the user's which overwrite the defaults | ||
883 | 1605 | ); | ||
884 | 1606 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
885 | 1607 | return \%vars; | ||
886 | 1608 | } | ||
887 | 1609 | |||
888 | 1560 | sub _d { | 1610 | sub _d { |
889 | 1561 | my ($package, undef, $line) = caller 0; | 1611 | my ($package, undef, $line) = caller 0; |
890 | 1562 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1612 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
891 | 1563 | 1613 | ||
892 | === modified file 'bin/pt-kill' | |||
893 | --- bin/pt-kill 2013-07-18 17:31:04 +0000 | |||
894 | +++ bin/pt-kill 2013-08-14 00:47:54 +0000 | |||
895 | @@ -69,6 +69,7 @@ | |||
896 | 69 | 69 | ||
897 | 70 | use List::Util qw(max); | 70 | use List::Util qw(max); |
898 | 71 | use Getopt::Long; | 71 | use Getopt::Long; |
899 | 72 | use Data::Dumper; | ||
900 | 72 | 73 | ||
901 | 73 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 74 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
902 | 74 | 75 | ||
903 | @@ -464,11 +465,21 @@ | |||
904 | 464 | my $long = exists $self->{opts}->{$opt} ? $opt | 465 | my $long = exists $self->{opts}->{$opt} ? $opt |
905 | 465 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 466 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
906 | 466 | : die "Getopt::Long gave a nonexistent option: $opt"; | 467 | : die "Getopt::Long gave a nonexistent option: $opt"; |
907 | 467 | |||
908 | 468 | $opt = $self->{opts}->{$long}; | 468 | $opt = $self->{opts}->{$long}; |
909 | 469 | if ( $opt->{is_cumulative} ) { | 469 | if ( $opt->{is_cumulative} ) { |
910 | 470 | $opt->{value}++; | 470 | $opt->{value}++; |
911 | 471 | } | 471 | } |
912 | 472 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
913 | 473 | my $next_opt = $1; | ||
914 | 474 | if ( exists $self->{opts}->{$next_opt} | ||
915 | 475 | || exists $self->{short_opts}->{$next_opt} ) { | ||
916 | 476 | $self->save_error("--$long requires a string value"); | ||
917 | 477 | return; | ||
918 | 478 | } | ||
919 | 479 | else { | ||
920 | 480 | $opt->{value} = $val; | ||
921 | 481 | } | ||
922 | 482 | } | ||
923 | 472 | else { | 483 | else { |
924 | 473 | $opt->{value} = $val; | 484 | $opt->{value} = $val; |
925 | 474 | } | 485 | } |
926 | @@ -1052,6 +1063,45 @@ | |||
927 | 1052 | ); | 1063 | ); |
928 | 1053 | }; | 1064 | }; |
929 | 1054 | 1065 | ||
930 | 1066 | sub set_vars { | ||
931 | 1067 | my ($self, $file) = @_; | ||
932 | 1068 | $file ||= $self->{file} || __FILE__; | ||
933 | 1069 | |||
934 | 1070 | my %user_vars; | ||
935 | 1071 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
936 | 1072 | if ( $user_vars ) { | ||
937 | 1073 | foreach my $var_val ( @$user_vars ) { | ||
938 | 1074 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
939 | 1075 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
940 | 1076 | $user_vars{$var} = { | ||
941 | 1077 | val => $val, | ||
942 | 1078 | default => 0, | ||
943 | 1079 | }; | ||
944 | 1080 | } | ||
945 | 1081 | } | ||
946 | 1082 | |||
947 | 1083 | my %default_vars; | ||
948 | 1084 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
949 | 1085 | if ( $default_vars ) { | ||
950 | 1086 | %default_vars = map { | ||
951 | 1087 | my $var_val = $_; | ||
952 | 1088 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
953 | 1089 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
954 | 1090 | $var => { | ||
955 | 1091 | val => $val, | ||
956 | 1092 | default => 1, | ||
957 | 1093 | }; | ||
958 | 1094 | } split("\n", $default_vars); | ||
959 | 1095 | } | ||
960 | 1096 | |||
961 | 1097 | my %vars = ( | ||
962 | 1098 | %default_vars, # first the tool's defaults | ||
963 | 1099 | %user_vars, # then the user's which overwrite the defaults | ||
964 | 1100 | ); | ||
965 | 1101 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
966 | 1102 | return \%vars; | ||
967 | 1103 | } | ||
968 | 1104 | |||
969 | 1055 | sub _d { | 1105 | sub _d { |
970 | 1056 | my ($package, undef, $line) = caller 0; | 1106 | my ($package, undef, $line) = caller 0; |
971 | 1057 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1107 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
972 | 1058 | 1108 | ||
973 | === modified file 'bin/pt-log-player' | |||
974 | --- bin/pt-log-player 2013-07-18 17:31:04 +0000 | |||
975 | +++ bin/pt-log-player 2013-08-14 00:47:54 +0000 | |||
976 | @@ -41,6 +41,7 @@ | |||
977 | 41 | 41 | ||
978 | 42 | use List::Util qw(max); | 42 | use List::Util qw(max); |
979 | 43 | use Getopt::Long; | 43 | use Getopt::Long; |
980 | 44 | use Data::Dumper; | ||
981 | 44 | 45 | ||
982 | 45 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 46 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
983 | 46 | 47 | ||
984 | @@ -436,11 +437,21 @@ | |||
985 | 436 | my $long = exists $self->{opts}->{$opt} ? $opt | 437 | my $long = exists $self->{opts}->{$opt} ? $opt |
986 | 437 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 438 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
987 | 438 | : die "Getopt::Long gave a nonexistent option: $opt"; | 439 | : die "Getopt::Long gave a nonexistent option: $opt"; |
988 | 439 | |||
989 | 440 | $opt = $self->{opts}->{$long}; | 440 | $opt = $self->{opts}->{$long}; |
990 | 441 | if ( $opt->{is_cumulative} ) { | 441 | if ( $opt->{is_cumulative} ) { |
991 | 442 | $opt->{value}++; | 442 | $opt->{value}++; |
992 | 443 | } | 443 | } |
993 | 444 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
994 | 445 | my $next_opt = $1; | ||
995 | 446 | if ( exists $self->{opts}->{$next_opt} | ||
996 | 447 | || exists $self->{short_opts}->{$next_opt} ) { | ||
997 | 448 | $self->save_error("--$long requires a string value"); | ||
998 | 449 | return; | ||
999 | 450 | } | ||
1000 | 451 | else { | ||
1001 | 452 | $opt->{value} = $val; | ||
1002 | 453 | } | ||
1003 | 454 | } | ||
1004 | 444 | else { | 455 | else { |
1005 | 445 | $opt->{value} = $val; | 456 | $opt->{value} = $val; |
1006 | 446 | } | 457 | } |
1007 | @@ -1024,6 +1035,45 @@ | |||
1008 | 1024 | ); | 1035 | ); |
1009 | 1025 | }; | 1036 | }; |
1010 | 1026 | 1037 | ||
1011 | 1038 | sub set_vars { | ||
1012 | 1039 | my ($self, $file) = @_; | ||
1013 | 1040 | $file ||= $self->{file} || __FILE__; | ||
1014 | 1041 | |||
1015 | 1042 | my %user_vars; | ||
1016 | 1043 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1017 | 1044 | if ( $user_vars ) { | ||
1018 | 1045 | foreach my $var_val ( @$user_vars ) { | ||
1019 | 1046 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1020 | 1047 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1021 | 1048 | $user_vars{$var} = { | ||
1022 | 1049 | val => $val, | ||
1023 | 1050 | default => 0, | ||
1024 | 1051 | }; | ||
1025 | 1052 | } | ||
1026 | 1053 | } | ||
1027 | 1054 | |||
1028 | 1055 | my %default_vars; | ||
1029 | 1056 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1030 | 1057 | if ( $default_vars ) { | ||
1031 | 1058 | %default_vars = map { | ||
1032 | 1059 | my $var_val = $_; | ||
1033 | 1060 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1034 | 1061 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1035 | 1062 | $var => { | ||
1036 | 1063 | val => $val, | ||
1037 | 1064 | default => 1, | ||
1038 | 1065 | }; | ||
1039 | 1066 | } split("\n", $default_vars); | ||
1040 | 1067 | } | ||
1041 | 1068 | |||
1042 | 1069 | my %vars = ( | ||
1043 | 1070 | %default_vars, # first the tool's defaults | ||
1044 | 1071 | %user_vars, # then the user's which overwrite the defaults | ||
1045 | 1072 | ); | ||
1046 | 1073 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1047 | 1074 | return \%vars; | ||
1048 | 1075 | } | ||
1049 | 1076 | |||
1050 | 1027 | sub _d { | 1077 | sub _d { |
1051 | 1028 | my ($package, undef, $line) = caller 0; | 1078 | my ($package, undef, $line) = caller 0; |
1052 | 1029 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1079 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1053 | 1030 | 1080 | ||
1054 | === modified file 'bin/pt-online-schema-change' | |||
1055 | --- bin/pt-online-schema-change 2013-07-18 17:31:04 +0000 | |||
1056 | +++ bin/pt-online-schema-change 2013-08-14 00:47:54 +0000 | |||
1057 | @@ -77,6 +77,7 @@ | |||
1058 | 77 | 77 | ||
1059 | 78 | use List::Util qw(max); | 78 | use List::Util qw(max); |
1060 | 79 | use Getopt::Long; | 79 | use Getopt::Long; |
1061 | 80 | use Data::Dumper; | ||
1062 | 80 | 81 | ||
1063 | 81 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 82 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1064 | 82 | 83 | ||
1065 | @@ -472,11 +473,21 @@ | |||
1066 | 472 | my $long = exists $self->{opts}->{$opt} ? $opt | 473 | my $long = exists $self->{opts}->{$opt} ? $opt |
1067 | 473 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 474 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1068 | 474 | : die "Getopt::Long gave a nonexistent option: $opt"; | 475 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1069 | 475 | |||
1070 | 476 | $opt = $self->{opts}->{$long}; | 476 | $opt = $self->{opts}->{$long}; |
1071 | 477 | if ( $opt->{is_cumulative} ) { | 477 | if ( $opt->{is_cumulative} ) { |
1072 | 478 | $opt->{value}++; | 478 | $opt->{value}++; |
1073 | 479 | } | 479 | } |
1074 | 480 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1075 | 481 | my $next_opt = $1; | ||
1076 | 482 | if ( exists $self->{opts}->{$next_opt} | ||
1077 | 483 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1078 | 484 | $self->save_error("--$long requires a string value"); | ||
1079 | 485 | return; | ||
1080 | 486 | } | ||
1081 | 487 | else { | ||
1082 | 488 | $opt->{value} = $val; | ||
1083 | 489 | } | ||
1084 | 490 | } | ||
1085 | 480 | else { | 491 | else { |
1086 | 481 | $opt->{value} = $val; | 492 | $opt->{value} = $val; |
1087 | 482 | } | 493 | } |
1088 | @@ -1060,6 +1071,45 @@ | |||
1089 | 1060 | ); | 1071 | ); |
1090 | 1061 | }; | 1072 | }; |
1091 | 1062 | 1073 | ||
1092 | 1074 | sub set_vars { | ||
1093 | 1075 | my ($self, $file) = @_; | ||
1094 | 1076 | $file ||= $self->{file} || __FILE__; | ||
1095 | 1077 | |||
1096 | 1078 | my %user_vars; | ||
1097 | 1079 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1098 | 1080 | if ( $user_vars ) { | ||
1099 | 1081 | foreach my $var_val ( @$user_vars ) { | ||
1100 | 1082 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1101 | 1083 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1102 | 1084 | $user_vars{$var} = { | ||
1103 | 1085 | val => $val, | ||
1104 | 1086 | default => 0, | ||
1105 | 1087 | }; | ||
1106 | 1088 | } | ||
1107 | 1089 | } | ||
1108 | 1090 | |||
1109 | 1091 | my %default_vars; | ||
1110 | 1092 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1111 | 1093 | if ( $default_vars ) { | ||
1112 | 1094 | %default_vars = map { | ||
1113 | 1095 | my $var_val = $_; | ||
1114 | 1096 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1115 | 1097 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1116 | 1098 | $var => { | ||
1117 | 1099 | val => $val, | ||
1118 | 1100 | default => 1, | ||
1119 | 1101 | }; | ||
1120 | 1102 | } split("\n", $default_vars); | ||
1121 | 1103 | } | ||
1122 | 1104 | |||
1123 | 1105 | my %vars = ( | ||
1124 | 1106 | %default_vars, # first the tool's defaults | ||
1125 | 1107 | %user_vars, # then the user's which overwrite the defaults | ||
1126 | 1108 | ); | ||
1127 | 1109 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1128 | 1110 | return \%vars; | ||
1129 | 1111 | } | ||
1130 | 1112 | |||
1131 | 1063 | sub _d { | 1113 | sub _d { |
1132 | 1064 | my ($package, undef, $line) = caller 0; | 1114 | my ($package, undef, $line) = caller 0; |
1133 | 1065 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1115 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1134 | 1066 | 1116 | ||
1135 | === modified file 'bin/pt-query-advisor' | |||
1136 | --- bin/pt-query-advisor 2013-07-18 17:31:04 +0000 | |||
1137 | +++ bin/pt-query-advisor 2013-08-14 00:47:54 +0000 | |||
1138 | @@ -449,6 +449,7 @@ | |||
1139 | 449 | 449 | ||
1140 | 450 | use List::Util qw(max); | 450 | use List::Util qw(max); |
1141 | 451 | use Getopt::Long; | 451 | use Getopt::Long; |
1142 | 452 | use Data::Dumper; | ||
1143 | 452 | 453 | ||
1144 | 453 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 454 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1145 | 454 | 455 | ||
1146 | @@ -844,11 +845,21 @@ | |||
1147 | 844 | my $long = exists $self->{opts}->{$opt} ? $opt | 845 | my $long = exists $self->{opts}->{$opt} ? $opt |
1148 | 845 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 846 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1149 | 846 | : die "Getopt::Long gave a nonexistent option: $opt"; | 847 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1150 | 847 | |||
1151 | 848 | $opt = $self->{opts}->{$long}; | 848 | $opt = $self->{opts}->{$long}; |
1152 | 849 | if ( $opt->{is_cumulative} ) { | 849 | if ( $opt->{is_cumulative} ) { |
1153 | 850 | $opt->{value}++; | 850 | $opt->{value}++; |
1154 | 851 | } | 851 | } |
1155 | 852 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1156 | 853 | my $next_opt = $1; | ||
1157 | 854 | if ( exists $self->{opts}->{$next_opt} | ||
1158 | 855 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1159 | 856 | $self->save_error("--$long requires a string value"); | ||
1160 | 857 | return; | ||
1161 | 858 | } | ||
1162 | 859 | else { | ||
1163 | 860 | $opt->{value} = $val; | ||
1164 | 861 | } | ||
1165 | 862 | } | ||
1166 | 852 | else { | 863 | else { |
1167 | 853 | $opt->{value} = $val; | 864 | $opt->{value} = $val; |
1168 | 854 | } | 865 | } |
1169 | @@ -1432,6 +1443,45 @@ | |||
1170 | 1432 | ); | 1443 | ); |
1171 | 1433 | }; | 1444 | }; |
1172 | 1434 | 1445 | ||
1173 | 1446 | sub set_vars { | ||
1174 | 1447 | my ($self, $file) = @_; | ||
1175 | 1448 | $file ||= $self->{file} || __FILE__; | ||
1176 | 1449 | |||
1177 | 1450 | my %user_vars; | ||
1178 | 1451 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1179 | 1452 | if ( $user_vars ) { | ||
1180 | 1453 | foreach my $var_val ( @$user_vars ) { | ||
1181 | 1454 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1182 | 1455 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1183 | 1456 | $user_vars{$var} = { | ||
1184 | 1457 | val => $val, | ||
1185 | 1458 | default => 0, | ||
1186 | 1459 | }; | ||
1187 | 1460 | } | ||
1188 | 1461 | } | ||
1189 | 1462 | |||
1190 | 1463 | my %default_vars; | ||
1191 | 1464 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1192 | 1465 | if ( $default_vars ) { | ||
1193 | 1466 | %default_vars = map { | ||
1194 | 1467 | my $var_val = $_; | ||
1195 | 1468 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1196 | 1469 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1197 | 1470 | $var => { | ||
1198 | 1471 | val => $val, | ||
1199 | 1472 | default => 1, | ||
1200 | 1473 | }; | ||
1201 | 1474 | } split("\n", $default_vars); | ||
1202 | 1475 | } | ||
1203 | 1476 | |||
1204 | 1477 | my %vars = ( | ||
1205 | 1478 | %default_vars, # first the tool's defaults | ||
1206 | 1479 | %user_vars, # then the user's which overwrite the defaults | ||
1207 | 1480 | ); | ||
1208 | 1481 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1209 | 1482 | return \%vars; | ||
1210 | 1483 | } | ||
1211 | 1484 | |||
1212 | 1435 | sub _d { | 1485 | sub _d { |
1213 | 1436 | my ($package, undef, $line) = caller 0; | 1486 | my ($package, undef, $line) = caller 0; |
1214 | 1437 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1487 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1215 | 1438 | 1488 | ||
1216 | === modified file 'bin/pt-query-digest' | |||
1217 | --- bin/pt-query-digest 2013-07-18 17:31:04 +0000 | |||
1218 | +++ bin/pt-query-digest 2013-08-14 00:47:54 +0000 | |||
1219 | @@ -593,6 +593,7 @@ | |||
1220 | 593 | 593 | ||
1221 | 594 | use List::Util qw(max); | 594 | use List::Util qw(max); |
1222 | 595 | use Getopt::Long; | 595 | use Getopt::Long; |
1223 | 596 | use Data::Dumper; | ||
1224 | 596 | 597 | ||
1225 | 597 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 598 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1226 | 598 | 599 | ||
1227 | @@ -988,11 +989,21 @@ | |||
1228 | 988 | my $long = exists $self->{opts}->{$opt} ? $opt | 989 | my $long = exists $self->{opts}->{$opt} ? $opt |
1229 | 989 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 990 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1230 | 990 | : die "Getopt::Long gave a nonexistent option: $opt"; | 991 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1231 | 991 | |||
1232 | 992 | $opt = $self->{opts}->{$long}; | 992 | $opt = $self->{opts}->{$long}; |
1233 | 993 | if ( $opt->{is_cumulative} ) { | 993 | if ( $opt->{is_cumulative} ) { |
1234 | 994 | $opt->{value}++; | 994 | $opt->{value}++; |
1235 | 995 | } | 995 | } |
1236 | 996 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1237 | 997 | my $next_opt = $1; | ||
1238 | 998 | if ( exists $self->{opts}->{$next_opt} | ||
1239 | 999 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1240 | 1000 | $self->save_error("--$long requires a string value"); | ||
1241 | 1001 | return; | ||
1242 | 1002 | } | ||
1243 | 1003 | else { | ||
1244 | 1004 | $opt->{value} = $val; | ||
1245 | 1005 | } | ||
1246 | 1006 | } | ||
1247 | 996 | else { | 1007 | else { |
1248 | 997 | $opt->{value} = $val; | 1008 | $opt->{value} = $val; |
1249 | 998 | } | 1009 | } |
1250 | @@ -1576,6 +1587,45 @@ | |||
1251 | 1576 | ); | 1587 | ); |
1252 | 1577 | }; | 1588 | }; |
1253 | 1578 | 1589 | ||
1254 | 1590 | sub set_vars { | ||
1255 | 1591 | my ($self, $file) = @_; | ||
1256 | 1592 | $file ||= $self->{file} || __FILE__; | ||
1257 | 1593 | |||
1258 | 1594 | my %user_vars; | ||
1259 | 1595 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1260 | 1596 | if ( $user_vars ) { | ||
1261 | 1597 | foreach my $var_val ( @$user_vars ) { | ||
1262 | 1598 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1263 | 1599 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1264 | 1600 | $user_vars{$var} = { | ||
1265 | 1601 | val => $val, | ||
1266 | 1602 | default => 0, | ||
1267 | 1603 | }; | ||
1268 | 1604 | } | ||
1269 | 1605 | } | ||
1270 | 1606 | |||
1271 | 1607 | my %default_vars; | ||
1272 | 1608 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1273 | 1609 | if ( $default_vars ) { | ||
1274 | 1610 | %default_vars = map { | ||
1275 | 1611 | my $var_val = $_; | ||
1276 | 1612 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1277 | 1613 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1278 | 1614 | $var => { | ||
1279 | 1615 | val => $val, | ||
1280 | 1616 | default => 1, | ||
1281 | 1617 | }; | ||
1282 | 1618 | } split("\n", $default_vars); | ||
1283 | 1619 | } | ||
1284 | 1620 | |||
1285 | 1621 | my %vars = ( | ||
1286 | 1622 | %default_vars, # first the tool's defaults | ||
1287 | 1623 | %user_vars, # then the user's which overwrite the defaults | ||
1288 | 1624 | ); | ||
1289 | 1625 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1290 | 1626 | return \%vars; | ||
1291 | 1627 | } | ||
1292 | 1628 | |||
1293 | 1579 | sub _d { | 1629 | sub _d { |
1294 | 1580 | my ($package, undef, $line) = caller 0; | 1630 | my ($package, undef, $line) = caller 0; |
1295 | 1581 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1631 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1296 | 1582 | 1632 | ||
1297 | === modified file 'bin/pt-show-grants' | |||
1298 | --- bin/pt-show-grants 2013-07-18 17:31:04 +0000 | |||
1299 | +++ bin/pt-show-grants 2013-08-14 00:47:54 +0000 | |||
1300 | @@ -37,6 +37,7 @@ | |||
1301 | 37 | 37 | ||
1302 | 38 | use List::Util qw(max); | 38 | use List::Util qw(max); |
1303 | 39 | use Getopt::Long; | 39 | use Getopt::Long; |
1304 | 40 | use Data::Dumper; | ||
1305 | 40 | 41 | ||
1306 | 41 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 42 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1307 | 42 | 43 | ||
1308 | @@ -432,11 +433,21 @@ | |||
1309 | 432 | my $long = exists $self->{opts}->{$opt} ? $opt | 433 | my $long = exists $self->{opts}->{$opt} ? $opt |
1310 | 433 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 434 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1311 | 434 | : die "Getopt::Long gave a nonexistent option: $opt"; | 435 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1312 | 435 | |||
1313 | 436 | $opt = $self->{opts}->{$long}; | 436 | $opt = $self->{opts}->{$long}; |
1314 | 437 | if ( $opt->{is_cumulative} ) { | 437 | if ( $opt->{is_cumulative} ) { |
1315 | 438 | $opt->{value}++; | 438 | $opt->{value}++; |
1316 | 439 | } | 439 | } |
1317 | 440 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1318 | 441 | my $next_opt = $1; | ||
1319 | 442 | if ( exists $self->{opts}->{$next_opt} | ||
1320 | 443 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1321 | 444 | $self->save_error("--$long requires a string value"); | ||
1322 | 445 | return; | ||
1323 | 446 | } | ||
1324 | 447 | else { | ||
1325 | 448 | $opt->{value} = $val; | ||
1326 | 449 | } | ||
1327 | 450 | } | ||
1328 | 440 | else { | 451 | else { |
1329 | 441 | $opt->{value} = $val; | 452 | $opt->{value} = $val; |
1330 | 442 | } | 453 | } |
1331 | @@ -1020,6 +1031,45 @@ | |||
1332 | 1020 | ); | 1031 | ); |
1333 | 1021 | }; | 1032 | }; |
1334 | 1022 | 1033 | ||
1335 | 1034 | sub set_vars { | ||
1336 | 1035 | my ($self, $file) = @_; | ||
1337 | 1036 | $file ||= $self->{file} || __FILE__; | ||
1338 | 1037 | |||
1339 | 1038 | my %user_vars; | ||
1340 | 1039 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1341 | 1040 | if ( $user_vars ) { | ||
1342 | 1041 | foreach my $var_val ( @$user_vars ) { | ||
1343 | 1042 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1344 | 1043 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1345 | 1044 | $user_vars{$var} = { | ||
1346 | 1045 | val => $val, | ||
1347 | 1046 | default => 0, | ||
1348 | 1047 | }; | ||
1349 | 1048 | } | ||
1350 | 1049 | } | ||
1351 | 1050 | |||
1352 | 1051 | my %default_vars; | ||
1353 | 1052 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1354 | 1053 | if ( $default_vars ) { | ||
1355 | 1054 | %default_vars = map { | ||
1356 | 1055 | my $var_val = $_; | ||
1357 | 1056 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1358 | 1057 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1359 | 1058 | $var => { | ||
1360 | 1059 | val => $val, | ||
1361 | 1060 | default => 1, | ||
1362 | 1061 | }; | ||
1363 | 1062 | } split("\n", $default_vars); | ||
1364 | 1063 | } | ||
1365 | 1064 | |||
1366 | 1065 | my %vars = ( | ||
1367 | 1066 | %default_vars, # first the tool's defaults | ||
1368 | 1067 | %user_vars, # then the user's which overwrite the defaults | ||
1369 | 1068 | ); | ||
1370 | 1069 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1371 | 1070 | return \%vars; | ||
1372 | 1071 | } | ||
1373 | 1072 | |||
1374 | 1023 | sub _d { | 1073 | sub _d { |
1375 | 1024 | my ($package, undef, $line) = caller 0; | 1074 | my ($package, undef, $line) = caller 0; |
1376 | 1025 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1075 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1377 | 1026 | 1076 | ||
1378 | === modified file 'bin/pt-slave-delay' | |||
1379 | --- bin/pt-slave-delay 2013-07-18 17:31:04 +0000 | |||
1380 | +++ bin/pt-slave-delay 2013-08-14 00:47:54 +0000 | |||
1381 | @@ -62,6 +62,7 @@ | |||
1382 | 62 | 62 | ||
1383 | 63 | use List::Util qw(max); | 63 | use List::Util qw(max); |
1384 | 64 | use Getopt::Long; | 64 | use Getopt::Long; |
1385 | 65 | use Data::Dumper; | ||
1386 | 65 | 66 | ||
1387 | 66 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 67 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1388 | 67 | 68 | ||
1389 | @@ -457,11 +458,21 @@ | |||
1390 | 457 | my $long = exists $self->{opts}->{$opt} ? $opt | 458 | my $long = exists $self->{opts}->{$opt} ? $opt |
1391 | 458 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 459 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1392 | 459 | : die "Getopt::Long gave a nonexistent option: $opt"; | 460 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1393 | 460 | |||
1394 | 461 | $opt = $self->{opts}->{$long}; | 461 | $opt = $self->{opts}->{$long}; |
1395 | 462 | if ( $opt->{is_cumulative} ) { | 462 | if ( $opt->{is_cumulative} ) { |
1396 | 463 | $opt->{value}++; | 463 | $opt->{value}++; |
1397 | 464 | } | 464 | } |
1398 | 465 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1399 | 466 | my $next_opt = $1; | ||
1400 | 467 | if ( exists $self->{opts}->{$next_opt} | ||
1401 | 468 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1402 | 469 | $self->save_error("--$long requires a string value"); | ||
1403 | 470 | return; | ||
1404 | 471 | } | ||
1405 | 472 | else { | ||
1406 | 473 | $opt->{value} = $val; | ||
1407 | 474 | } | ||
1408 | 475 | } | ||
1409 | 465 | else { | 476 | else { |
1410 | 466 | $opt->{value} = $val; | 477 | $opt->{value} = $val; |
1411 | 467 | } | 478 | } |
1412 | @@ -1045,6 +1056,45 @@ | |||
1413 | 1045 | ); | 1056 | ); |
1414 | 1046 | }; | 1057 | }; |
1415 | 1047 | 1058 | ||
1416 | 1059 | sub set_vars { | ||
1417 | 1060 | my ($self, $file) = @_; | ||
1418 | 1061 | $file ||= $self->{file} || __FILE__; | ||
1419 | 1062 | |||
1420 | 1063 | my %user_vars; | ||
1421 | 1064 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1422 | 1065 | if ( $user_vars ) { | ||
1423 | 1066 | foreach my $var_val ( @$user_vars ) { | ||
1424 | 1067 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1425 | 1068 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1426 | 1069 | $user_vars{$var} = { | ||
1427 | 1070 | val => $val, | ||
1428 | 1071 | default => 0, | ||
1429 | 1072 | }; | ||
1430 | 1073 | } | ||
1431 | 1074 | } | ||
1432 | 1075 | |||
1433 | 1076 | my %default_vars; | ||
1434 | 1077 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1435 | 1078 | if ( $default_vars ) { | ||
1436 | 1079 | %default_vars = map { | ||
1437 | 1080 | my $var_val = $_; | ||
1438 | 1081 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1439 | 1082 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1440 | 1083 | $var => { | ||
1441 | 1084 | val => $val, | ||
1442 | 1085 | default => 1, | ||
1443 | 1086 | }; | ||
1444 | 1087 | } split("\n", $default_vars); | ||
1445 | 1088 | } | ||
1446 | 1089 | |||
1447 | 1090 | my %vars = ( | ||
1448 | 1091 | %default_vars, # first the tool's defaults | ||
1449 | 1092 | %user_vars, # then the user's which overwrite the defaults | ||
1450 | 1093 | ); | ||
1451 | 1094 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1452 | 1095 | return \%vars; | ||
1453 | 1096 | } | ||
1454 | 1097 | |||
1455 | 1048 | sub _d { | 1098 | sub _d { |
1456 | 1049 | my ($package, undef, $line) = caller 0; | 1099 | my ($package, undef, $line) = caller 0; |
1457 | 1050 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1100 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1458 | 1051 | 1101 | ||
1459 | === modified file 'bin/pt-slave-find' | |||
1460 | --- bin/pt-slave-find 2013-07-18 17:31:04 +0000 | |||
1461 | +++ bin/pt-slave-find 2013-08-14 00:47:54 +0000 | |||
1462 | @@ -41,6 +41,7 @@ | |||
1463 | 41 | 41 | ||
1464 | 42 | use List::Util qw(max); | 42 | use List::Util qw(max); |
1465 | 43 | use Getopt::Long; | 43 | use Getopt::Long; |
1466 | 44 | use Data::Dumper; | ||
1467 | 44 | 45 | ||
1468 | 45 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 46 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1469 | 46 | 47 | ||
1470 | @@ -436,11 +437,21 @@ | |||
1471 | 436 | my $long = exists $self->{opts}->{$opt} ? $opt | 437 | my $long = exists $self->{opts}->{$opt} ? $opt |
1472 | 437 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 438 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1473 | 438 | : die "Getopt::Long gave a nonexistent option: $opt"; | 439 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1474 | 439 | |||
1475 | 440 | $opt = $self->{opts}->{$long}; | 440 | $opt = $self->{opts}->{$long}; |
1476 | 441 | if ( $opt->{is_cumulative} ) { | 441 | if ( $opt->{is_cumulative} ) { |
1477 | 442 | $opt->{value}++; | 442 | $opt->{value}++; |
1478 | 443 | } | 443 | } |
1479 | 444 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1480 | 445 | my $next_opt = $1; | ||
1481 | 446 | if ( exists $self->{opts}->{$next_opt} | ||
1482 | 447 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1483 | 448 | $self->save_error("--$long requires a string value"); | ||
1484 | 449 | return; | ||
1485 | 450 | } | ||
1486 | 451 | else { | ||
1487 | 452 | $opt->{value} = $val; | ||
1488 | 453 | } | ||
1489 | 454 | } | ||
1490 | 444 | else { | 455 | else { |
1491 | 445 | $opt->{value} = $val; | 456 | $opt->{value} = $val; |
1492 | 446 | } | 457 | } |
1493 | @@ -1024,6 +1035,45 @@ | |||
1494 | 1024 | ); | 1035 | ); |
1495 | 1025 | }; | 1036 | }; |
1496 | 1026 | 1037 | ||
1497 | 1038 | sub set_vars { | ||
1498 | 1039 | my ($self, $file) = @_; | ||
1499 | 1040 | $file ||= $self->{file} || __FILE__; | ||
1500 | 1041 | |||
1501 | 1042 | my %user_vars; | ||
1502 | 1043 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1503 | 1044 | if ( $user_vars ) { | ||
1504 | 1045 | foreach my $var_val ( @$user_vars ) { | ||
1505 | 1046 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1506 | 1047 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1507 | 1048 | $user_vars{$var} = { | ||
1508 | 1049 | val => $val, | ||
1509 | 1050 | default => 0, | ||
1510 | 1051 | }; | ||
1511 | 1052 | } | ||
1512 | 1053 | } | ||
1513 | 1054 | |||
1514 | 1055 | my %default_vars; | ||
1515 | 1056 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1516 | 1057 | if ( $default_vars ) { | ||
1517 | 1058 | %default_vars = map { | ||
1518 | 1059 | my $var_val = $_; | ||
1519 | 1060 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1520 | 1061 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1521 | 1062 | $var => { | ||
1522 | 1063 | val => $val, | ||
1523 | 1064 | default => 1, | ||
1524 | 1065 | }; | ||
1525 | 1066 | } split("\n", $default_vars); | ||
1526 | 1067 | } | ||
1527 | 1068 | |||
1528 | 1069 | my %vars = ( | ||
1529 | 1070 | %default_vars, # first the tool's defaults | ||
1530 | 1071 | %user_vars, # then the user's which overwrite the defaults | ||
1531 | 1072 | ); | ||
1532 | 1073 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1533 | 1074 | return \%vars; | ||
1534 | 1075 | } | ||
1535 | 1076 | |||
1536 | 1027 | sub _d { | 1077 | sub _d { |
1537 | 1028 | my ($package, undef, $line) = caller 0; | 1078 | my ($package, undef, $line) = caller 0; |
1538 | 1029 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1079 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1539 | 1030 | 1080 | ||
1540 | === modified file 'bin/pt-slave-restart' | |||
1541 | --- bin/pt-slave-restart 2013-07-18 17:31:04 +0000 | |||
1542 | +++ bin/pt-slave-restart 2013-08-14 00:47:54 +0000 | |||
1543 | @@ -189,6 +189,7 @@ | |||
1544 | 189 | 189 | ||
1545 | 190 | use List::Util qw(max); | 190 | use List::Util qw(max); |
1546 | 191 | use Getopt::Long; | 191 | use Getopt::Long; |
1547 | 192 | use Data::Dumper; | ||
1548 | 192 | 193 | ||
1549 | 193 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 194 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1550 | 194 | 195 | ||
1551 | @@ -584,11 +585,21 @@ | |||
1552 | 584 | my $long = exists $self->{opts}->{$opt} ? $opt | 585 | my $long = exists $self->{opts}->{$opt} ? $opt |
1553 | 585 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 586 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1554 | 586 | : die "Getopt::Long gave a nonexistent option: $opt"; | 587 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1555 | 587 | |||
1556 | 588 | $opt = $self->{opts}->{$long}; | 588 | $opt = $self->{opts}->{$long}; |
1557 | 589 | if ( $opt->{is_cumulative} ) { | 589 | if ( $opt->{is_cumulative} ) { |
1558 | 590 | $opt->{value}++; | 590 | $opt->{value}++; |
1559 | 591 | } | 591 | } |
1560 | 592 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1561 | 593 | my $next_opt = $1; | ||
1562 | 594 | if ( exists $self->{opts}->{$next_opt} | ||
1563 | 595 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1564 | 596 | $self->save_error("--$long requires a string value"); | ||
1565 | 597 | return; | ||
1566 | 598 | } | ||
1567 | 599 | else { | ||
1568 | 600 | $opt->{value} = $val; | ||
1569 | 601 | } | ||
1570 | 602 | } | ||
1571 | 592 | else { | 603 | else { |
1572 | 593 | $opt->{value} = $val; | 604 | $opt->{value} = $val; |
1573 | 594 | } | 605 | } |
1574 | @@ -1172,6 +1183,45 @@ | |||
1575 | 1172 | ); | 1183 | ); |
1576 | 1173 | }; | 1184 | }; |
1577 | 1174 | 1185 | ||
1578 | 1186 | sub set_vars { | ||
1579 | 1187 | my ($self, $file) = @_; | ||
1580 | 1188 | $file ||= $self->{file} || __FILE__; | ||
1581 | 1189 | |||
1582 | 1190 | my %user_vars; | ||
1583 | 1191 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1584 | 1192 | if ( $user_vars ) { | ||
1585 | 1193 | foreach my $var_val ( @$user_vars ) { | ||
1586 | 1194 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1587 | 1195 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1588 | 1196 | $user_vars{$var} = { | ||
1589 | 1197 | val => $val, | ||
1590 | 1198 | default => 0, | ||
1591 | 1199 | }; | ||
1592 | 1200 | } | ||
1593 | 1201 | } | ||
1594 | 1202 | |||
1595 | 1203 | my %default_vars; | ||
1596 | 1204 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1597 | 1205 | if ( $default_vars ) { | ||
1598 | 1206 | %default_vars = map { | ||
1599 | 1207 | my $var_val = $_; | ||
1600 | 1208 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1601 | 1209 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1602 | 1210 | $var => { | ||
1603 | 1211 | val => $val, | ||
1604 | 1212 | default => 1, | ||
1605 | 1213 | }; | ||
1606 | 1214 | } split("\n", $default_vars); | ||
1607 | 1215 | } | ||
1608 | 1216 | |||
1609 | 1217 | my %vars = ( | ||
1610 | 1218 | %default_vars, # first the tool's defaults | ||
1611 | 1219 | %user_vars, # then the user's which overwrite the defaults | ||
1612 | 1220 | ); | ||
1613 | 1221 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1614 | 1222 | return \%vars; | ||
1615 | 1223 | } | ||
1616 | 1224 | |||
1617 | 1175 | sub _d { | 1225 | sub _d { |
1618 | 1176 | my ($package, undef, $line) = caller 0; | 1226 | my ($package, undef, $line) = caller 0; |
1619 | 1177 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1227 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1620 | 1178 | 1228 | ||
1621 | === modified file 'bin/pt-table-checksum' | |||
1622 | --- bin/pt-table-checksum 2013-07-18 17:31:04 +0000 | |||
1623 | +++ bin/pt-table-checksum 2013-08-14 00:47:54 +0000 | |||
1624 | @@ -1762,6 +1762,7 @@ | |||
1625 | 1762 | 1762 | ||
1626 | 1763 | use List::Util qw(max); | 1763 | use List::Util qw(max); |
1627 | 1764 | use Getopt::Long; | 1764 | use Getopt::Long; |
1628 | 1765 | use Data::Dumper; | ||
1629 | 1765 | 1766 | ||
1630 | 1766 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 1767 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1631 | 1767 | 1768 | ||
1632 | @@ -2157,11 +2158,21 @@ | |||
1633 | 2157 | my $long = exists $self->{opts}->{$opt} ? $opt | 2158 | my $long = exists $self->{opts}->{$opt} ? $opt |
1634 | 2158 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 2159 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1635 | 2159 | : die "Getopt::Long gave a nonexistent option: $opt"; | 2160 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1636 | 2160 | |||
1637 | 2161 | $opt = $self->{opts}->{$long}; | 2161 | $opt = $self->{opts}->{$long}; |
1638 | 2162 | if ( $opt->{is_cumulative} ) { | 2162 | if ( $opt->{is_cumulative} ) { |
1639 | 2163 | $opt->{value}++; | 2163 | $opt->{value}++; |
1640 | 2164 | } | 2164 | } |
1641 | 2165 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1642 | 2166 | my $next_opt = $1; | ||
1643 | 2167 | if ( exists $self->{opts}->{$next_opt} | ||
1644 | 2168 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1645 | 2169 | $self->save_error("--$long requires a string value"); | ||
1646 | 2170 | return; | ||
1647 | 2171 | } | ||
1648 | 2172 | else { | ||
1649 | 2173 | $opt->{value} = $val; | ||
1650 | 2174 | } | ||
1651 | 2175 | } | ||
1652 | 2165 | else { | 2176 | else { |
1653 | 2166 | $opt->{value} = $val; | 2177 | $opt->{value} = $val; |
1654 | 2167 | } | 2178 | } |
1655 | @@ -2745,6 +2756,45 @@ | |||
1656 | 2745 | ); | 2756 | ); |
1657 | 2746 | }; | 2757 | }; |
1658 | 2747 | 2758 | ||
1659 | 2759 | sub set_vars { | ||
1660 | 2760 | my ($self, $file) = @_; | ||
1661 | 2761 | $file ||= $self->{file} || __FILE__; | ||
1662 | 2762 | |||
1663 | 2763 | my %user_vars; | ||
1664 | 2764 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1665 | 2765 | if ( $user_vars ) { | ||
1666 | 2766 | foreach my $var_val ( @$user_vars ) { | ||
1667 | 2767 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1668 | 2768 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1669 | 2769 | $user_vars{$var} = { | ||
1670 | 2770 | val => $val, | ||
1671 | 2771 | default => 0, | ||
1672 | 2772 | }; | ||
1673 | 2773 | } | ||
1674 | 2774 | } | ||
1675 | 2775 | |||
1676 | 2776 | my %default_vars; | ||
1677 | 2777 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1678 | 2778 | if ( $default_vars ) { | ||
1679 | 2779 | %default_vars = map { | ||
1680 | 2780 | my $var_val = $_; | ||
1681 | 2781 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1682 | 2782 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1683 | 2783 | $var => { | ||
1684 | 2784 | val => $val, | ||
1685 | 2785 | default => 1, | ||
1686 | 2786 | }; | ||
1687 | 2787 | } split("\n", $default_vars); | ||
1688 | 2788 | } | ||
1689 | 2789 | |||
1690 | 2790 | my %vars = ( | ||
1691 | 2791 | %default_vars, # first the tool's defaults | ||
1692 | 2792 | %user_vars, # then the user's which overwrite the defaults | ||
1693 | 2793 | ); | ||
1694 | 2794 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1695 | 2795 | return \%vars; | ||
1696 | 2796 | } | ||
1697 | 2797 | |||
1698 | 2748 | sub _d { | 2798 | sub _d { |
1699 | 2749 | my ($package, undef, $line) = caller 0; | 2799 | my ($package, undef, $line) = caller 0; |
1700 | 2750 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 2800 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1701 | 2751 | 2801 | ||
1702 | === modified file 'bin/pt-table-sync' | |||
1703 | --- bin/pt-table-sync 2013-07-18 17:31:04 +0000 | |||
1704 | +++ bin/pt-table-sync 2013-08-14 00:47:54 +0000 | |||
1705 | @@ -78,6 +78,7 @@ | |||
1706 | 78 | 78 | ||
1707 | 79 | use List::Util qw(max); | 79 | use List::Util qw(max); |
1708 | 80 | use Getopt::Long; | 80 | use Getopt::Long; |
1709 | 81 | use Data::Dumper; | ||
1710 | 81 | 82 | ||
1711 | 82 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 83 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1712 | 83 | 84 | ||
1713 | @@ -473,11 +474,21 @@ | |||
1714 | 473 | my $long = exists $self->{opts}->{$opt} ? $opt | 474 | my $long = exists $self->{opts}->{$opt} ? $opt |
1715 | 474 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 475 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1716 | 475 | : die "Getopt::Long gave a nonexistent option: $opt"; | 476 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1717 | 476 | |||
1718 | 477 | $opt = $self->{opts}->{$long}; | 477 | $opt = $self->{opts}->{$long}; |
1719 | 478 | if ( $opt->{is_cumulative} ) { | 478 | if ( $opt->{is_cumulative} ) { |
1720 | 479 | $opt->{value}++; | 479 | $opt->{value}++; |
1721 | 480 | } | 480 | } |
1722 | 481 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1723 | 482 | my $next_opt = $1; | ||
1724 | 483 | if ( exists $self->{opts}->{$next_opt} | ||
1725 | 484 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1726 | 485 | $self->save_error("--$long requires a string value"); | ||
1727 | 486 | return; | ||
1728 | 487 | } | ||
1729 | 488 | else { | ||
1730 | 489 | $opt->{value} = $val; | ||
1731 | 490 | } | ||
1732 | 491 | } | ||
1733 | 481 | else { | 492 | else { |
1734 | 482 | $opt->{value} = $val; | 493 | $opt->{value} = $val; |
1735 | 483 | } | 494 | } |
1736 | @@ -1061,6 +1072,45 @@ | |||
1737 | 1061 | ); | 1072 | ); |
1738 | 1062 | }; | 1073 | }; |
1739 | 1063 | 1074 | ||
1740 | 1075 | sub set_vars { | ||
1741 | 1076 | my ($self, $file) = @_; | ||
1742 | 1077 | $file ||= $self->{file} || __FILE__; | ||
1743 | 1078 | |||
1744 | 1079 | my %user_vars; | ||
1745 | 1080 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1746 | 1081 | if ( $user_vars ) { | ||
1747 | 1082 | foreach my $var_val ( @$user_vars ) { | ||
1748 | 1083 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1749 | 1084 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1750 | 1085 | $user_vars{$var} = { | ||
1751 | 1086 | val => $val, | ||
1752 | 1087 | default => 0, | ||
1753 | 1088 | }; | ||
1754 | 1089 | } | ||
1755 | 1090 | } | ||
1756 | 1091 | |||
1757 | 1092 | my %default_vars; | ||
1758 | 1093 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1759 | 1094 | if ( $default_vars ) { | ||
1760 | 1095 | %default_vars = map { | ||
1761 | 1096 | my $var_val = $_; | ||
1762 | 1097 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1763 | 1098 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1764 | 1099 | $var => { | ||
1765 | 1100 | val => $val, | ||
1766 | 1101 | default => 1, | ||
1767 | 1102 | }; | ||
1768 | 1103 | } split("\n", $default_vars); | ||
1769 | 1104 | } | ||
1770 | 1105 | |||
1771 | 1106 | my %vars = ( | ||
1772 | 1107 | %default_vars, # first the tool's defaults | ||
1773 | 1108 | %user_vars, # then the user's which overwrite the defaults | ||
1774 | 1109 | ); | ||
1775 | 1110 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1776 | 1111 | return \%vars; | ||
1777 | 1112 | } | ||
1778 | 1113 | |||
1779 | 1064 | sub _d { | 1114 | sub _d { |
1780 | 1065 | my ($package, undef, $line) = caller 0; | 1115 | my ($package, undef, $line) = caller 0; |
1781 | 1066 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1116 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1782 | 1067 | 1117 | ||
1783 | === modified file 'bin/pt-table-usage' | |||
1784 | --- bin/pt-table-usage 2013-07-18 17:31:04 +0000 | |||
1785 | +++ bin/pt-table-usage 2013-08-14 00:47:54 +0000 | |||
1786 | @@ -428,6 +428,7 @@ | |||
1787 | 428 | 428 | ||
1788 | 429 | use List::Util qw(max); | 429 | use List::Util qw(max); |
1789 | 430 | use Getopt::Long; | 430 | use Getopt::Long; |
1790 | 431 | use Data::Dumper; | ||
1791 | 431 | 432 | ||
1792 | 432 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 433 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1793 | 433 | 434 | ||
1794 | @@ -449,7 +450,6 @@ | |||
1795 | 449 | 'default' => 1, | 450 | 'default' => 1, |
1796 | 450 | 'cumulative' => 1, | 451 | 'cumulative' => 1, |
1797 | 451 | 'negatable' => 1, | 452 | 'negatable' => 1, |
1798 | 452 | 'value_is_optional' => 1, | ||
1799 | 453 | ); | 453 | ); |
1800 | 454 | 454 | ||
1801 | 455 | my $self = { | 455 | my $self = { |
1802 | @@ -691,10 +691,9 @@ | |||
1803 | 691 | $opt->{short} = undef; | 691 | $opt->{short} = undef; |
1804 | 692 | } | 692 | } |
1805 | 693 | 693 | ||
1810 | 694 | $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0; | 694 | $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0; |
1811 | 695 | $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0; | 695 | $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0; |
1812 | 696 | $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0; | 696 | $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0; |
1809 | 697 | $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0; | ||
1813 | 698 | 697 | ||
1814 | 699 | $opt->{group} ||= 'default'; | 698 | $opt->{group} ||= 'default'; |
1815 | 700 | $self->{groups}->{ $opt->{group} }->{$long} = 1; | 699 | $self->{groups}->{ $opt->{group} }->{$long} = 1; |
1816 | @@ -825,12 +824,22 @@ | |||
1817 | 825 | my $long = exists $self->{opts}->{$opt} ? $opt | 824 | my $long = exists $self->{opts}->{$opt} ? $opt |
1818 | 826 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 825 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1819 | 827 | : die "Getopt::Long gave a nonexistent option: $opt"; | 826 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1820 | 828 | |||
1821 | 829 | $opt = $self->{opts}->{$long}; | 827 | $opt = $self->{opts}->{$long}; |
1822 | 830 | if ( $opt->{is_cumulative} ) { | 828 | if ( $opt->{is_cumulative} ) { |
1823 | 831 | $opt->{value}++; | 829 | $opt->{value}++; |
1824 | 832 | } | 830 | } |
1826 | 833 | elsif ( !($opt->{optional_value} && !$val) ) { | 831 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { |
1827 | 832 | my $next_opt = $1; | ||
1828 | 833 | if ( exists $self->{opts}->{$next_opt} | ||
1829 | 834 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1830 | 835 | $self->save_error("--$long requires a string value"); | ||
1831 | 836 | return; | ||
1832 | 837 | } | ||
1833 | 838 | else { | ||
1834 | 839 | $opt->{value} = $val; | ||
1835 | 840 | } | ||
1836 | 841 | } | ||
1837 | 842 | else { | ||
1838 | 834 | $opt->{value} = $val; | 843 | $opt->{value} = $val; |
1839 | 835 | } | 844 | } |
1840 | 836 | $opt->{got} = 1; | 845 | $opt->{got} = 1; |
1841 | @@ -1210,7 +1219,7 @@ | |||
1842 | 1210 | $desc .= ". Optional suffix s=seconds, m=minutes, h=hours, " | 1219 | $desc .= ". Optional suffix s=seconds, m=minutes, h=hours, " |
1843 | 1211 | . "d=days; if no suffix, $s is used."; | 1220 | . "d=days; if no suffix, $s is used."; |
1844 | 1212 | } | 1221 | } |
1846 | 1213 | $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol})(?:\s+|$)/g); | 1222 | $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol}(?!\W))(?:\s+|(?<=\W)|$)/g); |
1847 | 1214 | $desc =~ s/ +$//mg; | 1223 | $desc =~ s/ +$//mg; |
1848 | 1215 | if ( $short ) { | 1224 | if ( $short ) { |
1849 | 1216 | $usage .= sprintf(" --%-${maxs}s -%s %s\n", $long, $short, $desc); | 1225 | $usage .= sprintf(" --%-${maxs}s -%s %s\n", $long, $short, $desc); |
1850 | @@ -1371,12 +1380,11 @@ | |||
1851 | 1371 | sub _parse_attribs { | 1380 | sub _parse_attribs { |
1852 | 1372 | my ( $self, $option, $attribs ) = @_; | 1381 | my ( $self, $option, $attribs ) = @_; |
1853 | 1373 | my $types = $self->{types}; | 1382 | my $types = $self->{types}; |
1854 | 1374 | my $eq = $attribs->{'value_is_optional'} ? ':' : '='; | ||
1855 | 1375 | return $option | 1383 | return $option |
1856 | 1376 | . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' ) | 1384 | . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' ) |
1857 | 1377 | . ($attribs->{'negatable'} ? '!' : '' ) | 1385 | . ($attribs->{'negatable'} ? '!' : '' ) |
1858 | 1378 | . ($attribs->{'cumulative'} ? '+' : '' ) | 1386 | . ($attribs->{'cumulative'} ? '+' : '' ) |
1860 | 1379 | . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' ); | 1387 | . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' ); |
1861 | 1380 | } | 1388 | } |
1862 | 1381 | 1389 | ||
1863 | 1382 | sub _parse_synopsis { | 1390 | sub _parse_synopsis { |
1864 | @@ -1414,6 +1422,45 @@ | |||
1865 | 1414 | ); | 1422 | ); |
1866 | 1415 | }; | 1423 | }; |
1867 | 1416 | 1424 | ||
1868 | 1425 | sub set_vars { | ||
1869 | 1426 | my ($self, $file) = @_; | ||
1870 | 1427 | $file ||= $self->{file} || __FILE__; | ||
1871 | 1428 | |||
1872 | 1429 | my %user_vars; | ||
1873 | 1430 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1874 | 1431 | if ( $user_vars ) { | ||
1875 | 1432 | foreach my $var_val ( @$user_vars ) { | ||
1876 | 1433 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1877 | 1434 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1878 | 1435 | $user_vars{$var} = { | ||
1879 | 1436 | val => $val, | ||
1880 | 1437 | default => 0, | ||
1881 | 1438 | }; | ||
1882 | 1439 | } | ||
1883 | 1440 | } | ||
1884 | 1441 | |||
1885 | 1442 | my %default_vars; | ||
1886 | 1443 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1887 | 1444 | if ( $default_vars ) { | ||
1888 | 1445 | %default_vars = map { | ||
1889 | 1446 | my $var_val = $_; | ||
1890 | 1447 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1891 | 1448 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1892 | 1449 | $var => { | ||
1893 | 1450 | val => $val, | ||
1894 | 1451 | default => 1, | ||
1895 | 1452 | }; | ||
1896 | 1453 | } split("\n", $default_vars); | ||
1897 | 1454 | } | ||
1898 | 1455 | |||
1899 | 1456 | my %vars = ( | ||
1900 | 1457 | %default_vars, # first the tool's defaults | ||
1901 | 1458 | %user_vars, # then the user's which overwrite the defaults | ||
1902 | 1459 | ); | ||
1903 | 1460 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1904 | 1461 | return \%vars; | ||
1905 | 1462 | } | ||
1906 | 1463 | |||
1907 | 1417 | sub _d { | 1464 | sub _d { |
1908 | 1418 | my ($package, undef, $line) = caller 0; | 1465 | my ($package, undef, $line) = caller 0; |
1909 | 1419 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1466 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1910 | 1420 | 1467 | ||
1911 | === modified file 'bin/pt-tcp-model' | |||
1912 | --- bin/pt-tcp-model 2013-07-18 17:31:04 +0000 | |||
1913 | +++ bin/pt-tcp-model 2013-08-14 00:47:54 +0000 | |||
1914 | @@ -40,6 +40,7 @@ | |||
1915 | 40 | 40 | ||
1916 | 41 | use List::Util qw(max); | 41 | use List::Util qw(max); |
1917 | 42 | use Getopt::Long; | 42 | use Getopt::Long; |
1918 | 43 | use Data::Dumper; | ||
1919 | 43 | 44 | ||
1920 | 44 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 45 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
1921 | 45 | 46 | ||
1922 | @@ -435,11 +436,21 @@ | |||
1923 | 435 | my $long = exists $self->{opts}->{$opt} ? $opt | 436 | my $long = exists $self->{opts}->{$opt} ? $opt |
1924 | 436 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 437 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
1925 | 437 | : die "Getopt::Long gave a nonexistent option: $opt"; | 438 | : die "Getopt::Long gave a nonexistent option: $opt"; |
1926 | 438 | |||
1927 | 439 | $opt = $self->{opts}->{$long}; | 439 | $opt = $self->{opts}->{$long}; |
1928 | 440 | if ( $opt->{is_cumulative} ) { | 440 | if ( $opt->{is_cumulative} ) { |
1929 | 441 | $opt->{value}++; | 441 | $opt->{value}++; |
1930 | 442 | } | 442 | } |
1931 | 443 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
1932 | 444 | my $next_opt = $1; | ||
1933 | 445 | if ( exists $self->{opts}->{$next_opt} | ||
1934 | 446 | || exists $self->{short_opts}->{$next_opt} ) { | ||
1935 | 447 | $self->save_error("--$long requires a string value"); | ||
1936 | 448 | return; | ||
1937 | 449 | } | ||
1938 | 450 | else { | ||
1939 | 451 | $opt->{value} = $val; | ||
1940 | 452 | } | ||
1941 | 453 | } | ||
1942 | 443 | else { | 454 | else { |
1943 | 444 | $opt->{value} = $val; | 455 | $opt->{value} = $val; |
1944 | 445 | } | 456 | } |
1945 | @@ -1023,6 +1034,45 @@ | |||
1946 | 1023 | ); | 1034 | ); |
1947 | 1024 | }; | 1035 | }; |
1948 | 1025 | 1036 | ||
1949 | 1037 | sub set_vars { | ||
1950 | 1038 | my ($self, $file) = @_; | ||
1951 | 1039 | $file ||= $self->{file} || __FILE__; | ||
1952 | 1040 | |||
1953 | 1041 | my %user_vars; | ||
1954 | 1042 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
1955 | 1043 | if ( $user_vars ) { | ||
1956 | 1044 | foreach my $var_val ( @$user_vars ) { | ||
1957 | 1045 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1958 | 1046 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1959 | 1047 | $user_vars{$var} = { | ||
1960 | 1048 | val => $val, | ||
1961 | 1049 | default => 0, | ||
1962 | 1050 | }; | ||
1963 | 1051 | } | ||
1964 | 1052 | } | ||
1965 | 1053 | |||
1966 | 1054 | my %default_vars; | ||
1967 | 1055 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
1968 | 1056 | if ( $default_vars ) { | ||
1969 | 1057 | %default_vars = map { | ||
1970 | 1058 | my $var_val = $_; | ||
1971 | 1059 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
1972 | 1060 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
1973 | 1061 | $var => { | ||
1974 | 1062 | val => $val, | ||
1975 | 1063 | default => 1, | ||
1976 | 1064 | }; | ||
1977 | 1065 | } split("\n", $default_vars); | ||
1978 | 1066 | } | ||
1979 | 1067 | |||
1980 | 1068 | my %vars = ( | ||
1981 | 1069 | %default_vars, # first the tool's defaults | ||
1982 | 1070 | %user_vars, # then the user's which overwrite the defaults | ||
1983 | 1071 | ); | ||
1984 | 1072 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
1985 | 1073 | return \%vars; | ||
1986 | 1074 | } | ||
1987 | 1075 | |||
1988 | 1026 | sub _d { | 1076 | sub _d { |
1989 | 1027 | my ($package, undef, $line) = caller 0; | 1077 | my ($package, undef, $line) = caller 0; |
1990 | 1028 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1078 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
1991 | 1029 | 1079 | ||
1992 | === modified file 'bin/pt-trend' | |||
1993 | --- bin/pt-trend 2013-07-18 17:31:04 +0000 | |||
1994 | +++ bin/pt-trend 2013-08-14 00:47:54 +0000 | |||
1995 | @@ -40,6 +40,7 @@ | |||
1996 | 40 | 40 | ||
1997 | 41 | use List::Util qw(max); | 41 | use List::Util qw(max); |
1998 | 42 | use Getopt::Long; | 42 | use Getopt::Long; |
1999 | 43 | use Data::Dumper; | ||
2000 | 43 | 44 | ||
2001 | 44 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 45 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
2002 | 45 | 46 | ||
2003 | @@ -435,11 +436,21 @@ | |||
2004 | 435 | my $long = exists $self->{opts}->{$opt} ? $opt | 436 | my $long = exists $self->{opts}->{$opt} ? $opt |
2005 | 436 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 437 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
2006 | 437 | : die "Getopt::Long gave a nonexistent option: $opt"; | 438 | : die "Getopt::Long gave a nonexistent option: $opt"; |
2007 | 438 | |||
2008 | 439 | $opt = $self->{opts}->{$long}; | 439 | $opt = $self->{opts}->{$long}; |
2009 | 440 | if ( $opt->{is_cumulative} ) { | 440 | if ( $opt->{is_cumulative} ) { |
2010 | 441 | $opt->{value}++; | 441 | $opt->{value}++; |
2011 | 442 | } | 442 | } |
2012 | 443 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
2013 | 444 | my $next_opt = $1; | ||
2014 | 445 | if ( exists $self->{opts}->{$next_opt} | ||
2015 | 446 | || exists $self->{short_opts}->{$next_opt} ) { | ||
2016 | 447 | $self->save_error("--$long requires a string value"); | ||
2017 | 448 | return; | ||
2018 | 449 | } | ||
2019 | 450 | else { | ||
2020 | 451 | $opt->{value} = $val; | ||
2021 | 452 | } | ||
2022 | 453 | } | ||
2023 | 443 | else { | 454 | else { |
2024 | 444 | $opt->{value} = $val; | 455 | $opt->{value} = $val; |
2025 | 445 | } | 456 | } |
2026 | @@ -1023,6 +1034,45 @@ | |||
2027 | 1023 | ); | 1034 | ); |
2028 | 1024 | }; | 1035 | }; |
2029 | 1025 | 1036 | ||
2030 | 1037 | sub set_vars { | ||
2031 | 1038 | my ($self, $file) = @_; | ||
2032 | 1039 | $file ||= $self->{file} || __FILE__; | ||
2033 | 1040 | |||
2034 | 1041 | my %user_vars; | ||
2035 | 1042 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
2036 | 1043 | if ( $user_vars ) { | ||
2037 | 1044 | foreach my $var_val ( @$user_vars ) { | ||
2038 | 1045 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2039 | 1046 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2040 | 1047 | $user_vars{$var} = { | ||
2041 | 1048 | val => $val, | ||
2042 | 1049 | default => 0, | ||
2043 | 1050 | }; | ||
2044 | 1051 | } | ||
2045 | 1052 | } | ||
2046 | 1053 | |||
2047 | 1054 | my %default_vars; | ||
2048 | 1055 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
2049 | 1056 | if ( $default_vars ) { | ||
2050 | 1057 | %default_vars = map { | ||
2051 | 1058 | my $var_val = $_; | ||
2052 | 1059 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2053 | 1060 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2054 | 1061 | $var => { | ||
2055 | 1062 | val => $val, | ||
2056 | 1063 | default => 1, | ||
2057 | 1064 | }; | ||
2058 | 1065 | } split("\n", $default_vars); | ||
2059 | 1066 | } | ||
2060 | 1067 | |||
2061 | 1068 | my %vars = ( | ||
2062 | 1069 | %default_vars, # first the tool's defaults | ||
2063 | 1070 | %user_vars, # then the user's which overwrite the defaults | ||
2064 | 1071 | ); | ||
2065 | 1072 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
2066 | 1073 | return \%vars; | ||
2067 | 1074 | } | ||
2068 | 1075 | |||
2069 | 1026 | sub _d { | 1076 | sub _d { |
2070 | 1027 | my ($package, undef, $line) = caller 0; | 1077 | my ($package, undef, $line) = caller 0; |
2071 | 1028 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1078 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
2072 | 1029 | 1079 | ||
2073 | === modified file 'bin/pt-upgrade' | |||
2074 | --- bin/pt-upgrade 2013-07-18 17:31:04 +0000 | |||
2075 | +++ bin/pt-upgrade 2013-08-14 00:47:54 +0000 | |||
2076 | @@ -998,6 +998,7 @@ | |||
2077 | 998 | 998 | ||
2078 | 999 | use List::Util qw(max); | 999 | use List::Util qw(max); |
2079 | 1000 | use Getopt::Long; | 1000 | use Getopt::Long; |
2080 | 1001 | use Data::Dumper; | ||
2081 | 1001 | 1002 | ||
2082 | 1002 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 1003 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
2083 | 1003 | 1004 | ||
2084 | @@ -1393,11 +1394,21 @@ | |||
2085 | 1393 | my $long = exists $self->{opts}->{$opt} ? $opt | 1394 | my $long = exists $self->{opts}->{$opt} ? $opt |
2086 | 1394 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 1395 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
2087 | 1395 | : die "Getopt::Long gave a nonexistent option: $opt"; | 1396 | : die "Getopt::Long gave a nonexistent option: $opt"; |
2088 | 1396 | |||
2089 | 1397 | $opt = $self->{opts}->{$long}; | 1397 | $opt = $self->{opts}->{$long}; |
2090 | 1398 | if ( $opt->{is_cumulative} ) { | 1398 | if ( $opt->{is_cumulative} ) { |
2091 | 1399 | $opt->{value}++; | 1399 | $opt->{value}++; |
2092 | 1400 | } | 1400 | } |
2093 | 1401 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
2094 | 1402 | my $next_opt = $1; | ||
2095 | 1403 | if ( exists $self->{opts}->{$next_opt} | ||
2096 | 1404 | || exists $self->{short_opts}->{$next_opt} ) { | ||
2097 | 1405 | $self->save_error("--$long requires a string value"); | ||
2098 | 1406 | return; | ||
2099 | 1407 | } | ||
2100 | 1408 | else { | ||
2101 | 1409 | $opt->{value} = $val; | ||
2102 | 1410 | } | ||
2103 | 1411 | } | ||
2104 | 1401 | else { | 1412 | else { |
2105 | 1402 | $opt->{value} = $val; | 1413 | $opt->{value} = $val; |
2106 | 1403 | } | 1414 | } |
2107 | @@ -1981,6 +1992,45 @@ | |||
2108 | 1981 | ); | 1992 | ); |
2109 | 1982 | }; | 1993 | }; |
2110 | 1983 | 1994 | ||
2111 | 1995 | sub set_vars { | ||
2112 | 1996 | my ($self, $file) = @_; | ||
2113 | 1997 | $file ||= $self->{file} || __FILE__; | ||
2114 | 1998 | |||
2115 | 1999 | my %user_vars; | ||
2116 | 2000 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
2117 | 2001 | if ( $user_vars ) { | ||
2118 | 2002 | foreach my $var_val ( @$user_vars ) { | ||
2119 | 2003 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2120 | 2004 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2121 | 2005 | $user_vars{$var} = { | ||
2122 | 2006 | val => $val, | ||
2123 | 2007 | default => 0, | ||
2124 | 2008 | }; | ||
2125 | 2009 | } | ||
2126 | 2010 | } | ||
2127 | 2011 | |||
2128 | 2012 | my %default_vars; | ||
2129 | 2013 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
2130 | 2014 | if ( $default_vars ) { | ||
2131 | 2015 | %default_vars = map { | ||
2132 | 2016 | my $var_val = $_; | ||
2133 | 2017 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2134 | 2018 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2135 | 2019 | $var => { | ||
2136 | 2020 | val => $val, | ||
2137 | 2021 | default => 1, | ||
2138 | 2022 | }; | ||
2139 | 2023 | } split("\n", $default_vars); | ||
2140 | 2024 | } | ||
2141 | 2025 | |||
2142 | 2026 | my %vars = ( | ||
2143 | 2027 | %default_vars, # first the tool's defaults | ||
2144 | 2028 | %user_vars, # then the user's which overwrite the defaults | ||
2145 | 2029 | ); | ||
2146 | 2030 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
2147 | 2031 | return \%vars; | ||
2148 | 2032 | } | ||
2149 | 2033 | |||
2150 | 1984 | sub _d { | 2034 | sub _d { |
2151 | 1985 | my ($package, undef, $line) = caller 0; | 2035 | my ($package, undef, $line) = caller 0; |
2152 | 1986 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 2036 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
2153 | 1987 | 2037 | ||
2154 | === modified file 'bin/pt-variable-advisor' | |||
2155 | --- bin/pt-variable-advisor 2013-07-18 17:31:04 +0000 | |||
2156 | +++ bin/pt-variable-advisor 2013-08-14 00:47:54 +0000 | |||
2157 | @@ -66,6 +66,7 @@ | |||
2158 | 66 | 66 | ||
2159 | 67 | use List::Util qw(max); | 67 | use List::Util qw(max); |
2160 | 68 | use Getopt::Long; | 68 | use Getopt::Long; |
2161 | 69 | use Data::Dumper; | ||
2162 | 69 | 70 | ||
2163 | 70 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 71 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
2164 | 71 | 72 | ||
2165 | @@ -461,11 +462,21 @@ | |||
2166 | 461 | my $long = exists $self->{opts}->{$opt} ? $opt | 462 | my $long = exists $self->{opts}->{$opt} ? $opt |
2167 | 462 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 463 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
2168 | 463 | : die "Getopt::Long gave a nonexistent option: $opt"; | 464 | : die "Getopt::Long gave a nonexistent option: $opt"; |
2169 | 464 | |||
2170 | 465 | $opt = $self->{opts}->{$long}; | 465 | $opt = $self->{opts}->{$long}; |
2171 | 466 | if ( $opt->{is_cumulative} ) { | 466 | if ( $opt->{is_cumulative} ) { |
2172 | 467 | $opt->{value}++; | 467 | $opt->{value}++; |
2173 | 468 | } | 468 | } |
2174 | 469 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
2175 | 470 | my $next_opt = $1; | ||
2176 | 471 | if ( exists $self->{opts}->{$next_opt} | ||
2177 | 472 | || exists $self->{short_opts}->{$next_opt} ) { | ||
2178 | 473 | $self->save_error("--$long requires a string value"); | ||
2179 | 474 | return; | ||
2180 | 475 | } | ||
2181 | 476 | else { | ||
2182 | 477 | $opt->{value} = $val; | ||
2183 | 478 | } | ||
2184 | 479 | } | ||
2185 | 469 | else { | 480 | else { |
2186 | 470 | $opt->{value} = $val; | 481 | $opt->{value} = $val; |
2187 | 471 | } | 482 | } |
2188 | @@ -1049,6 +1060,45 @@ | |||
2189 | 1049 | ); | 1060 | ); |
2190 | 1050 | }; | 1061 | }; |
2191 | 1051 | 1062 | ||
2192 | 1063 | sub set_vars { | ||
2193 | 1064 | my ($self, $file) = @_; | ||
2194 | 1065 | $file ||= $self->{file} || __FILE__; | ||
2195 | 1066 | |||
2196 | 1067 | my %user_vars; | ||
2197 | 1068 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
2198 | 1069 | if ( $user_vars ) { | ||
2199 | 1070 | foreach my $var_val ( @$user_vars ) { | ||
2200 | 1071 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2201 | 1072 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2202 | 1073 | $user_vars{$var} = { | ||
2203 | 1074 | val => $val, | ||
2204 | 1075 | default => 0, | ||
2205 | 1076 | }; | ||
2206 | 1077 | } | ||
2207 | 1078 | } | ||
2208 | 1079 | |||
2209 | 1080 | my %default_vars; | ||
2210 | 1081 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
2211 | 1082 | if ( $default_vars ) { | ||
2212 | 1083 | %default_vars = map { | ||
2213 | 1084 | my $var_val = $_; | ||
2214 | 1085 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2215 | 1086 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2216 | 1087 | $var => { | ||
2217 | 1088 | val => $val, | ||
2218 | 1089 | default => 1, | ||
2219 | 1090 | }; | ||
2220 | 1091 | } split("\n", $default_vars); | ||
2221 | 1092 | } | ||
2222 | 1093 | |||
2223 | 1094 | my %vars = ( | ||
2224 | 1095 | %default_vars, # first the tool's defaults | ||
2225 | 1096 | %user_vars, # then the user's which overwrite the defaults | ||
2226 | 1097 | ); | ||
2227 | 1098 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
2228 | 1099 | return \%vars; | ||
2229 | 1100 | } | ||
2230 | 1101 | |||
2231 | 1052 | sub _d { | 1102 | sub _d { |
2232 | 1053 | my ($package, undef, $line) = caller 0; | 1103 | my ($package, undef, $line) = caller 0; |
2233 | 1054 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1104 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
2234 | 1055 | 1105 | ||
2235 | === modified file 'bin/pt-visual-explain' | |||
2236 | --- bin/pt-visual-explain 2013-07-18 17:31:04 +0000 | |||
2237 | +++ bin/pt-visual-explain 2013-08-14 00:47:54 +0000 | |||
2238 | @@ -711,6 +711,7 @@ | |||
2239 | 711 | 711 | ||
2240 | 712 | use List::Util qw(max); | 712 | use List::Util qw(max); |
2241 | 713 | use Getopt::Long; | 713 | use Getopt::Long; |
2242 | 714 | use Data::Dumper; | ||
2243 | 714 | 715 | ||
2244 | 715 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 716 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
2245 | 716 | 717 | ||
2246 | @@ -732,7 +733,6 @@ | |||
2247 | 732 | 'default' => 1, | 733 | 'default' => 1, |
2248 | 733 | 'cumulative' => 1, | 734 | 'cumulative' => 1, |
2249 | 734 | 'negatable' => 1, | 735 | 'negatable' => 1, |
2250 | 735 | 'value_is_optional' => 1, | ||
2251 | 736 | ); | 736 | ); |
2252 | 737 | 737 | ||
2253 | 738 | my $self = { | 738 | my $self = { |
2254 | @@ -974,10 +974,9 @@ | |||
2255 | 974 | $opt->{short} = undef; | 974 | $opt->{short} = undef; |
2256 | 975 | } | 975 | } |
2257 | 976 | 976 | ||
2262 | 977 | $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0; | 977 | $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0; |
2263 | 978 | $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0; | 978 | $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0; |
2264 | 979 | $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0; | 979 | $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0; |
2261 | 980 | $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0; | ||
2265 | 981 | 980 | ||
2266 | 982 | $opt->{group} ||= 'default'; | 981 | $opt->{group} ||= 'default'; |
2267 | 983 | $self->{groups}->{ $opt->{group} }->{$long} = 1; | 982 | $self->{groups}->{ $opt->{group} }->{$long} = 1; |
2268 | @@ -1108,12 +1107,22 @@ | |||
2269 | 1108 | my $long = exists $self->{opts}->{$opt} ? $opt | 1107 | my $long = exists $self->{opts}->{$opt} ? $opt |
2270 | 1109 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 1108 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
2271 | 1110 | : die "Getopt::Long gave a nonexistent option: $opt"; | 1109 | : die "Getopt::Long gave a nonexistent option: $opt"; |
2272 | 1111 | |||
2273 | 1112 | $opt = $self->{opts}->{$long}; | 1110 | $opt = $self->{opts}->{$long}; |
2274 | 1113 | if ( $opt->{is_cumulative} ) { | 1111 | if ( $opt->{is_cumulative} ) { |
2275 | 1114 | $opt->{value}++; | 1112 | $opt->{value}++; |
2276 | 1115 | } | 1113 | } |
2278 | 1116 | elsif ( !($opt->{optional_value} && !$val) ) { | 1114 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { |
2279 | 1115 | my $next_opt = $1; | ||
2280 | 1116 | if ( exists $self->{opts}->{$next_opt} | ||
2281 | 1117 | || exists $self->{short_opts}->{$next_opt} ) { | ||
2282 | 1118 | $self->save_error("--$long requires a string value"); | ||
2283 | 1119 | return; | ||
2284 | 1120 | } | ||
2285 | 1121 | else { | ||
2286 | 1122 | $opt->{value} = $val; | ||
2287 | 1123 | } | ||
2288 | 1124 | } | ||
2289 | 1125 | else { | ||
2290 | 1117 | $opt->{value} = $val; | 1126 | $opt->{value} = $val; |
2291 | 1118 | } | 1127 | } |
2292 | 1119 | $opt->{got} = 1; | 1128 | $opt->{got} = 1; |
2293 | @@ -1493,7 +1502,7 @@ | |||
2294 | 1493 | $desc .= ". Optional suffix s=seconds, m=minutes, h=hours, " | 1502 | $desc .= ". Optional suffix s=seconds, m=minutes, h=hours, " |
2295 | 1494 | . "d=days; if no suffix, $s is used."; | 1503 | . "d=days; if no suffix, $s is used."; |
2296 | 1495 | } | 1504 | } |
2298 | 1496 | $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol})(?:\s+|$)/g); | 1505 | $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol}(?!\W))(?:\s+|(?<=\W)|$)/g); |
2299 | 1497 | $desc =~ s/ +$//mg; | 1506 | $desc =~ s/ +$//mg; |
2300 | 1498 | if ( $short ) { | 1507 | if ( $short ) { |
2301 | 1499 | $usage .= sprintf(" --%-${maxs}s -%s %s\n", $long, $short, $desc); | 1508 | $usage .= sprintf(" --%-${maxs}s -%s %s\n", $long, $short, $desc); |
2302 | @@ -1654,12 +1663,11 @@ | |||
2303 | 1654 | sub _parse_attribs { | 1663 | sub _parse_attribs { |
2304 | 1655 | my ( $self, $option, $attribs ) = @_; | 1664 | my ( $self, $option, $attribs ) = @_; |
2305 | 1656 | my $types = $self->{types}; | 1665 | my $types = $self->{types}; |
2306 | 1657 | my $eq = $attribs->{'value_is_optional'} ? ':' : '='; | ||
2307 | 1658 | return $option | 1666 | return $option |
2308 | 1659 | . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' ) | 1667 | . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' ) |
2309 | 1660 | . ($attribs->{'negatable'} ? '!' : '' ) | 1668 | . ($attribs->{'negatable'} ? '!' : '' ) |
2310 | 1661 | . ($attribs->{'cumulative'} ? '+' : '' ) | 1669 | . ($attribs->{'cumulative'} ? '+' : '' ) |
2312 | 1662 | . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' ); | 1670 | . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' ); |
2313 | 1663 | } | 1671 | } |
2314 | 1664 | 1672 | ||
2315 | 1665 | sub _parse_synopsis { | 1673 | sub _parse_synopsis { |
2316 | @@ -1697,6 +1705,45 @@ | |||
2317 | 1697 | ); | 1705 | ); |
2318 | 1698 | }; | 1706 | }; |
2319 | 1699 | 1707 | ||
2320 | 1708 | sub set_vars { | ||
2321 | 1709 | my ($self, $file) = @_; | ||
2322 | 1710 | $file ||= $self->{file} || __FILE__; | ||
2323 | 1711 | |||
2324 | 1712 | my %user_vars; | ||
2325 | 1713 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
2326 | 1714 | if ( $user_vars ) { | ||
2327 | 1715 | foreach my $var_val ( @$user_vars ) { | ||
2328 | 1716 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2329 | 1717 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2330 | 1718 | $user_vars{$var} = { | ||
2331 | 1719 | val => $val, | ||
2332 | 1720 | default => 0, | ||
2333 | 1721 | }; | ||
2334 | 1722 | } | ||
2335 | 1723 | } | ||
2336 | 1724 | |||
2337 | 1725 | my %default_vars; | ||
2338 | 1726 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
2339 | 1727 | if ( $default_vars ) { | ||
2340 | 1728 | %default_vars = map { | ||
2341 | 1729 | my $var_val = $_; | ||
2342 | 1730 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2343 | 1731 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2344 | 1732 | $var => { | ||
2345 | 1733 | val => $val, | ||
2346 | 1734 | default => 1, | ||
2347 | 1735 | }; | ||
2348 | 1736 | } split("\n", $default_vars); | ||
2349 | 1737 | } | ||
2350 | 1738 | |||
2351 | 1739 | my %vars = ( | ||
2352 | 1740 | %default_vars, # first the tool's defaults | ||
2353 | 1741 | %user_vars, # then the user's which overwrite the defaults | ||
2354 | 1742 | ); | ||
2355 | 1743 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
2356 | 1744 | return \%vars; | ||
2357 | 1745 | } | ||
2358 | 1746 | |||
2359 | 1700 | sub _d { | 1747 | sub _d { |
2360 | 1701 | my ($package, undef, $line) = caller 0; | 1748 | my ($package, undef, $line) = caller 0; |
2361 | 1702 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1749 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
2362 | 1703 | 1750 | ||
2363 | === modified file 'lib/OptionParser.pm' | |||
2364 | --- lib/OptionParser.pm 2013-01-03 00:19:16 +0000 | |||
2365 | +++ lib/OptionParser.pm 2013-08-14 00:47:54 +0000 | |||
2366 | @@ -18,45 +18,6 @@ | |||
2367 | 18 | # OptionParser package | 18 | # OptionParser package |
2368 | 19 | # ########################################################################### | 19 | # ########################################################################### |
2369 | 20 | { | 20 | { |
2370 | 21 | # Package: OptionParser | ||
2371 | 22 | # OptionParser parses command line options from a tool's POD. By default | ||
2372 | 23 | # it parses a description and usage from the POD's SYNOPSIS section and | ||
2373 | 24 | # command line options from the OPTIONS section. | ||
2374 | 25 | # | ||
2375 | 26 | # The SYNOPSIS section should look like, | ||
2376 | 27 | # (start code) | ||
2377 | 28 | # =head1 SYNOPSIS | ||
2378 | 29 | # | ||
2379 | 30 | # Usage: mk-archiver [OPTION...] --source DSN --where WHERE | ||
2380 | 31 | # | ||
2381 | 32 | # mk-archiver nibbles records from a MySQL table. The --source and --dest | ||
2382 | 33 | # arguments use DSN syntax; if COPY is yes, --dest defaults to the key's value | ||
2383 | 34 | # from --source. | ||
2384 | 35 | # | ||
2385 | 36 | # Examples: | ||
2386 | 37 | # ... | ||
2387 | 38 | # (end code) | ||
2388 | 39 | # The key, required parts are the "Usage:" line and the following description | ||
2389 | 40 | # paragraph. | ||
2390 | 41 | # | ||
2391 | 42 | # The OPTIONS section shoud look like, | ||
2392 | 43 | # (start code) | ||
2393 | 44 | # =head1 OPTIONS | ||
2394 | 45 | # | ||
2395 | 46 | # Optional rules, one per line. | ||
2396 | 47 | # | ||
2397 | 48 | # =over | ||
2398 | 49 | # | ||
2399 | 50 | # =item --analyze | ||
2400 | 51 | # | ||
2401 | 52 | # type: string | ||
2402 | 53 | # | ||
2403 | 54 | # Run ANALYZE TABLE afterwards on L<"--source"> and/or L<"--dest">. | ||
2404 | 55 | # ect. | ||
2405 | 56 | # (end code) | ||
2406 | 57 | # The option's full name is given as the "=item". The next, optional para | ||
2407 | 58 | # is the option's attributes. And the next, required para is the option's | ||
2408 | 59 | # description (the first period-terminated sentence). | ||
2409 | 60 | package OptionParser; | 21 | package OptionParser; |
2410 | 61 | 22 | ||
2411 | 62 | use strict; | 23 | use strict; |
2412 | @@ -66,6 +27,7 @@ | |||
2413 | 66 | 27 | ||
2414 | 67 | use List::Util qw(max); | 28 | use List::Util qw(max); |
2415 | 68 | use Getopt::Long; | 29 | use Getopt::Long; |
2416 | 30 | use Data::Dumper; | ||
2417 | 69 | 31 | ||
2418 | 70 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | 32 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; |
2419 | 71 | 33 | ||
2420 | @@ -592,12 +554,23 @@ | |||
2421 | 592 | my $long = exists $self->{opts}->{$opt} ? $opt | 554 | my $long = exists $self->{opts}->{$opt} ? $opt |
2422 | 593 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} | 555 | : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} |
2423 | 594 | : die "Getopt::Long gave a nonexistent option: $opt"; | 556 | : die "Getopt::Long gave a nonexistent option: $opt"; |
2424 | 595 | |||
2425 | 596 | # Reassign $opt. | 557 | # Reassign $opt. |
2426 | 597 | $opt = $self->{opts}->{$long}; | 558 | $opt = $self->{opts}->{$long}; |
2427 | 598 | if ( $opt->{is_cumulative} ) { | 559 | if ( $opt->{is_cumulative} ) { |
2428 | 599 | $opt->{value}++; | 560 | $opt->{value}++; |
2429 | 600 | } | 561 | } |
2430 | 562 | elsif ( ($opt->{type} || '') eq 's' && $val =~ m/^--?(.+)/ ) { | ||
2431 | 563 | # https://bugs.launchpad.net/percona-toolkit/+bug/1199589 | ||
2432 | 564 | my $next_opt = $1; | ||
2433 | 565 | if ( exists $self->{opts}->{$next_opt} | ||
2434 | 566 | || exists $self->{short_opts}->{$next_opt} ) { | ||
2435 | 567 | $self->save_error("--$long requires a string value"); | ||
2436 | 568 | return; | ||
2437 | 569 | } | ||
2438 | 570 | else { | ||
2439 | 571 | $opt->{value} = $val; | ||
2440 | 572 | } | ||
2441 | 573 | } | ||
2442 | 601 | else { | 574 | else { |
2443 | 602 | $opt->{value} = $val; | 575 | $opt->{value} = $val; |
2444 | 603 | } | 576 | } |
2445 | @@ -1318,6 +1291,45 @@ | |||
2446 | 1318 | ); | 1291 | ); |
2447 | 1319 | }; | 1292 | }; |
2448 | 1320 | 1293 | ||
2449 | 1294 | sub set_vars { | ||
2450 | 1295 | my ($self, $file) = @_; | ||
2451 | 1296 | $file ||= $self->{file} || __FILE__; | ||
2452 | 1297 | |||
2453 | 1298 | my %user_vars; | ||
2454 | 1299 | my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; | ||
2455 | 1300 | if ( $user_vars ) { | ||
2456 | 1301 | foreach my $var_val ( @$user_vars ) { | ||
2457 | 1302 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2458 | 1303 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2459 | 1304 | $user_vars{$var} = { | ||
2460 | 1305 | val => $val, | ||
2461 | 1306 | default => 0, | ||
2462 | 1307 | }; | ||
2463 | 1308 | } | ||
2464 | 1309 | } | ||
2465 | 1310 | |||
2466 | 1311 | my %default_vars; | ||
2467 | 1312 | my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); | ||
2468 | 1313 | if ( $default_vars ) { | ||
2469 | 1314 | %default_vars = map { | ||
2470 | 1315 | my $var_val = $_; | ||
2471 | 1316 | my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; | ||
2472 | 1317 | die "Invalid --set-vars value: $var_val\n" unless $var && defined $val; | ||
2473 | 1318 | $var => { | ||
2474 | 1319 | val => $val, | ||
2475 | 1320 | default => 1, | ||
2476 | 1321 | }; | ||
2477 | 1322 | } split("\n", $default_vars); | ||
2478 | 1323 | } | ||
2479 | 1324 | |||
2480 | 1325 | my %vars = ( | ||
2481 | 1326 | %default_vars, # first the tool's defaults | ||
2482 | 1327 | %user_vars, # then the user's which overwrite the defaults | ||
2483 | 1328 | ); | ||
2484 | 1329 | PTDEBUG && _d('--set-vars:', Dumper(\%vars)); | ||
2485 | 1330 | return \%vars; | ||
2486 | 1331 | } | ||
2487 | 1332 | |||
2488 | 1321 | sub _d { | 1333 | sub _d { |
2489 | 1322 | my ($package, undef, $line) = caller 0; | 1334 | my ($package, undef, $line) = caller 0; |
2490 | 1323 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1335 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
2491 | 1324 | 1336 | ||
2492 | === modified file 't/lib/OptionParser.t' | |||
2493 | --- t/lib/OptionParser.t 2012-11-09 16:31:13 +0000 | |||
2494 | +++ t/lib/OptionParser.t 2013-08-14 00:47:54 +0000 | |||
2495 | @@ -2022,6 +2022,59 @@ | |||
2496 | 2022 | ); | 2022 | ); |
2497 | 2023 | 2023 | ||
2498 | 2024 | # ############################################################################# | 2024 | # ############################################################################# |
2499 | 2025 | # https://bugs.launchpad.net/percona-toolkit/+bug/1199589 | ||
2500 | 2026 | # pt-archiver deletes data despite --dry-run | ||
2501 | 2027 | # ############################################################################# | ||
2502 | 2028 | |||
2503 | 2029 | # From the issue: "One problem is that --optimize is not being used correctly: | ||
2504 | 2030 | # the option takes an argument: d, s, or ds (see --analyze). The real problem | ||
2505 | 2031 | # is that --optimize is consuming the next option, which is --dry-run in this | ||
2506 | 2032 | # case. This shouldn't happen; it means the option parser is failing to notice | ||
2507 | 2033 | # that --dry-run is not the string val to --optimize but rather an option; | ||
2508 | 2034 | # it should catch this and the tool should fail to start with an error like | ||
2509 | 2035 | # "--optimize requires a value". | ||
2510 | 2036 | |||
2511 | 2037 | @ARGV = qw(--optimize --dry-run --ascend-first --where 1=1 --purge --source localhost); | ||
2512 | 2038 | $o = new OptionParser(file => "$trunk/bin/pt-archiver"); | ||
2513 | 2039 | $o->get_specs(); | ||
2514 | 2040 | $o->get_opts(); | ||
2515 | 2041 | |||
2516 | 2042 | $output = output( | ||
2517 | 2043 | sub { $o->usage_or_errors(undef, 1); }, | ||
2518 | 2044 | ); | ||
2519 | 2045 | |||
2520 | 2046 | like( | ||
2521 | 2047 | $output, | ||
2522 | 2048 | qr/--optimize requires a string value/, | ||
2523 | 2049 | "String opts don't consume the next opt (bug 1199589)" | ||
2524 | 2050 | ); | ||
2525 | 2051 | |||
2526 | 2052 | is( | ||
2527 | 2053 | $o->get('optimize'), | ||
2528 | 2054 | undef, | ||
2529 | 2055 | "--optimize didn't consume --dry-run (bug 1199589)" | ||
2530 | 2056 | ); | ||
2531 | 2057 | |||
2532 | 2058 | @ARGV = qw(--optimize ds --dry-run --ascend-first --where 1=1 --purge --source localhost); | ||
2533 | 2059 | $o->get_opts(); | ||
2534 | 2060 | |||
2535 | 2061 | $output = output( | ||
2536 | 2062 | sub { $o->usage_or_errors(undef, 1); }, | ||
2537 | 2063 | ); | ||
2538 | 2064 | |||
2539 | 2065 | is( | ||
2540 | 2066 | $output, | ||
2541 | 2067 | '', | ||
2542 | 2068 | "String opts still work (bug 1199589)" | ||
2543 | 2069 | ); | ||
2544 | 2070 | |||
2545 | 2071 | is( | ||
2546 | 2072 | $o->get('optimize'), | ||
2547 | 2073 | 'ds', | ||
2548 | 2074 | "--optimize got its value (bug 1199589)" | ||
2549 | 2075 | ); | ||
2550 | 2076 | |||
2551 | 2077 | # ############################################################################# | ||
2552 | 2025 | # Done. | 2078 | # Done. |
2553 | 2026 | # ############################################################################# | 2079 | # ############################################################################# |
2554 | 2027 | { | 2080 | { |
2555 | 2028 | 2081 | ||
2556 | === added file 't/pt-archiver/bugs.t' | |||
2557 | --- t/pt-archiver/bugs.t 1970-01-01 00:00:00 +0000 | |||
2558 | +++ t/pt-archiver/bugs.t 2013-08-14 00:47:54 +0000 | |||
2559 | @@ -0,0 +1,56 @@ | |||
2560 | 1 | #!/usr/bin/env perl | ||
2561 | 2 | |||
2562 | 3 | BEGIN { | ||
2563 | 4 | die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" | ||
2564 | 5 | unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; | ||
2565 | 6 | unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; | ||
2566 | 7 | }; | ||
2567 | 8 | |||
2568 | 9 | use strict; | ||
2569 | 10 | use warnings FATAL => 'all'; | ||
2570 | 11 | use English qw(-no_match_vars); | ||
2571 | 12 | use Test::More; | ||
2572 | 13 | use Data::Dumper; | ||
2573 | 14 | |||
2574 | 15 | use PerconaTest; | ||
2575 | 16 | use Sandbox; | ||
2576 | 17 | require "$trunk/bin/pt-archiver"; | ||
2577 | 18 | |||
2578 | 19 | my $dp = new DSNParser(opts=>$dsn_opts); | ||
2579 | 20 | my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp); | ||
2580 | 21 | my $master_dbh = $sb->get_dbh_for('master'); | ||
2581 | 22 | |||
2582 | 23 | if ( !$master_dbh ) { | ||
2583 | 24 | plan skip_all => 'Cannot connect to sandbox master'; | ||
2584 | 25 | } | ||
2585 | 26 | |||
2586 | 27 | my $output; | ||
2587 | 28 | my $cnf = "/tmp/12345/my.sandbox.cnf"; | ||
2588 | 29 | my $cmd = "$trunk/bin/pt-archiver"; | ||
2589 | 30 | |||
2590 | 31 | $sb->create_dbs($master_dbh, ['test']); | ||
2591 | 32 | $sb->load_file('master', 't/pt-archiver/samples/tables1-4.sql'); | ||
2592 | 33 | |||
2593 | 34 | # ########################################################################### | ||
2594 | 35 | # pt-archiver deletes data despite --dry-run | ||
2595 | 36 | # https://bugs.launchpad.net/percona-toolkit/+bug/1199589 | ||
2596 | 37 | # ########################################################################### | ||
2597 | 38 | |||
2598 | 39 | my $rows_before = $master_dbh->selectall_arrayref("SELECT * FROM test.table_1 ORDER BY a"); | ||
2599 | 40 | |||
2600 | 41 | $output = `$cmd --optimize --dry-run --purge --where 1=1 --source D=test,t=table_1,F=$cnf 2>&1`; | ||
2601 | 42 | |||
2602 | 43 | my $rows_after = $master_dbh->selectall_arrayref("SELECT * FROM test.table_1 ORDER BY a"); | ||
2603 | 44 | |||
2604 | 45 | is_deeply( | ||
2605 | 46 | $rows_after, | ||
2606 | 47 | $rows_before, | ||
2607 | 48 | "--optimize does not consume --dry-run (bug 1199589)" | ||
2608 | 49 | ) or diag(Dumper($rows_after)); | ||
2609 | 50 | |||
2610 | 51 | # ############################################################################# | ||
2611 | 52 | # Done. | ||
2612 | 53 | # ############################################################################# | ||
2613 | 54 | $sb->wipe_clean($master_dbh); | ||
2614 | 55 | ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox"); | ||
2615 | 56 | done_testing; |