| 2 |
rodolico |
1 |
#!/usr/bin/env perl
|
|
|
2 |
|
|
|
3 |
# Simplified BSD License (FreeBSD License)
|
|
|
4 |
#
|
|
|
5 |
# Copyright (c) 2026, Daily Data Inc.
|
|
|
6 |
# All rights reserved.
|
|
|
7 |
#
|
|
|
8 |
# Redistribution and use in source and binary forms, with or without
|
|
|
9 |
# modification, are permitted provided that the following conditions are met:
|
|
|
10 |
#
|
|
|
11 |
# 1. Redistributions of source code must retain the above copyright notice, this
|
|
|
12 |
# list of conditions and the following disclaimer.
|
|
|
13 |
#
|
|
|
14 |
# 2. Redistributions in binary form must reproduce the above copyright notice,
|
|
|
15 |
# this list of conditions and the following disclaimer in the documentation
|
|
|
16 |
# and/or other materials provided with the distribution.
|
|
|
17 |
#
|
|
|
18 |
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
|
|
19 |
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
|
20 |
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
|
|
21 |
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
|
|
22 |
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
|
23 |
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
|
|
24 |
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
|
|
25 |
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
|
|
26 |
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
|
27 |
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
28 |
|
|
|
29 |
# perlConfigFileUtility
|
|
|
30 |
# Utility to merge template configuration structures with existing config files,
|
|
|
31 |
# edit configurations interactively, and convert between YAML and JSON formats.
|
|
|
32 |
# Supports reading Perl data structures as templates and YAML/JSON as config files.
|
|
|
33 |
# Provides interactive hierarchical editor for modifying configuration values.
|
|
|
34 |
# Can add new keys to hashes and elements to arrays dynamically.
|
|
|
35 |
# Automatically backs up config files when saving changes.
|
|
|
36 |
#
|
|
|
37 |
# Author: R. W. Rodolico <rodo@dailydata.net>
|
|
|
38 |
# Created: January 2026
|
|
|
39 |
#
|
|
|
40 |
# Revision History:
|
| 6 |
rodolico |
41 |
# Version: 1.2.0 RWR 2026-01-18
|
|
|
42 |
# Added ability to load multiple config files and compare their values
|
|
|
43 |
# Added ability to rename hash keys in interactive edit mode
|
|
|
44 |
# Refactored long functions for improved readability and maintainability
|
|
|
45 |
#
|
| 2 |
rodolico |
46 |
# Version: 1.1.0 RWR 2026-01-15
|
|
|
47 |
# Added ability to delete keys from hashes and elements from arrays
|
| 6 |
rodolico |
48 |
#
|
| 2 |
rodolico |
49 |
# Version: 1.0 RWR 2026-01-13
|
|
|
50 |
# Initial release with merge, edit, and format conversion capabilities
|
|
|
51 |
|
|
|
52 |
use strict;
|
|
|
53 |
use warnings;
|
|
|
54 |
use File::Slurp qw(read_file);
|
|
|
55 |
use Data::Dumper;
|
|
|
56 |
use Getopt::Long qw(GetOptions);
|
|
|
57 |
Getopt::Long::Configure("bundling");
|
|
|
58 |
|
| 6 |
rodolico |
59 |
our $VERSION = '1.2.0';
|
| 2 |
rodolico |
60 |
|
|
|
61 |
# ============================================================================
|
|
|
62 |
# FUNCTIONS
|
|
|
63 |
# ============================================================================
|
|
|
64 |
|
|
|
65 |
## Get a display tag showing the type and value of a data structure element.
|
|
|
66 |
## Returns formatted string indicating if value is a hash, array, or scalar.
|
|
|
67 |
##
|
|
|
68 |
## Arguments:
|
|
|
69 |
## $value - The value to analyze
|
|
|
70 |
##
|
|
|
71 |
## Returns:
|
|
|
72 |
## String: '[HASH]' for hashrefs, '[ARRAY]' for arrayrefs,
|
|
|
73 |
## 'value' for defined scalars, '<undef>' for undefined
|
|
|
74 |
sub getTypeTag {
|
|
|
75 |
my ($value) = @_;
|
|
|
76 |
my $ref = ref($value);
|
|
|
77 |
return '[HASH]' if $ref eq 'HASH';
|
|
|
78 |
return '[ARRAY]' if $ref eq 'ARRAY';
|
|
|
79 |
return defined($value) ? "'$value'" : '<undef>';
|
|
|
80 |
}
|
|
|
81 |
|
|
|
82 |
## Display sorted hash keys with index numbers and type tags.
|
|
|
83 |
## Shows each key with its value type for user selection in interactive mode.
|
|
|
84 |
##
|
|
|
85 |
## Arguments:
|
|
|
86 |
## $hash - Hashref to display
|
|
|
87 |
## $path - String path to current location in data structure
|
|
|
88 |
##
|
|
|
89 |
## Returns:
|
|
|
90 |
## Array of sorted key names
|
|
|
91 |
sub displayHashKeys {
|
|
|
92 |
my ($hash, $path) = @_;
|
|
|
93 |
$path //= 'root';
|
|
|
94 |
|
|
|
95 |
print "\n" . "=" x 70 . "\n";
|
|
|
96 |
print "Editing: $path\n";
|
|
|
97 |
print "=" x 70 . "\n";
|
|
|
98 |
|
|
|
99 |
my @keys = sort keys %$hash;
|
|
|
100 |
|
|
|
101 |
if (@keys == 0) {
|
|
|
102 |
print " (empty hash)\n";
|
|
|
103 |
return ();
|
|
|
104 |
}
|
|
|
105 |
|
|
|
106 |
for my $i (0 .. $#keys) {
|
|
|
107 |
my $key = $keys[$i];
|
|
|
108 |
my $typeTag = getTypeTag($hash->{$key});
|
|
|
109 |
printf " %2d) %-30s %s\n", $i + 1, $key, $typeTag;
|
|
|
110 |
}
|
|
|
111 |
|
|
|
112 |
return @keys;
|
|
|
113 |
}
|
|
|
114 |
|
|
|
115 |
## Display array elements with index numbers and type tags.
|
|
|
116 |
## Shows each element's index and value type for user selection.
|
|
|
117 |
##
|
|
|
118 |
## Arguments:
|
|
|
119 |
## $array - Arrayref to display
|
|
|
120 |
## $path - String path to current location in data structure
|
|
|
121 |
##
|
|
|
122 |
## Returns:
|
|
|
123 |
## Nothing (void)
|
|
|
124 |
sub displayArrayElements {
|
|
|
125 |
my ($array, $path) = @_;
|
|
|
126 |
$path //= 'root';
|
|
|
127 |
|
|
|
128 |
print "\n" . "=" x 70 . "\n";
|
|
|
129 |
print "Editing array: $path\n";
|
|
|
130 |
print "=" x 70 . "\n";
|
|
|
131 |
|
|
|
132 |
if (@$array == 0) {
|
|
|
133 |
print " (empty array)\n";
|
|
|
134 |
return;
|
|
|
135 |
}
|
|
|
136 |
|
|
|
137 |
for my $i (0 .. $#$array) {
|
|
|
138 |
my $typeTag = getTypeTag($array->[$i]);
|
|
|
139 |
printf " %2d) [%d] %s\n", $i + 1, $i, $typeTag;
|
|
|
140 |
}
|
|
|
141 |
}
|
|
|
142 |
|
|
|
143 |
## Get and validate user's menu choice.
|
| 6 |
rodolico |
144 |
## Accepts numeric selection, back/quit commands, and optional add/delete/rename commands.
|
| 2 |
rodolico |
145 |
##
|
|
|
146 |
## Arguments:
|
|
|
147 |
## $prompt - String prompt to display
|
|
|
148 |
## $max - Integer maximum valid selection
|
|
|
149 |
## $allow_add - Boolean whether to allow 'add' command
|
|
|
150 |
## $allow_delete - Boolean whether to allow 'delete' command
|
| 6 |
rodolico |
151 |
## $allow_rename - Boolean whether to allow 'rename' command
|
| 2 |
rodolico |
152 |
##
|
|
|
153 |
## Returns:
|
| 6 |
rodolico |
154 |
## Integer (0-based index), 'quit', 'back', 'add', 'delete', 'rename', or undef for invalid input
|
| 2 |
rodolico |
155 |
sub getUserChoice {
|
| 6 |
rodolico |
156 |
my ($prompt, $max, $allowAdd, $allowDelete, $allowRename) = @_;
|
| 2 |
rodolico |
157 |
|
|
|
158 |
my $options = "1-$max, 0=back";
|
|
|
159 |
$options .= ", a=add new" if $allowAdd;
|
|
|
160 |
$options .= ", d=delete" if $allowDelete;
|
| 6 |
rodolico |
161 |
$options .= ", r=rename" if $allowRename;
|
| 2 |
rodolico |
162 |
$options .= ", q=quit";
|
|
|
163 |
|
|
|
164 |
print "\n$prompt ($options): ";
|
|
|
165 |
my $input = <STDIN>;
|
|
|
166 |
chomp $input;
|
|
|
167 |
|
|
|
168 |
return 'quit' if $input =~ /^q/i;
|
|
|
169 |
return 'back' if $input eq '0' || $input eq '';
|
|
|
170 |
return 'add' if $allowAdd && $input =~ /^a/i;
|
|
|
171 |
return 'delete' if $allowDelete && $input =~ /^d/i;
|
| 6 |
rodolico |
172 |
return 'rename' if $allowRename && $input =~ /^r/i;
|
| 2 |
rodolico |
173 |
|
|
|
174 |
if ($input =~ /^\d+$/ && $input >= 1 && $input <= $max) {
|
|
|
175 |
return $input - 1; # Convert to 0-based index
|
|
|
176 |
}
|
|
|
177 |
|
|
|
178 |
print "Invalid choice. Please enter a valid option.\n";
|
|
|
179 |
return undef;
|
|
|
180 |
}
|
|
|
181 |
|
|
|
182 |
## Prompt user to select type for a new value.
|
|
|
183 |
## Displays menu of scalar, hash, or array options.
|
|
|
184 |
##
|
|
|
185 |
## Arguments:
|
|
|
186 |
## None
|
|
|
187 |
##
|
|
|
188 |
## Returns:
|
|
|
189 |
## String: 'scalar', 'hash', or 'array'
|
|
|
190 |
sub getValueType {
|
|
|
191 |
print "\nSelect value type:\n";
|
|
|
192 |
print " 1) Scalar (string/number)\n";
|
|
|
193 |
print " 2) Hash (key-value pairs)\n";
|
|
|
194 |
print " 3) Array (list of items)\n";
|
|
|
195 |
print "Enter choice (1-3): ";
|
|
|
196 |
|
|
|
197 |
my $input = <STDIN>;
|
|
|
198 |
chomp $input;
|
|
|
199 |
|
|
|
200 |
return 'scalar' if $input eq '1';
|
|
|
201 |
return 'hash' if $input eq '2';
|
|
|
202 |
return 'array' if $input eq '3';
|
|
|
203 |
|
|
|
204 |
print "Invalid choice. Defaulting to scalar.\n";
|
|
|
205 |
return 'scalar';
|
|
|
206 |
}
|
|
|
207 |
|
|
|
208 |
## Create a new value of the specified type.
|
|
|
209 |
## For scalars, prompts for input. For hashes/arrays, returns empty structure.
|
|
|
210 |
##
|
|
|
211 |
## Arguments:
|
|
|
212 |
## $type - String: 'scalar', 'hash', or 'array'
|
|
|
213 |
##
|
|
|
214 |
## Returns:
|
|
|
215 |
## New value: hashref ({}), arrayref ([]), or user-entered string
|
|
|
216 |
sub createNewValue {
|
|
|
217 |
my ($type) = @_;
|
|
|
218 |
|
|
|
219 |
if ($type eq 'hash') {
|
|
|
220 |
return {};
|
|
|
221 |
} elsif ($type eq 'array') {
|
|
|
222 |
return [];
|
|
|
223 |
} else {
|
|
|
224 |
print "Enter value: ";
|
|
|
225 |
my $value = <STDIN>;
|
|
|
226 |
chomp $value;
|
|
|
227 |
return $value;
|
|
|
228 |
}
|
|
|
229 |
}
|
|
|
230 |
|
|
|
231 |
## Edit a scalar value interactively.
|
|
|
232 |
## Displays current value and prompts for new value.
|
|
|
233 |
##
|
|
|
234 |
## Arguments:
|
|
|
235 |
## $value - Current scalar value
|
|
|
236 |
## $key - Key name in parent structure
|
|
|
237 |
## $path - String path to current location
|
|
|
238 |
##
|
|
|
239 |
## Returns:
|
|
|
240 |
## New value (original if user pressed Enter without input)
|
|
|
241 |
sub editScalar {
|
|
|
242 |
my ($value, $key, $path) = @_;
|
|
|
243 |
|
|
|
244 |
print "\n" . "-" x 70 . "\n";
|
|
|
245 |
print "Editing: $path.$key\n";
|
|
|
246 |
print "Current value: " . (defined($value) ? "'$value'" : '<undef>') . "\n";
|
|
|
247 |
print "Enter new value (or press Enter to keep current): ";
|
|
|
248 |
|
|
|
249 |
my $input = <STDIN>;
|
|
|
250 |
chomp $input;
|
|
|
251 |
|
|
|
252 |
if ($input ne '') {
|
|
|
253 |
print "Value updated.\n";
|
|
|
254 |
return $input;
|
|
|
255 |
}
|
|
|
256 |
|
|
|
257 |
return $value;
|
|
|
258 |
}
|
|
|
259 |
|
| 6 |
rodolico |
260 |
## Handle renaming a key in a hash.
|
|
|
261 |
##
|
|
|
262 |
## Arguments:
|
|
|
263 |
## $hash - Hashref to rename key in
|
|
|
264 |
## $keys - Arrayref of key names
|
|
|
265 |
##
|
|
|
266 |
## Returns:
|
|
|
267 |
## Nothing (modifies $hash in place)
|
|
|
268 |
sub handleHashKeyRename {
|
|
|
269 |
my ($hash, $keys) = @_;
|
|
|
270 |
|
|
|
271 |
return if @$keys == 0; # Empty hash, nothing to rename
|
|
|
272 |
|
|
|
273 |
print "\nSelect key to rename (1-" . scalar(@$keys) . ", 0=cancel): ";
|
|
|
274 |
my $renameInput = <STDIN>;
|
|
|
275 |
chomp $renameInput;
|
|
|
276 |
|
|
|
277 |
if ($renameInput eq '0' || $renameInput eq '') {
|
|
|
278 |
print "Rename cancelled.\n";
|
|
|
279 |
return;
|
|
|
280 |
}
|
|
|
281 |
|
|
|
282 |
if ($renameInput =~ /^\d+$/ && $renameInput >= 1 && $renameInput <= scalar(@$keys)) {
|
|
|
283 |
my $oldKey = $keys->[$renameInput - 1];
|
|
|
284 |
print "Current key name: '$oldKey'\n";
|
|
|
285 |
print "Enter new key name: ";
|
|
|
286 |
my $newKey = <STDIN>;
|
|
|
287 |
chomp $newKey;
|
|
|
288 |
|
|
|
289 |
if ($newKey eq '') {
|
|
|
290 |
print "Rename cancelled (empty key name).\n";
|
|
|
291 |
return;
|
|
|
292 |
}
|
|
|
293 |
|
|
|
294 |
if ($newKey eq $oldKey) {
|
|
|
295 |
print "New key name is the same as old key name.\n";
|
|
|
296 |
return;
|
|
|
297 |
}
|
|
|
298 |
|
|
|
299 |
if (exists $hash->{$newKey}) {
|
|
|
300 |
print "Key '$newKey' already exists. Rename cancelled.\n";
|
|
|
301 |
return;
|
|
|
302 |
}
|
|
|
303 |
|
|
|
304 |
# Rename by copying value to new key and deleting old key
|
|
|
305 |
$hash->{$newKey} = $hash->{$oldKey};
|
|
|
306 |
delete $hash->{$oldKey};
|
|
|
307 |
print "Key renamed from '$oldKey' to '$newKey'.\n";
|
|
|
308 |
} else {
|
|
|
309 |
print "Invalid selection.\n";
|
|
|
310 |
}
|
|
|
311 |
}
|
|
|
312 |
|
|
|
313 |
## Handle deletion of a key from a hash.
|
|
|
314 |
##
|
|
|
315 |
## Arguments:
|
|
|
316 |
## $hash - Hashref to delete from
|
|
|
317 |
## $keys - Arrayref of key names
|
|
|
318 |
##
|
|
|
319 |
## Returns:
|
|
|
320 |
## Nothing (modifies $hash in place)
|
|
|
321 |
sub handleHashKeyDeletion {
|
|
|
322 |
my ($hash, $keys) = @_;
|
|
|
323 |
|
|
|
324 |
return if @$keys == 0; # Empty hash, nothing to delete
|
|
|
325 |
|
|
|
326 |
print "\nSelect key to delete (1-" . scalar(@$keys) . ", 0=cancel): ";
|
|
|
327 |
my $delInput = <STDIN>;
|
|
|
328 |
chomp $delInput;
|
|
|
329 |
|
|
|
330 |
if ($delInput eq '0' || $delInput eq '') {
|
|
|
331 |
print "Delete cancelled.\n";
|
|
|
332 |
return;
|
|
|
333 |
}
|
|
|
334 |
|
|
|
335 |
if ($delInput =~ /^\d+$/ && $delInput >= 1 && $delInput <= scalar(@$keys)) {
|
|
|
336 |
my $keyToDelete = $keys->[$delInput - 1];
|
|
|
337 |
print "Delete key '$keyToDelete' and all its children? (y/n): ";
|
|
|
338 |
my $confirm = <STDIN>;
|
|
|
339 |
chomp $confirm;
|
|
|
340 |
|
|
|
341 |
if ($confirm =~ /^y/i) {
|
|
|
342 |
delete $hash->{$keyToDelete};
|
|
|
343 |
print "Key '$keyToDelete' deleted.\n";
|
|
|
344 |
} else {
|
|
|
345 |
print "Delete cancelled.\n";
|
|
|
346 |
}
|
|
|
347 |
} else {
|
|
|
348 |
print "Invalid selection.\n";
|
|
|
349 |
}
|
|
|
350 |
}
|
|
|
351 |
|
|
|
352 |
## Handle adding a new key to a hash.
|
|
|
353 |
##
|
|
|
354 |
## Arguments:
|
|
|
355 |
## $hash - Hashref to add to
|
|
|
356 |
## $path - Current path string
|
|
|
357 |
##
|
|
|
358 |
## Returns:
|
|
|
359 |
## Nothing (modifies $hash in place)
|
|
|
360 |
sub handleHashKeyAddition {
|
|
|
361 |
my ($hash, $path) = @_;
|
|
|
362 |
|
|
|
363 |
print "\nEnter new key name: ";
|
|
|
364 |
my $newKey = <STDIN>;
|
|
|
365 |
chomp $newKey;
|
|
|
366 |
|
|
|
367 |
if ($newKey eq '') {
|
|
|
368 |
print "Invalid key name.\n";
|
|
|
369 |
return;
|
|
|
370 |
}
|
|
|
371 |
|
|
|
372 |
if (exists $hash->{$newKey}) {
|
|
|
373 |
print "Key '$newKey' already exists.\n";
|
|
|
374 |
return;
|
|
|
375 |
}
|
|
|
376 |
|
|
|
377 |
my $valueType = getValueType();
|
|
|
378 |
my $newValue = createNewValue($valueType);
|
|
|
379 |
$hash->{$newKey} = $newValue;
|
|
|
380 |
print "Key '$newKey' added.\n";
|
|
|
381 |
|
|
|
382 |
# If it's a hash or array, allow immediate editing
|
|
|
383 |
if ($valueType eq 'hash' || $valueType eq 'array') {
|
|
|
384 |
my $newPath = $path eq 'root' ? $newKey : "$path.$newKey";
|
|
|
385 |
if ($valueType eq 'hash') {
|
|
|
386 |
editHash($newValue, $newPath);
|
|
|
387 |
} else {
|
|
|
388 |
editArray($newValue, $newPath);
|
|
|
389 |
}
|
|
|
390 |
}
|
|
|
391 |
}
|
|
|
392 |
|
| 2 |
rodolico |
393 |
## Interactively edit a hash structure.
|
|
|
394 |
## Displays keys, allows selection and editing of values, supports adding and deleting keys.
|
|
|
395 |
## Recursively calls itself for nested hashes and edit_array for arrays.
|
|
|
396 |
##
|
|
|
397 |
## Arguments:
|
|
|
398 |
## $hash - Hashref to edit
|
|
|
399 |
## $path - String path to current location (default 'root')
|
|
|
400 |
##
|
|
|
401 |
## Returns:
|
|
|
402 |
## Nothing (modifies $hash in place)
|
|
|
403 |
sub editHash {
|
|
|
404 |
my ($hash, $path) = @_;
|
|
|
405 |
$path //= 'root';
|
|
|
406 |
|
|
|
407 |
while (1) {
|
|
|
408 |
my @keys = displayHashKeys($hash, $path);
|
|
|
409 |
|
| 6 |
rodolico |
410 |
my $choice = getUserChoice("Select key to edit", scalar(@keys) || 1, 1, scalar(@keys) > 0, scalar(@keys) > 0);
|
| 2 |
rodolico |
411 |
|
|
|
412 |
return if !defined $choice;
|
|
|
413 |
return if $choice eq 'back';
|
|
|
414 |
exit 0 if $choice eq 'quit';
|
|
|
415 |
|
|
|
416 |
if ($choice eq 'add') {
|
| 6 |
rodolico |
417 |
handleHashKeyAddition($hash, $path);
|
| 2 |
rodolico |
418 |
next;
|
|
|
419 |
}
|
|
|
420 |
|
|
|
421 |
if ($choice eq 'delete') {
|
| 6 |
rodolico |
422 |
handleHashKeyDeletion($hash, \@keys);
|
| 2 |
rodolico |
423 |
next;
|
|
|
424 |
}
|
|
|
425 |
|
| 6 |
rodolico |
426 |
if ($choice eq 'rename') {
|
|
|
427 |
handleHashKeyRename($hash, \@keys);
|
|
|
428 |
next;
|
|
|
429 |
}
|
|
|
430 |
|
| 2 |
rodolico |
431 |
return if @keys == 0; # Empty hash after checking for add/delete
|
|
|
432 |
|
|
|
433 |
my $key = $keys[$choice];
|
|
|
434 |
my $value = $hash->{$key};
|
|
|
435 |
my $newPath = $path eq 'root' ? $key : "$path.$key";
|
|
|
436 |
|
|
|
437 |
if (ref($value) eq 'HASH') {
|
|
|
438 |
editHash($value, $newPath);
|
|
|
439 |
} elsif (ref($value) eq 'ARRAY') {
|
|
|
440 |
editArray($value, $newPath);
|
|
|
441 |
} else {
|
|
|
442 |
$hash->{$key} = editScalar($value, $key, $path);
|
|
|
443 |
}
|
|
|
444 |
}
|
|
|
445 |
}
|
|
|
446 |
|
| 6 |
rodolico |
447 |
## Handle deletion of an element from an array.
|
|
|
448 |
##
|
|
|
449 |
## Arguments:
|
|
|
450 |
## $array - Arrayref to delete from
|
|
|
451 |
##
|
|
|
452 |
## Returns:
|
|
|
453 |
## Nothing (modifies $array in place)
|
|
|
454 |
sub handleArrayElementDeletion {
|
|
|
455 |
my ($array) = @_;
|
|
|
456 |
|
|
|
457 |
return if @$array == 0; # Empty array, nothing to delete
|
|
|
458 |
|
|
|
459 |
print "\nSelect element to delete (1-" . scalar(@$array) . ", 0=cancel): ";
|
|
|
460 |
my $delInput = <STDIN>;
|
|
|
461 |
chomp $delInput;
|
|
|
462 |
|
|
|
463 |
if ($delInput eq '0' || $delInput eq '') {
|
|
|
464 |
print "Delete cancelled.\n";
|
|
|
465 |
return;
|
|
|
466 |
}
|
|
|
467 |
|
|
|
468 |
if ($delInput =~ /^\d+$/ && $delInput >= 1 && $delInput <= scalar(@$array)) {
|
|
|
469 |
my $indexToDelete = $delInput - 1;
|
|
|
470 |
print "Delete element at index $indexToDelete and all its children? (y/n): ";
|
|
|
471 |
my $confirm = <STDIN>;
|
|
|
472 |
chomp $confirm;
|
|
|
473 |
|
|
|
474 |
if ($confirm =~ /^y/i) {
|
|
|
475 |
splice @$array, $indexToDelete, 1;
|
|
|
476 |
print "Element at index $indexToDelete deleted.\n";
|
|
|
477 |
} else {
|
|
|
478 |
print "Delete cancelled.\n";
|
|
|
479 |
}
|
|
|
480 |
} else {
|
|
|
481 |
print "Invalid selection.\n";
|
|
|
482 |
}
|
|
|
483 |
}
|
|
|
484 |
|
|
|
485 |
## Handle adding a new element to an array.
|
|
|
486 |
##
|
|
|
487 |
## Arguments:
|
|
|
488 |
## $array - Arrayref to add to
|
|
|
489 |
## $path - Current path string
|
|
|
490 |
##
|
|
|
491 |
## Returns:
|
|
|
492 |
## Nothing (modifies $array in place)
|
|
|
493 |
sub handleArrayElementAddition {
|
|
|
494 |
my ($array, $path) = @_;
|
|
|
495 |
|
|
|
496 |
my $valueType = getValueType();
|
|
|
497 |
my $newValue = createNewValue($valueType);
|
|
|
498 |
push @$array, $newValue;
|
|
|
499 |
my $newIndex = $#$array;
|
|
|
500 |
print "Element added at index $newIndex.\n";
|
|
|
501 |
|
|
|
502 |
# If it's a hash or array, allow immediate editing
|
|
|
503 |
if ($valueType eq 'hash' || $valueType eq 'array') {
|
|
|
504 |
my $newPath = "$path\[$newIndex\]";
|
|
|
505 |
if ($valueType eq 'hash') {
|
|
|
506 |
editHash($newValue, $newPath);
|
|
|
507 |
} else {
|
|
|
508 |
editArray($newValue, $newPath);
|
|
|
509 |
}
|
|
|
510 |
}
|
|
|
511 |
}
|
|
|
512 |
|
|
|
513 |
## Edit a scalar value in an array.
|
|
|
514 |
##
|
|
|
515 |
## Arguments:
|
|
|
516 |
## $array - Arrayref containing the value
|
|
|
517 |
## $index - Index of value to edit
|
|
|
518 |
## $path - Path string for display
|
|
|
519 |
##
|
|
|
520 |
## Returns:
|
|
|
521 |
## Nothing (modifies $array in place)
|
|
|
522 |
sub editArrayScalar {
|
|
|
523 |
my ($array, $index, $path) = @_;
|
|
|
524 |
|
|
|
525 |
my $value = $array->[$index];
|
|
|
526 |
print "\n" . "-" x 70 . "\n";
|
|
|
527 |
print "Editing: $path\n";
|
|
|
528 |
print "Current value: " . (defined($value) ? "'$value'" : '<undef>') . "\n";
|
|
|
529 |
print "Enter new value (or press Enter to keep current): ";
|
|
|
530 |
|
|
|
531 |
my $input = <STDIN>;
|
|
|
532 |
chomp $input;
|
|
|
533 |
|
|
|
534 |
if ($input ne '') {
|
|
|
535 |
$array->[$index] = $input;
|
|
|
536 |
print "Value updated.\n";
|
|
|
537 |
}
|
|
|
538 |
}
|
|
|
539 |
|
| 2 |
rodolico |
540 |
## Interactively edit an array structure.
|
|
|
541 |
## Displays elements, allows selection and editing, supports adding and deleting elements.
|
|
|
542 |
## Recursively handles nested hashes and arrays.
|
|
|
543 |
##
|
|
|
544 |
## Arguments:
|
|
|
545 |
## $array - Arrayref to edit
|
|
|
546 |
## $path - String path to current location (default 'root')
|
|
|
547 |
##
|
|
|
548 |
## Returns:
|
|
|
549 |
## Nothing (modifies $array in place)
|
|
|
550 |
sub editArray {
|
|
|
551 |
my ($array, $path) = @_;
|
|
|
552 |
$path //= 'root';
|
|
|
553 |
|
|
|
554 |
while (1) {
|
|
|
555 |
displayArrayElements($array, $path);
|
|
|
556 |
|
| 6 |
rodolico |
557 |
my $choice = getUserChoice("Select element to edit", scalar(@$array) || 1, 1, scalar(@$array) > 0, 0);
|
| 2 |
rodolico |
558 |
|
|
|
559 |
return if !defined $choice;
|
|
|
560 |
return if $choice eq 'back';
|
|
|
561 |
exit 0 if $choice eq 'quit';
|
|
|
562 |
|
|
|
563 |
if ($choice eq 'add') {
|
| 6 |
rodolico |
564 |
handleArrayElementAddition($array, $path);
|
| 2 |
rodolico |
565 |
next;
|
|
|
566 |
}
|
|
|
567 |
|
|
|
568 |
if ($choice eq 'delete') {
|
| 6 |
rodolico |
569 |
handleArrayElementDeletion($array);
|
| 2 |
rodolico |
570 |
next;
|
|
|
571 |
}
|
|
|
572 |
|
|
|
573 |
return if @$array == 0; # Empty array after checking for add/delete
|
|
|
574 |
|
|
|
575 |
my $value = $array->[$choice];
|
|
|
576 |
my $newPath = "$path\[$choice\]";
|
|
|
577 |
|
|
|
578 |
if (ref($value) eq 'HASH') {
|
|
|
579 |
editHash($value, $newPath);
|
|
|
580 |
} elsif (ref($value) eq 'ARRAY') {
|
|
|
581 |
editArray($value, $newPath);
|
|
|
582 |
} else {
|
| 6 |
rodolico |
583 |
editArrayScalar($array, $choice, $newPath);
|
| 2 |
rodolico |
584 |
}
|
|
|
585 |
}
|
|
|
586 |
}
|
|
|
587 |
|
|
|
588 |
## Return usage string for command line help.
|
|
|
589 |
##
|
|
|
590 |
## Arguments:
|
|
|
591 |
## None
|
|
|
592 |
##
|
|
|
593 |
## Returns:
|
|
|
594 |
## String containing usage information
|
|
|
595 |
sub usageString {
|
| 6 |
rodolico |
596 |
return "Usage: $0 [-t <template_file>] [-c <config_file>] [-o <output_file>] [-e] [-C]\n" .
|
| 2 |
rodolico |
597 |
" $0 <template_file> [config_file]\n" .
|
| 6 |
rodolico |
598 |
" $0 -C -c <file1> -c <file2> [-c <file3> ...]\n" .
|
| 2 |
rodolico |
599 |
"\nAt least one of template or config file must be specified.\n" .
|
|
|
600 |
"\nOptions:\n" .
|
|
|
601 |
" -t, --template <file> Template file (Perl hashref)\n" .
|
| 6 |
rodolico |
602 |
" -c, --config <file> Config file (YAML or JSON) - can specify multiple\n" .
|
| 2 |
rodolico |
603 |
" -o, --output <file> Output file (default: STDOUT)\n" .
|
|
|
604 |
" -e, --edit Interactive edit mode\n" .
|
| 6 |
rodolico |
605 |
" -C, --compare Compare multiple config files and show differences\n" .
|
| 2 |
rodolico |
606 |
" -v, --version Show version information\n" .
|
|
|
607 |
" -h, --help Show this help message\n";
|
|
|
608 |
}
|
|
|
609 |
|
|
|
610 |
## Print usage information to STDOUT.
|
|
|
611 |
##
|
|
|
612 |
## Arguments:
|
|
|
613 |
## None
|
|
|
614 |
##
|
|
|
615 |
## Returns:
|
|
|
616 |
## Nothing (void)
|
|
|
617 |
sub printUsage {
|
|
|
618 |
print usageString();
|
|
|
619 |
}
|
|
|
620 |
|
|
|
621 |
## Parse command line options using Getopt::Long.
|
|
|
622 |
## Supports both option-style and positional arguments for backward compatibility.
|
|
|
623 |
##
|
|
|
624 |
## Arguments:
|
|
|
625 |
## None (reads from @ARGV)
|
|
|
626 |
##
|
|
|
627 |
## Returns:
|
|
|
628 |
## Hashref with keys: templateFile, configFile, outputFile, editMode
|
|
|
629 |
sub parseCommandLine {
|
|
|
630 |
my $opts = {
|
|
|
631 |
templateFile => undef,
|
| 6 |
rodolico |
632 |
configFiles => [],
|
| 2 |
rodolico |
633 |
outputFile => undef,
|
|
|
634 |
editMode => 0,
|
| 6 |
rodolico |
635 |
compareMode => 0,
|
| 2 |
rodolico |
636 |
};
|
|
|
637 |
|
|
|
638 |
GetOptions(
|
|
|
639 |
't|template=s' => \$opts->{templateFile},
|
| 6 |
rodolico |
640 |
'c|config=s' => $opts->{configFiles},
|
| 2 |
rodolico |
641 |
'o|output=s' => \$opts->{outputFile},
|
|
|
642 |
'e|edit' => \$opts->{editMode},
|
| 6 |
rodolico |
643 |
'C|compare' => \$opts->{compareMode},
|
| 2 |
rodolico |
644 |
'v|version' => sub { print "$0 version $VERSION\n"; exit 0; },
|
|
|
645 |
'h|help' => sub { printUsage(); exit 0; },
|
|
|
646 |
) or die "Error in command line arguments\n";
|
|
|
647 |
|
|
|
648 |
# For backward compatibility, also accept positional arguments
|
| 6 |
rodolico |
649 |
if (!$opts->{templateFile} && @{$opts->{configFiles}} == 0 && @ARGV >= 1) {
|
| 2 |
rodolico |
650 |
$opts->{templateFile} = $ARGV[0];
|
| 6 |
rodolico |
651 |
push @{$opts->{configFiles}}, $ARGV[1] if @ARGV >= 2;
|
|
|
652 |
# Support multiple positional config files
|
|
|
653 |
push @{$opts->{configFiles}}, @ARGV[2..$#ARGV] if @ARGV > 2;
|
| 2 |
rodolico |
654 |
}
|
|
|
655 |
|
|
|
656 |
# Check that at least one input file is specified
|
|
|
657 |
die "Error: At least one of template or config file required\n" . usageString()
|
| 6 |
rodolico |
658 |
unless $opts->{templateFile} || @{$opts->{configFiles}} > 0;
|
| 2 |
rodolico |
659 |
|
| 6 |
rodolico |
660 |
# In compare mode, require at least 2 config files
|
|
|
661 |
if ($opts->{compareMode} && @{$opts->{configFiles}} < 2) {
|
|
|
662 |
die "Error: Compare mode requires at least 2 config files\n" . usageString();
|
|
|
663 |
}
|
|
|
664 |
|
| 2 |
rodolico |
665 |
return $opts;
|
|
|
666 |
}
|
|
|
667 |
|
|
|
668 |
## Load and evaluate a Perl template file.
|
|
|
669 |
## Template file should contain a hashref data structure.
|
|
|
670 |
##
|
|
|
671 |
## Arguments:
|
|
|
672 |
## $templateFile - Path to template file
|
|
|
673 |
##
|
|
|
674 |
## Returns:
|
|
|
675 |
## Hashref from template, or empty hashref if no file specified
|
|
|
676 |
sub loadTemplate {
|
|
|
677 |
my ($templateFile) = @_;
|
|
|
678 |
return {} unless $templateFile;
|
|
|
679 |
|
|
|
680 |
die "Template file '$templateFile' does not exist\n" unless -f $templateFile;
|
|
|
681 |
my $templateContent = read_file($templateFile);
|
|
|
682 |
my $template = eval $templateContent;
|
|
|
683 |
die "Error parsing template file: $@\n" if $@;
|
|
|
684 |
die "Template must be a hashref\n" unless ref($template) eq 'HASH';
|
|
|
685 |
|
|
|
686 |
return $template;
|
|
|
687 |
}
|
|
|
688 |
|
|
|
689 |
## Detect file format based on extension.
|
|
|
690 |
## Recognizes .yaml, .yml, and .json extensions.
|
|
|
691 |
##
|
|
|
692 |
## Arguments:
|
|
|
693 |
## $filename - Path to file
|
|
|
694 |
##
|
|
|
695 |
## Returns:
|
|
|
696 |
## String: 'yaml' or 'json'
|
|
|
697 |
## Dies if extension not recognized
|
|
|
698 |
sub detectFileFormat {
|
|
|
699 |
my ($filename) = @_;
|
|
|
700 |
return 'yaml' if $filename =~ /\.ya?ml$/i;
|
|
|
701 |
return 'json' if $filename =~ /\.json$/i;
|
|
|
702 |
die "Config file must be YAML (.yaml/.yml) or JSON (.json)\n";
|
|
|
703 |
}
|
|
|
704 |
|
|
|
705 |
## Load a YAML file using available YAML library.
|
|
|
706 |
## Tries YAML::XS, YAML::Tiny, and YAML in order.
|
|
|
707 |
##
|
|
|
708 |
## Arguments:
|
|
|
709 |
## $filename - Path to YAML file
|
|
|
710 |
##
|
|
|
711 |
## Returns:
|
|
|
712 |
## Perl data structure from YAML file
|
|
|
713 |
## Dies if no YAML library available
|
|
|
714 |
sub loadYamlFile {
|
|
|
715 |
my ($filename) = @_;
|
|
|
716 |
|
|
|
717 |
for my $yamlModule ('YAML::XS', 'YAML::Tiny', 'YAML') {
|
|
|
718 |
if (eval "require $yamlModule; 1") {
|
|
|
719 |
$yamlModule->import('LoadFile');
|
|
|
720 |
return LoadFile($filename);
|
|
|
721 |
}
|
|
|
722 |
}
|
|
|
723 |
die "No YAML library available. Install YAML::XS, YAML::Tiny, or YAML\n";
|
|
|
724 |
}
|
|
|
725 |
|
|
|
726 |
## Load a JSON file using available JSON library.
|
|
|
727 |
## Tries JSON::XS, JSON::PP, and JSON in order.
|
|
|
728 |
##
|
|
|
729 |
## Arguments:
|
|
|
730 |
## $filename - Path to JSON file
|
|
|
731 |
##
|
|
|
732 |
## Returns:
|
|
|
733 |
## Perl data structure from JSON file
|
|
|
734 |
## Dies if no JSON library available
|
|
|
735 |
sub loadJsonFile {
|
|
|
736 |
my ($filename) = @_;
|
|
|
737 |
|
|
|
738 |
for my $jsonModule ('JSON::XS', 'JSON::PP', 'JSON') {
|
|
|
739 |
if (eval "require $jsonModule; 1") {
|
|
|
740 |
my $jsonText = read_file($filename);
|
|
|
741 |
return $jsonModule->new->decode($jsonText);
|
|
|
742 |
}
|
|
|
743 |
}
|
|
|
744 |
die "No JSON library available. Install JSON::XS, JSON::PP, or JSON\n";
|
|
|
745 |
}
|
|
|
746 |
|
|
|
747 |
## Load config file and detect its format.
|
|
|
748 |
## Handles both YAML and JSON formats automatically.
|
|
|
749 |
##
|
|
|
750 |
## Arguments:
|
|
|
751 |
## $configFile - Path to config file
|
|
|
752 |
##
|
|
|
753 |
## Returns:
|
|
|
754 |
## List: ($config_hashref, $format_string)
|
|
|
755 |
## Returns ({}, 'yaml') if no file specified
|
|
|
756 |
sub loadConfig {
|
|
|
757 |
my ($configFile) = @_;
|
|
|
758 |
my $config = {};
|
|
|
759 |
my $format = 'yaml'; # Default format
|
|
|
760 |
|
|
|
761 |
if ($configFile && -f $configFile) {
|
|
|
762 |
$format = detectFileFormat($configFile);
|
|
|
763 |
|
|
|
764 |
if ($format eq 'yaml') {
|
|
|
765 |
$config = loadYamlFile($configFile);
|
|
|
766 |
} elsif ($format eq 'json') {
|
|
|
767 |
$config = loadJsonFile($configFile);
|
|
|
768 |
}
|
|
|
769 |
|
|
|
770 |
die "Config must be a hashref\n" unless ref($config) eq 'HASH';
|
|
|
771 |
}
|
|
|
772 |
|
|
|
773 |
return ($config, $format);
|
|
|
774 |
}
|
|
|
775 |
|
|
|
776 |
## Recursively merge template into config.
|
|
|
777 |
## Template values are only applied for missing keys in config.
|
|
|
778 |
## Handles nested hashes and arrays, tracking changes in messages array.
|
|
|
779 |
##
|
|
|
780 |
## Arguments:
|
|
|
781 |
## $template - Hashref template structure
|
|
|
782 |
## $config - Hashref config to merge into
|
|
|
783 |
## $path - Current path string for messages (default '')
|
|
|
784 |
## $messages - Arrayref to collect change notifications (default [])
|
|
|
785 |
##
|
|
|
786 |
## Returns:
|
|
|
787 |
## List: ($config, $messages) - updated config and array of change messages
|
|
|
788 |
sub mergeHash {
|
|
|
789 |
my ($template, $config, $path, $messages) = @_;
|
|
|
790 |
$path //= ''; # Track the key path for notifications
|
|
|
791 |
$messages //= []; # Array to collect notification messages
|
|
|
792 |
|
|
|
793 |
for my $key (keys %$template) {
|
|
|
794 |
my $currentPath = $path ? "$path.$key" : $key;
|
|
|
795 |
|
|
|
796 |
if (!exists $config->{$key}) {
|
|
|
797 |
# Key missing in config, copy from template
|
|
|
798 |
$config->{$key} = $template->{$key};
|
|
|
799 |
push @$messages, "Added key: $currentPath";
|
|
|
800 |
} elsif (ref($template->{$key}) eq 'HASH' && ref($config->{$key}) eq 'HASH') {
|
|
|
801 |
# Both are hashes, recurse
|
|
|
802 |
mergeHash($template->{$key}, $config->{$key}, $currentPath, $messages);
|
|
|
803 |
} elsif (ref($template->{$key}) eq 'ARRAY' && ref($config->{$key}) eq 'ARRAY') {
|
|
|
804 |
# Both are arrays, merge by index
|
|
|
805 |
my $templateArray = $template->{$key};
|
|
|
806 |
my $configArray = $config->{$key};
|
|
|
807 |
|
|
|
808 |
# Extend config array if template is longer
|
|
|
809 |
for my $i (0 .. $#$templateArray) {
|
|
|
810 |
if ($i > $#$configArray) {
|
|
|
811 |
# Config array is shorter, append from template
|
|
|
812 |
push @$configArray, $templateArray->[$i];
|
|
|
813 |
push @$messages, "Extended array: $currentPath\[$i\] (added from template)";
|
|
|
814 |
} elsif (ref($templateArray->[$i]) eq 'HASH' && ref($configArray->[$i]) eq 'HASH') {
|
|
|
815 |
# Both elements are hashes, merge them
|
|
|
816 |
mergeHash($templateArray->[$i], $configArray->[$i], "$currentPath\[$i\]", $messages);
|
|
|
817 |
}
|
|
|
818 |
# Otherwise keep existing config value at this index
|
|
|
819 |
}
|
|
|
820 |
}
|
|
|
821 |
# If key exists in config with different types, keep config value (don't override)
|
|
|
822 |
}
|
|
|
823 |
return ($config, $messages);
|
|
|
824 |
}
|
|
|
825 |
|
|
|
826 |
## Merge template and config or return whichever is provided.
|
|
|
827 |
## Determines merge strategy based on which files are present.
|
|
|
828 |
##
|
|
|
829 |
## Arguments:
|
|
|
830 |
## $template - Hashref from template file
|
|
|
831 |
## $config - Hashref from config file
|
|
|
832 |
## $hasTemplate - Boolean whether template file was provided
|
|
|
833 |
## $hasConfig - Boolean whether config file was provided
|
|
|
834 |
##
|
|
|
835 |
## Returns:
|
|
|
836 |
## List: ($merged_hashref, $messages_arrayref)
|
|
|
837 |
sub mergeConfigs {
|
|
|
838 |
my ($template, $config, $hasTemplate, $hasConfig) = @_;
|
|
|
839 |
|
|
|
840 |
if ($hasTemplate && $hasConfig) {
|
|
|
841 |
return mergeHash($template, $config);
|
|
|
842 |
} elsif ($hasTemplate) {
|
|
|
843 |
return ($template, []);
|
|
|
844 |
} else {
|
|
|
845 |
return ($config, []);
|
|
|
846 |
}
|
|
|
847 |
}
|
|
|
848 |
|
|
|
849 |
## Output notification messages to STDERR.
|
|
|
850 |
##
|
|
|
851 |
## Arguments:
|
|
|
852 |
## $messages - Arrayref of message strings
|
|
|
853 |
##
|
|
|
854 |
## Returns:
|
|
|
855 |
## Nothing (void)
|
|
|
856 |
sub outputMessages {
|
|
|
857 |
my ($messages) = @_;
|
|
|
858 |
return unless @$messages;
|
|
|
859 |
warn "$_\n" for @$messages;
|
|
|
860 |
}
|
|
|
861 |
|
|
|
862 |
## Format data structure as JSON.
|
|
|
863 |
## Tries JSON::XS, JSON::PP, and JSON libraries in order.
|
|
|
864 |
## Uses pretty-printing and canonical key ordering.
|
|
|
865 |
##
|
|
|
866 |
## Arguments:
|
|
|
867 |
## $data - Perl data structure to format
|
|
|
868 |
##
|
|
|
869 |
## Returns:
|
|
|
870 |
## String containing JSON representation
|
|
|
871 |
## Dies if no JSON library available
|
|
|
872 |
sub formatAsJson {
|
|
|
873 |
my ($data) = @_;
|
|
|
874 |
|
|
|
875 |
for my $jsonModule ('JSON::XS', 'JSON::PP', 'JSON') {
|
|
|
876 |
if (eval "require $jsonModule; 1") {
|
|
|
877 |
my $jsonObj = $jsonModule->new->pretty->canonical;
|
|
|
878 |
return $jsonObj->encode($data);
|
|
|
879 |
}
|
|
|
880 |
}
|
|
|
881 |
die "No JSON library available for output. Install JSON::XS, JSON::PP, or JSON\n";
|
|
|
882 |
}
|
|
|
883 |
|
|
|
884 |
## Format data structure as YAML.
|
|
|
885 |
## Tries YAML::XS, YAML::Tiny, and YAML libraries in order.
|
|
|
886 |
##
|
|
|
887 |
## Arguments:
|
|
|
888 |
## $data - Perl data structure to format
|
|
|
889 |
##
|
|
|
890 |
## Returns:
|
|
|
891 |
## String containing YAML representation
|
|
|
892 |
## Dies if no YAML library available
|
|
|
893 |
sub formatAsYaml {
|
|
|
894 |
my ($data) = @_;
|
|
|
895 |
|
|
|
896 |
for my $yamlModule ('YAML::XS', 'YAML::Tiny', 'YAML') {
|
|
|
897 |
if (eval "require $yamlModule; 1") {
|
|
|
898 |
$yamlModule->import('Dump');
|
|
|
899 |
return Dump($data);
|
|
|
900 |
}
|
|
|
901 |
}
|
|
|
902 |
die "No YAML library available for output. Install YAML::XS, YAML::Tiny, or YAML\n";
|
|
|
903 |
}
|
|
|
904 |
|
|
|
905 |
## Format data structure as YAML or JSON based on format parameter.
|
|
|
906 |
##
|
|
|
907 |
## Arguments:
|
|
|
908 |
## $data - Perl data structure to format
|
|
|
909 |
## $format - String: 'yaml' or 'json'
|
|
|
910 |
##
|
|
|
911 |
## Returns:
|
|
|
912 |
## String containing formatted output
|
|
|
913 |
sub formatOutput {
|
|
|
914 |
my ($data, $format) = @_;
|
|
|
915 |
|
|
|
916 |
if ($format eq 'json') {
|
|
|
917 |
return formatAsJson($data);
|
|
|
918 |
} else {
|
|
|
919 |
return formatAsYaml($data);
|
|
|
920 |
}
|
|
|
921 |
}
|
|
|
922 |
|
|
|
923 |
## Write content to file or STDOUT.
|
|
|
924 |
##
|
|
|
925 |
## Arguments:
|
|
|
926 |
## $content - String content to write
|
|
|
927 |
## $outputFile - Path to output file, or undef for STDOUT
|
|
|
928 |
##
|
|
|
929 |
## Returns:
|
|
|
930 |
## Nothing (void)
|
|
|
931 |
sub writeOutput {
|
|
|
932 |
my ($content, $outputFile) = @_;
|
|
|
933 |
|
|
|
934 |
if ($outputFile) {
|
|
|
935 |
open my $fh, '>', $outputFile or die "Cannot write to '$outputFile': $!\n";
|
|
|
936 |
print $fh $content;
|
|
|
937 |
close $fh;
|
|
|
938 |
warn "Output written to: $outputFile\n";
|
|
|
939 |
} else {
|
|
|
940 |
print $content;
|
|
|
941 |
}
|
|
|
942 |
}
|
|
|
943 |
|
|
|
944 |
## Prompt user whether to save changes.
|
|
|
945 |
##
|
|
|
946 |
## Arguments:
|
|
|
947 |
## None
|
|
|
948 |
##
|
|
|
949 |
## Returns:
|
|
|
950 |
## Boolean: true if user wants to save (answered 'y' or 'Y')
|
|
|
951 |
sub promptSave {
|
|
|
952 |
print "\nSave changes? (y/n): ";
|
|
|
953 |
my $input = <STDIN>;
|
|
|
954 |
chomp $input;
|
|
|
955 |
return $input =~ /^y/i;
|
|
|
956 |
}
|
|
|
957 |
|
|
|
958 |
## Backup original file and save new content.
|
|
|
959 |
## Renames original file with .bak suffix before writing new content.
|
|
|
960 |
##
|
|
|
961 |
## Arguments:
|
|
|
962 |
## $filename - Path to file to save
|
|
|
963 |
## $content - String content to write
|
|
|
964 |
##
|
|
|
965 |
## Returns:
|
|
|
966 |
## Nothing (void)
|
|
|
967 |
## Dies on file operation errors
|
|
|
968 |
sub backupAndSave {
|
|
|
969 |
my ($filename, $content) = @_;
|
|
|
970 |
|
|
|
971 |
# Create backup by renaming original file
|
|
|
972 |
my $backupFile = "$filename.bak";
|
|
|
973 |
if (-f $filename) {
|
|
|
974 |
rename $filename, $backupFile or die "Cannot create backup '$backupFile': $!\n";
|
|
|
975 |
warn "Original file backed up to: $backupFile\n";
|
|
|
976 |
}
|
|
|
977 |
|
|
|
978 |
# Write new content to original filename
|
|
|
979 |
open my $fh, '>', $filename or die "Cannot write to '$filename': $!\n";
|
|
|
980 |
print $fh $content;
|
|
|
981 |
close $fh;
|
|
|
982 |
warn "Changes saved to: $filename\n";
|
|
|
983 |
}
|
|
|
984 |
|
| 6 |
rodolico |
985 |
## Collect values and types from all configs for a given key.
|
|
|
986 |
##
|
|
|
987 |
## Arguments:
|
|
|
988 |
## $configs - Arrayref of hashrefs
|
|
|
989 |
## $key - Key to check in each config
|
|
|
990 |
##
|
|
|
991 |
## Returns:
|
|
|
992 |
## List: (\@values, \@types, $allExist)
|
|
|
993 |
sub collectConfigValues {
|
|
|
994 |
my ($configs, $key) = @_;
|
|
|
995 |
my @values;
|
|
|
996 |
my @types;
|
|
|
997 |
my $allExist = 1;
|
|
|
998 |
|
|
|
999 |
for my $i (0 .. $#$configs) {
|
|
|
1000 |
my $config = $configs->[$i];
|
|
|
1001 |
if (!exists $config->{$key}) {
|
|
|
1002 |
push @values, undef;
|
|
|
1003 |
push @types, 'missing';
|
|
|
1004 |
$allExist = 0;
|
|
|
1005 |
} else {
|
|
|
1006 |
push @values, $config->{$key};
|
|
|
1007 |
push @types, ref($config->{$key}) || 'scalar';
|
|
|
1008 |
}
|
|
|
1009 |
}
|
|
|
1010 |
|
|
|
1011 |
return (\@values, \@types, $allExist);
|
|
|
1012 |
}
|
|
|
1013 |
|
|
|
1014 |
## Format value for display in comparison report.
|
|
|
1015 |
##
|
|
|
1016 |
## Arguments:
|
|
|
1017 |
## $value - Value to format
|
|
|
1018 |
## $path - Path string for the value
|
|
|
1019 |
##
|
|
|
1020 |
## Returns:
|
|
|
1021 |
## String representation of value
|
|
|
1022 |
sub formatValueForComparison {
|
|
|
1023 |
my ($value, $path) = @_;
|
|
|
1024 |
|
|
|
1025 |
if (!defined($value)) {
|
|
|
1026 |
return '<missing>';
|
|
|
1027 |
} elsif (ref($value)) {
|
|
|
1028 |
return "key: $path [" . ref($value) . "]";
|
|
|
1029 |
} else {
|
|
|
1030 |
return "key: $path '$value'";
|
|
|
1031 |
}
|
|
|
1032 |
}
|
|
|
1033 |
|
|
|
1034 |
## Record a difference between config files.
|
|
|
1035 |
##
|
|
|
1036 |
## Arguments:
|
|
|
1037 |
## $diffs - Arrayref to append difference to
|
|
|
1038 |
## $path - String path to the difference
|
|
|
1039 |
## $values - Arrayref of values from each config
|
|
|
1040 |
## $filenames - Arrayref of filenames
|
|
|
1041 |
## $diffType - 'missing' or 'different'
|
|
|
1042 |
##
|
|
|
1043 |
## Returns:
|
|
|
1044 |
## Nothing (modifies $diffs in place)
|
|
|
1045 |
sub recordDifference {
|
|
|
1046 |
my ($diffs, $path, $values, $filenames, $diffType) = @_;
|
|
|
1047 |
|
|
|
1048 |
my %fileValues;
|
|
|
1049 |
for my $i (0 .. $#$filenames) {
|
|
|
1050 |
$fileValues{$filenames->[$i]} = formatValueForComparison($values->[$i], $path);
|
|
|
1051 |
}
|
|
|
1052 |
|
|
|
1053 |
push @$diffs, {
|
|
|
1054 |
path => $path,
|
|
|
1055 |
values => \%fileValues,
|
|
|
1056 |
diffType => $diffType
|
|
|
1057 |
};
|
|
|
1058 |
}
|
|
|
1059 |
|
|
|
1060 |
## Check if all elements in array have the same type.
|
|
|
1061 |
##
|
|
|
1062 |
## Arguments:
|
|
|
1063 |
## $types - Arrayref of type strings
|
|
|
1064 |
##
|
|
|
1065 |
## Returns:
|
|
|
1066 |
## Boolean: true if all types match
|
|
|
1067 |
sub allSameType {
|
|
|
1068 |
my ($types) = @_;
|
|
|
1069 |
my $firstType = $types->[0];
|
|
|
1070 |
|
|
|
1071 |
for my $type (@$types) {
|
|
|
1072 |
return 0 if $type ne $firstType;
|
|
|
1073 |
}
|
|
|
1074 |
return 1;
|
|
|
1075 |
}
|
|
|
1076 |
|
|
|
1077 |
## Compare scalar values across configs.
|
|
|
1078 |
##
|
|
|
1079 |
## Arguments:
|
|
|
1080 |
## $values - Arrayref of scalar values
|
|
|
1081 |
## $filenames - Arrayref of filenames
|
|
|
1082 |
## $path - Current path string
|
|
|
1083 |
## $diffs - Arrayref to collect differences
|
|
|
1084 |
##
|
|
|
1085 |
## Returns:
|
|
|
1086 |
## Nothing (modifies $diffs in place)
|
|
|
1087 |
sub compareScalarValues {
|
|
|
1088 |
my ($values, $filenames, $path, $diffs) = @_;
|
|
|
1089 |
|
|
|
1090 |
my $firstVal = $values->[0];
|
|
|
1091 |
my $allSame = 1;
|
|
|
1092 |
|
|
|
1093 |
for my $val (@$values) {
|
|
|
1094 |
if (!defined($val) || !defined($firstVal) || $val ne $firstVal) {
|
|
|
1095 |
$allSame = 0;
|
|
|
1096 |
last;
|
|
|
1097 |
}
|
|
|
1098 |
}
|
|
|
1099 |
|
|
|
1100 |
recordDifference($diffs, $path, $values, $filenames, 'different') unless $allSame;
|
|
|
1101 |
}
|
|
|
1102 |
|
|
|
1103 |
## Compare array elements across configs.
|
|
|
1104 |
##
|
|
|
1105 |
## Arguments:
|
|
|
1106 |
## $values - Arrayref of arrayrefs to compare
|
|
|
1107 |
## $configs - Arrayref of config hashrefs
|
|
|
1108 |
## $filenames - Arrayref of filenames
|
|
|
1109 |
## $path - Current path string
|
|
|
1110 |
## $diffs - Arrayref to collect differences
|
|
|
1111 |
##
|
|
|
1112 |
## Returns:
|
|
|
1113 |
## Nothing (modifies $diffs in place)
|
|
|
1114 |
sub compareArrayElements {
|
|
|
1115 |
my ($values, $configs, $filenames, $path, $diffs) = @_;
|
|
|
1116 |
|
|
|
1117 |
# Find maximum array length
|
|
|
1118 |
my $maxLen = 0;
|
|
|
1119 |
$maxLen = @$_ > $maxLen ? @$_ : $maxLen for @$values;
|
|
|
1120 |
|
|
|
1121 |
# Compare each index position
|
|
|
1122 |
for my $idx (0 .. $maxLen - 1) {
|
|
|
1123 |
my @elemValues;
|
|
|
1124 |
my @elemTypes;
|
|
|
1125 |
my $allElemExist = 1;
|
|
|
1126 |
|
|
|
1127 |
# Collect values at this index from all configs
|
|
|
1128 |
for my $i (0 .. $#$configs) {
|
|
|
1129 |
if ($idx >= @{$values->[$i]}) {
|
|
|
1130 |
push @elemValues, undef;
|
|
|
1131 |
push @elemTypes, 'missing';
|
|
|
1132 |
$allElemExist = 0;
|
|
|
1133 |
} else {
|
|
|
1134 |
push @elemValues, $values->[$i]->[$idx];
|
|
|
1135 |
push @elemTypes, ref($values->[$i]->[$idx]) || 'scalar';
|
|
|
1136 |
}
|
|
|
1137 |
}
|
|
|
1138 |
|
|
|
1139 |
my $arrayPath = "$path\[$idx\]";
|
|
|
1140 |
|
|
|
1141 |
# Handle missing elements
|
|
|
1142 |
if (!$allElemExist) {
|
|
|
1143 |
recordDifference($diffs, $arrayPath, \@elemValues, $filenames, 'missing');
|
|
|
1144 |
next;
|
|
|
1145 |
}
|
|
|
1146 |
|
|
|
1147 |
# Handle type mismatches
|
|
|
1148 |
if (!allSameType(\@elemTypes)) {
|
|
|
1149 |
recordDifference($diffs, $arrayPath, \@elemValues, $filenames, 'different');
|
|
|
1150 |
next;
|
|
|
1151 |
}
|
|
|
1152 |
|
|
|
1153 |
# Recurse based on type
|
|
|
1154 |
my $firstElemType = $elemTypes[0];
|
|
|
1155 |
if ($firstElemType eq 'HASH') {
|
|
|
1156 |
compareConfigs(\@elemValues, $filenames, $arrayPath, $diffs);
|
|
|
1157 |
} elsif ($firstElemType eq 'ARRAY') {
|
|
|
1158 |
compareConfigs(\@elemValues, $filenames, $arrayPath, $diffs);
|
|
|
1159 |
} elsif ($firstElemType eq 'scalar') {
|
|
|
1160 |
compareScalarValues(\@elemValues, $filenames, $arrayPath, $diffs);
|
|
|
1161 |
}
|
|
|
1162 |
}
|
|
|
1163 |
}
|
|
|
1164 |
|
|
|
1165 |
## Recursively compare multiple config structures.
|
|
|
1166 |
## Identifies keys that exist in some configs but not others,
|
|
|
1167 |
## and values that differ across configs.
|
|
|
1168 |
##
|
|
|
1169 |
## Arguments:
|
|
|
1170 |
## $configs - Arrayref of hashrefs, each representing a config file
|
|
|
1171 |
## $filenames - Arrayref of filenames corresponding to each config
|
|
|
1172 |
## $path - Current path string (default '')
|
|
|
1173 |
## $diffs - Arrayref to collect differences (default [])
|
|
|
1174 |
##
|
|
|
1175 |
## Returns:
|
|
|
1176 |
## Arrayref of hashrefs, each describing a difference with keys:
|
|
|
1177 |
## path - String path to the differing value
|
|
|
1178 |
## values - Hashref mapping filename to value at that path
|
|
|
1179 |
## diffType - 'missing' (key absent in some files) or 'different' (values differ)
|
|
|
1180 |
sub compareConfigs {
|
|
|
1181 |
my ($configs, $filenames, $path, $diffs) = @_;
|
|
|
1182 |
$path //= '';
|
|
|
1183 |
$diffs //= [];
|
|
|
1184 |
|
|
|
1185 |
# Collect all unique keys across all configs
|
|
|
1186 |
my %allKeys;
|
|
|
1187 |
for my $config (@$configs) {
|
|
|
1188 |
next unless ref($config) eq 'HASH';
|
|
|
1189 |
$allKeys{$_} = 1 for keys %$config;
|
|
|
1190 |
}
|
|
|
1191 |
|
|
|
1192 |
# Check each key across all configs
|
|
|
1193 |
for my $key (sort keys %allKeys) {
|
|
|
1194 |
my $currentPath = $path ? "$path.$key" : $key;
|
|
|
1195 |
my ($values, $types, $allExist) = collectConfigValues($configs, $key);
|
|
|
1196 |
|
|
|
1197 |
# If key missing from some configs, record it
|
|
|
1198 |
if (!$allExist) {
|
|
|
1199 |
recordDifference($diffs, $currentPath, $values, $filenames, 'missing');
|
|
|
1200 |
next;
|
|
|
1201 |
}
|
|
|
1202 |
|
|
|
1203 |
# Check if all values are the same type
|
|
|
1204 |
if (!allSameType($types)) {
|
|
|
1205 |
recordDifference($diffs, $currentPath, $values, $filenames, 'different');
|
|
|
1206 |
} elsif ($types->[0] eq 'HASH') {
|
|
|
1207 |
# All are hashes - recurse
|
|
|
1208 |
compareConfigs($values, $filenames, $currentPath, $diffs);
|
|
|
1209 |
} elsif ($types->[0] eq 'ARRAY') {
|
|
|
1210 |
# All are arrays - compare by index
|
|
|
1211 |
compareArrayElements($values, $configs, $filenames, $currentPath, $diffs);
|
|
|
1212 |
} elsif ($types->[0] eq 'scalar') {
|
|
|
1213 |
# All are scalars - compare values
|
|
|
1214 |
compareScalarValues($values, $filenames, $currentPath, $diffs);
|
|
|
1215 |
}
|
|
|
1216 |
}
|
|
|
1217 |
|
|
|
1218 |
return $diffs;
|
|
|
1219 |
}
|
|
|
1220 |
|
|
|
1221 |
## Generate a formatted comparison report.
|
|
|
1222 |
## Creates a readable report showing all differences between config files.
|
|
|
1223 |
##
|
|
|
1224 |
## Arguments:
|
|
|
1225 |
## $diffs - Arrayref of difference records from compareConfigs()
|
|
|
1226 |
## $filenames - Arrayref of config filenames
|
|
|
1227 |
##
|
|
|
1228 |
## Returns:
|
|
|
1229 |
## String containing formatted report
|
|
|
1230 |
sub generateComparisonReport {
|
|
|
1231 |
my ($diffs, $filenames) = @_;
|
|
|
1232 |
|
|
|
1233 |
my $report = "\n" . "=" x 80 . "\n";
|
|
|
1234 |
$report .= "Configuration Comparison Report\n";
|
|
|
1235 |
$report .= "=" x 80 . "\n\n";
|
|
|
1236 |
|
|
|
1237 |
$report .= "Comparing files:\n";
|
|
|
1238 |
for my $i (0 .. $#$filenames) {
|
|
|
1239 |
$report .= sprintf " [%d] %s\n", $i + 1, $filenames->[$i];
|
|
|
1240 |
}
|
|
|
1241 |
$report .= "\n";
|
|
|
1242 |
|
|
|
1243 |
if (@$diffs == 0) {
|
|
|
1244 |
$report .= "No differences found. All config files are identical.\n\n";
|
|
|
1245 |
return $report;
|
|
|
1246 |
}
|
|
|
1247 |
|
|
|
1248 |
$report .= sprintf "Found %d difference%s:\n\n", scalar(@$diffs), @$diffs == 1 ? '' : 's';
|
|
|
1249 |
|
|
|
1250 |
for my $i (0 .. $#$diffs) {
|
|
|
1251 |
my $diff = $diffs->[$i];
|
|
|
1252 |
$report .= sprintf "[%d] Path: %s\n", $i + 1, $diff->{path};
|
|
|
1253 |
$report .= sprintf " Type: %s\n", $diff->{diffType} eq 'missing' ? 'Key missing in some files' : 'Different values';
|
|
|
1254 |
|
|
|
1255 |
for my $filename (sort keys %{$diff->{values}}) {
|
|
|
1256 |
$report .= sprintf " %-40s %s\n", $filename . ':', $diff->{values}->{$filename};
|
|
|
1257 |
}
|
|
|
1258 |
|
|
|
1259 |
$report .= "\n";
|
|
|
1260 |
}
|
|
|
1261 |
|
|
|
1262 |
$report .= "=" x 80 . "\n";
|
|
|
1263 |
return $report;
|
|
|
1264 |
}
|
|
|
1265 |
|
| 2 |
rodolico |
1266 |
# ============================================================================
|
|
|
1267 |
# MAIN
|
|
|
1268 |
# ============================================================================
|
|
|
1269 |
|
|
|
1270 |
my $opts = parseCommandLine();
|
| 6 |
rodolico |
1271 |
|
|
|
1272 |
# Comparison mode - load multiple configs and compare
|
|
|
1273 |
if ($opts->{compareMode}) {
|
|
|
1274 |
my @configs;
|
|
|
1275 |
my @formats;
|
|
|
1276 |
|
|
|
1277 |
for my $configFile (@{$opts->{configFiles}}) {
|
|
|
1278 |
my ($config, $format) = loadConfig($configFile);
|
|
|
1279 |
push @configs, $config;
|
|
|
1280 |
push @formats, $format;
|
|
|
1281 |
}
|
|
|
1282 |
|
|
|
1283 |
my $diffs = compareConfigs(\@configs, $opts->{configFiles});
|
|
|
1284 |
my $report = generateComparisonReport($diffs, $opts->{configFiles});
|
|
|
1285 |
|
|
|
1286 |
if ($opts->{outputFile}) {
|
|
|
1287 |
writeOutput($report, $opts->{outputFile});
|
|
|
1288 |
} else {
|
|
|
1289 |
print $report;
|
|
|
1290 |
}
|
|
|
1291 |
|
|
|
1292 |
exit 0;
|
|
|
1293 |
}
|
|
|
1294 |
|
|
|
1295 |
# Normal mode - single config file with optional template
|
| 2 |
rodolico |
1296 |
my $template = loadTemplate($opts->{templateFile});
|
| 6 |
rodolico |
1297 |
my $configFile = @{$opts->{configFiles}} > 0 ? $opts->{configFiles}->[0] : undef;
|
|
|
1298 |
my ($config, $outputFormat) = loadConfig($configFile);
|
|
|
1299 |
my ($merged, $messages) = mergeConfigs($template, $config, $opts->{templateFile}, $configFile);
|
| 2 |
rodolico |
1300 |
|
|
|
1301 |
outputMessages($messages);
|
|
|
1302 |
|
|
|
1303 |
# Enter interactive edit mode if requested
|
|
|
1304 |
if ($opts->{editMode}) {
|
|
|
1305 |
print "\n*** Interactive Edit Mode ***\n";
|
|
|
1306 |
print "Navigate through the configuration and edit values.\n";
|
|
|
1307 |
print "Commands: select number to edit, 0=back, q=quit\n";
|
|
|
1308 |
editHash($merged);
|
|
|
1309 |
print "\n*** Exiting Edit Mode ***\n\n";
|
|
|
1310 |
}
|
|
|
1311 |
|
|
|
1312 |
# Determine output format - if output file specified, use its extension
|
|
|
1313 |
if ($opts->{outputFile}) {
|
|
|
1314 |
$outputFormat = detectFileFormat($opts->{outputFile});
|
|
|
1315 |
}
|
|
|
1316 |
|
|
|
1317 |
my $outputContent = formatOutput($merged, $outputFormat);
|
|
|
1318 |
|
|
|
1319 |
# Handle output based on whether output file is specified
|
|
|
1320 |
if ($opts->{outputFile}) {
|
|
|
1321 |
# Output file specified, write directly
|
|
|
1322 |
writeOutput($outputContent, $opts->{outputFile});
|
| 6 |
rodolico |
1323 |
} elsif ($configFile && promptSave()) {
|
| 2 |
rodolico |
1324 |
# No output file, but config file exists and user wants to save
|
| 6 |
rodolico |
1325 |
backupAndSave($configFile, $outputContent);
|
| 2 |
rodolico |
1326 |
} else {
|
|
|
1327 |
# No output file and either no config or user declined save, output to STDOUT
|
|
|
1328 |
writeOutput($outputContent, undef);
|
|
|
1329 |
}
|