Rev 6 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
#!/usr/bin/env perl
# Simplified BSD License (FreeBSD License)
#
# Copyright (c) 2026, Daily Data Inc.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
# list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright notice,
# this list of conditions and the following disclaimer in the documentation
# and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# perlConfigFileUtility
# Utility to merge template configuration structures with existing config files,
# edit configurations interactively, and convert between YAML and JSON formats.
# Supports reading Perl data structures as templates and YAML/JSON as config files.
# Provides interactive hierarchical editor for modifying configuration values.
# Can add new keys to hashes and elements to arrays dynamically.
# Automatically backs up config files when saving changes.
#
# Author: R. W. Rodolico <rodo@dailydata.net>
# Created: January 2026
#
# Revision History:
# Version: 1.2.0 RWR 2026-01-18
# Added ability to load multiple config files and compare their values
# Added ability to rename hash keys in interactive edit mode
# Refactored long functions for improved readability and maintainability
#
# Version: 1.1.0 RWR 2026-01-15
# Added ability to delete keys from hashes and elements from arrays
#
# Version: 1.0 RWR 2026-01-13
# Initial release with merge, edit, and format conversion capabilities
use strict;
use warnings;
use File::Slurp qw(read_file);
use Data::Dumper;
use Getopt::Long qw(GetOptions);
Getopt::Long::Configure("bundling");
our $VERSION = '1.2.0';
# ============================================================================
# FUNCTIONS
# ============================================================================
## Get a display tag showing the type and value of a data structure element.
## Returns formatted string indicating if value is a hash, array, or scalar.
##
## Arguments:
## $value - The value to analyze
##
## Returns:
## String: '[HASH]' for hashrefs, '[ARRAY]' for arrayrefs,
## 'value' for defined scalars, '<undef>' for undefined
sub getTypeTag {
my ($value) = @_;
my $ref = ref($value);
return '[HASH]' if $ref eq 'HASH';
return '[ARRAY]' if $ref eq 'ARRAY';
return defined($value) ? "'$value'" : '<undef>';
}
## Display sorted hash keys with index numbers and type tags.
## Shows each key with its value type for user selection in interactive mode.
##
## Arguments:
## $hash - Hashref to display
## $path - String path to current location in data structure
##
## Returns:
## Array of sorted key names
sub displayHashKeys {
my ($hash, $path) = @_;
$path //= 'root';
print "\n" . "=" x 70 . "\n";
print "Editing: $path\n";
print "=" x 70 . "\n";
my @keys = sort keys %$hash;
if (@keys == 0) {
print " (empty hash)\n";
return ();
}
for my $i (0 .. $#keys) {
my $key = $keys[$i];
my $typeTag = getTypeTag($hash->{$key});
printf " %2d) %-30s %s\n", $i + 1, $key, $typeTag;
}
return @keys;
}
## Display array elements with index numbers and type tags.
## Shows each element's index and value type for user selection.
##
## Arguments:
## $array - Arrayref to display
## $path - String path to current location in data structure
##
## Returns:
## Nothing (void)
sub displayArrayElements {
my ($array, $path) = @_;
$path //= 'root';
print "\n" . "=" x 70 . "\n";
print "Editing array: $path\n";
print "=" x 70 . "\n";
if (@$array == 0) {
print " (empty array)\n";
return;
}
for my $i (0 .. $#$array) {
my $typeTag = getTypeTag($array->[$i]);
printf " %2d) [%d] %s\n", $i + 1, $i, $typeTag;
}
}
## Get and validate user's menu choice.
## Accepts numeric selection, back/quit commands, and optional add/delete/rename commands.
##
## Arguments:
## $prompt - String prompt to display
## $max - Integer maximum valid selection
## $allow_add - Boolean whether to allow 'add' command
## $allow_delete - Boolean whether to allow 'delete' command
## $allow_rename - Boolean whether to allow 'rename' command
##
## Returns:
## Integer (0-based index), 'quit', 'back', 'add', 'delete', 'rename', or undef for invalid input
sub getUserChoice {
my ($prompt, $max, $allowAdd, $allowDelete, $allowRename) = @_;
my $options = "1-$max, 0=back";
$options .= ", a=add new" if $allowAdd;
$options .= ", d=delete" if $allowDelete;
$options .= ", r=rename" if $allowRename;
$options .= ", q=quit";
print "\n$prompt ($options): ";
my $input = <STDIN>;
chomp $input;
return 'quit' if $input =~ /^q/i;
return 'back' if $input eq '0' || $input eq '';
return 'add' if $allowAdd && $input =~ /^a/i;
return 'delete' if $allowDelete && $input =~ /^d/i;
return 'rename' if $allowRename && $input =~ /^r/i;
if ($input =~ /^\d+$/ && $input >= 1 && $input <= $max) {
return $input - 1; # Convert to 0-based index
}
print "Invalid choice. Please enter a valid option.\n";
return undef;
}
## Prompt user to select type for a new value.
## Displays menu of scalar, hash, or array options.
##
## Arguments:
## None
##
## Returns:
## String: 'scalar', 'hash', or 'array'
sub getValueType {
print "\nSelect value type:\n";
print " 1) Scalar (string/number)\n";
print " 2) Hash (key-value pairs)\n";
print " 3) Array (list of items)\n";
print "Enter choice (1-3): ";
my $input = <STDIN>;
chomp $input;
return 'scalar' if $input eq '1';
return 'hash' if $input eq '2';
return 'array' if $input eq '3';
print "Invalid choice. Defaulting to scalar.\n";
return 'scalar';
}
## Create a new value of the specified type.
## For scalars, prompts for input. For hashes/arrays, returns empty structure.
##
## Arguments:
## $type - String: 'scalar', 'hash', or 'array'
##
## Returns:
## New value: hashref ({}), arrayref ([]), or user-entered string
sub createNewValue {
my ($type) = @_;
if ($type eq 'hash') {
return {};
} elsif ($type eq 'array') {
return [];
} else {
print "Enter value: ";
my $value = <STDIN>;
chomp $value;
return $value;
}
}
## Edit a scalar value interactively.
## Displays current value and prompts for new value.
##
## Arguments:
## $value - Current scalar value
## $key - Key name in parent structure
## $path - String path to current location
##
## Returns:
## New value (original if user pressed Enter without input)
sub editScalar {
my ($value, $key, $path) = @_;
print "\n" . "-" x 70 . "\n";
print "Editing: $path.$key\n";
print "Current value: " . (defined($value) ? "'$value'" : '<undef>') . "\n";
print "Enter new value (or press Enter to keep current): ";
my $input = <STDIN>;
chomp $input;
if ($input ne '') {
print "Value updated.\n";
return $input;
}
return $value;
}
## Handle renaming a key in a hash.
##
## Arguments:
## $hash - Hashref to rename key in
## $keys - Arrayref of key names
##
## Returns:
## Nothing (modifies $hash in place)
sub handleHashKeyRename {
my ($hash, $keys) = @_;
return if @$keys == 0; # Empty hash, nothing to rename
print "\nSelect key to rename (1-" . scalar(@$keys) . ", 0=cancel): ";
my $renameInput = <STDIN>;
chomp $renameInput;
if ($renameInput eq '0' || $renameInput eq '') {
print "Rename cancelled.\n";
return;
}
if ($renameInput =~ /^\d+$/ && $renameInput >= 1 && $renameInput <= scalar(@$keys)) {
my $oldKey = $keys->[$renameInput - 1];
print "Current key name: '$oldKey'\n";
print "Enter new key name: ";
my $newKey = <STDIN>;
chomp $newKey;
if ($newKey eq '') {
print "Rename cancelled (empty key name).\n";
return;
}
if ($newKey eq $oldKey) {
print "New key name is the same as old key name.\n";
return;
}
if (exists $hash->{$newKey}) {
print "Key '$newKey' already exists. Rename cancelled.\n";
return;
}
# Rename by copying value to new key and deleting old key
$hash->{$newKey} = $hash->{$oldKey};
delete $hash->{$oldKey};
print "Key renamed from '$oldKey' to '$newKey'.\n";
} else {
print "Invalid selection.\n";
}
}
## Handle deletion of a key from a hash.
##
## Arguments:
## $hash - Hashref to delete from
## $keys - Arrayref of key names
##
## Returns:
## Nothing (modifies $hash in place)
sub handleHashKeyDeletion {
my ($hash, $keys) = @_;
return if @$keys == 0; # Empty hash, nothing to delete
print "\nSelect key to delete (1-" . scalar(@$keys) . ", 0=cancel): ";
my $delInput = <STDIN>;
chomp $delInput;
if ($delInput eq '0' || $delInput eq '') {
print "Delete cancelled.\n";
return;
}
if ($delInput =~ /^\d+$/ && $delInput >= 1 && $delInput <= scalar(@$keys)) {
my $keyToDelete = $keys->[$delInput - 1];
print "Delete key '$keyToDelete' and all its children? (y/n): ";
my $confirm = <STDIN>;
chomp $confirm;
if ($confirm =~ /^y/i) {
delete $hash->{$keyToDelete};
print "Key '$keyToDelete' deleted.\n";
} else {
print "Delete cancelled.\n";
}
} else {
print "Invalid selection.\n";
}
}
## Handle adding a new key to a hash.
##
## Arguments:
## $hash - Hashref to add to
## $path - Current path string
##
## Returns:
## Nothing (modifies $hash in place)
sub handleHashKeyAddition {
my ($hash, $path) = @_;
print "\nEnter new key name: ";
my $newKey = <STDIN>;
chomp $newKey;
if ($newKey eq '') {
print "Invalid key name.\n";
return;
}
if (exists $hash->{$newKey}) {
print "Key '$newKey' already exists.\n";
return;
}
my $valueType = getValueType();
my $newValue = createNewValue($valueType);
$hash->{$newKey} = $newValue;
print "Key '$newKey' added.\n";
# If it's a hash or array, allow immediate editing
if ($valueType eq 'hash' || $valueType eq 'array') {
my $newPath = $path eq 'root' ? $newKey : "$path.$newKey";
if ($valueType eq 'hash') {
editHash($newValue, $newPath);
} else {
editArray($newValue, $newPath);
}
}
}
## Interactively edit a hash structure.
## Displays keys, allows selection and editing of values, supports adding and deleting keys.
## Recursively calls itself for nested hashes and edit_array for arrays.
##
## Arguments:
## $hash - Hashref to edit
## $path - String path to current location (default 'root')
##
## Returns:
## Nothing (modifies $hash in place)
sub editHash {
my ($hash, $path) = @_;
$path //= 'root';
while (1) {
my @keys = displayHashKeys($hash, $path);
my $choice = getUserChoice("Select key to edit", scalar(@keys) || 1, 1, scalar(@keys) > 0, scalar(@keys) > 0);
return if !defined $choice;
return if $choice eq 'back';
exit 0 if $choice eq 'quit';
if ($choice eq 'add') {
handleHashKeyAddition($hash, $path);
next;
}
if ($choice eq 'delete') {
handleHashKeyDeletion($hash, \@keys);
next;
}
if ($choice eq 'rename') {
handleHashKeyRename($hash, \@keys);
next;
}
return if @keys == 0; # Empty hash after checking for add/delete
my $key = $keys[$choice];
my $value = $hash->{$key};
my $newPath = $path eq 'root' ? $key : "$path.$key";
if (ref($value) eq 'HASH') {
editHash($value, $newPath);
} elsif (ref($value) eq 'ARRAY') {
editArray($value, $newPath);
} else {
$hash->{$key} = editScalar($value, $key, $path);
}
}
}
## Handle deletion of an element from an array.
##
## Arguments:
## $array - Arrayref to delete from
##
## Returns:
## Nothing (modifies $array in place)
sub handleArrayElementDeletion {
my ($array) = @_;
return if @$array == 0; # Empty array, nothing to delete
print "\nSelect element to delete (1-" . scalar(@$array) . ", 0=cancel): ";
my $delInput = <STDIN>;
chomp $delInput;
if ($delInput eq '0' || $delInput eq '') {
print "Delete cancelled.\n";
return;
}
if ($delInput =~ /^\d+$/ && $delInput >= 1 && $delInput <= scalar(@$array)) {
my $indexToDelete = $delInput - 1;
print "Delete element at index $indexToDelete and all its children? (y/n): ";
my $confirm = <STDIN>;
chomp $confirm;
if ($confirm =~ /^y/i) {
splice @$array, $indexToDelete, 1;
print "Element at index $indexToDelete deleted.\n";
} else {
print "Delete cancelled.\n";
}
} else {
print "Invalid selection.\n";
}
}
## Handle adding a new element to an array.
##
## Arguments:
## $array - Arrayref to add to
## $path - Current path string
##
## Returns:
## Nothing (modifies $array in place)
sub handleArrayElementAddition {
my ($array, $path) = @_;
my $valueType = getValueType();
my $newValue = createNewValue($valueType);
push @$array, $newValue;
my $newIndex = $#$array;
print "Element added at index $newIndex.\n";
# If it's a hash or array, allow immediate editing
if ($valueType eq 'hash' || $valueType eq 'array') {
my $newPath = "$path\[$newIndex\]";
if ($valueType eq 'hash') {
editHash($newValue, $newPath);
} else {
editArray($newValue, $newPath);
}
}
}
## Edit a scalar value in an array.
##
## Arguments:
## $array - Arrayref containing the value
## $index - Index of value to edit
## $path - Path string for display
##
## Returns:
## Nothing (modifies $array in place)
sub editArrayScalar {
my ($array, $index, $path) = @_;
my $value = $array->[$index];
print "\n" . "-" x 70 . "\n";
print "Editing: $path\n";
print "Current value: " . (defined($value) ? "'$value'" : '<undef>') . "\n";
print "Enter new value (or press Enter to keep current): ";
my $input = <STDIN>;
chomp $input;
if ($input ne '') {
$array->[$index] = $input;
print "Value updated.\n";
}
}
## Interactively edit an array structure.
## Displays elements, allows selection and editing, supports adding and deleting elements.
## Recursively handles nested hashes and arrays.
##
## Arguments:
## $array - Arrayref to edit
## $path - String path to current location (default 'root')
##
## Returns:
## Nothing (modifies $array in place)
sub editArray {
my ($array, $path) = @_;
$path //= 'root';
while (1) {
displayArrayElements($array, $path);
my $choice = getUserChoice("Select element to edit", scalar(@$array) || 1, 1, scalar(@$array) > 0, 0);
return if !defined $choice;
return if $choice eq 'back';
exit 0 if $choice eq 'quit';
if ($choice eq 'add') {
handleArrayElementAddition($array, $path);
next;
}
if ($choice eq 'delete') {
handleArrayElementDeletion($array);
next;
}
return if @$array == 0; # Empty array after checking for add/delete
my $value = $array->[$choice];
my $newPath = "$path\[$choice\]";
if (ref($value) eq 'HASH') {
editHash($value, $newPath);
} elsif (ref($value) eq 'ARRAY') {
editArray($value, $newPath);
} else {
editArrayScalar($array, $choice, $newPath);
}
}
}
## Return usage string for command line help.
##
## Arguments:
## None
##
## Returns:
## String containing usage information
sub usageString {
return "Usage: $0 [-t <template_file>] [-c <config_file>] [-o <output_file>] [-e] [-C]\n" .
" $0 <template_file> [config_file]\n" .
" $0 -C -c <file1> -c <file2> [-c <file3> ...]\n" .
"\nAt least one of template or config file must be specified.\n" .
"\nOptions:\n" .
" -t, --template <file> Template file (Perl hashref)\n" .
" -c, --config <file> Config file (YAML or JSON) - can specify multiple\n" .
" -o, --output <file> Output file (default: STDOUT)\n" .
" -e, --edit Interactive edit mode\n" .
" -C, --compare Compare multiple config files and show differences\n" .
" -v, --version Show version information\n" .
" -h, --help Show this help message\n";
}
## Print usage information to STDOUT.
##
## Arguments:
## None
##
## Returns:
## Nothing (void)
sub printUsage {
print usageString();
}
## Parse command line options using Getopt::Long.
## Supports both option-style and positional arguments for backward compatibility.
##
## Arguments:
## None (reads from @ARGV)
##
## Returns:
## Hashref with keys: templateFile, configFile, outputFile, editMode
sub parseCommandLine {
my $opts = {
templateFile => undef,
configFiles => [],
outputFile => undef,
editMode => 0,
compareMode => 0,
};
GetOptions(
't|template=s' => \$opts->{templateFile},
'c|config=s' => $opts->{configFiles},
'o|output=s' => \$opts->{outputFile},
'e|edit' => \$opts->{editMode},
'C|compare' => \$opts->{compareMode},
'v|version' => sub { print "$0 version $VERSION\n"; exit 0; },
'h|help' => sub { printUsage(); exit 0; },
) or die "Error in command line arguments\n";
# For backward compatibility, also accept positional arguments
if (!$opts->{templateFile} && @{$opts->{configFiles}} == 0 && @ARGV >= 1) {
$opts->{templateFile} = $ARGV[0];
push @{$opts->{configFiles}}, $ARGV[1] if @ARGV >= 2;
# Support multiple positional config files
push @{$opts->{configFiles}}, @ARGV[2..$#ARGV] if @ARGV > 2;
}
# Check that at least one input file is specified
die "Error: At least one of template or config file required\n" . usageString()
unless $opts->{templateFile} || @{$opts->{configFiles}} > 0;
# In compare mode, require at least 2 config files
if ($opts->{compareMode} && @{$opts->{configFiles}} < 2) {
die "Error: Compare mode requires at least 2 config files\n" . usageString();
}
return $opts;
}
## Load and evaluate a Perl template file.
## Template file should contain a hashref data structure.
##
## Arguments:
## $templateFile - Path to template file
##
## Returns:
## Hashref from template, or empty hashref if no file specified
sub loadTemplate {
my ($templateFile) = @_;
return {} unless $templateFile;
die "Template file '$templateFile' does not exist\n" unless -f $templateFile;
my $templateContent = read_file($templateFile);
my $template = eval $templateContent;
die "Error parsing template file: $@\n" if $@;
die "Template must be a hashref\n" unless ref($template) eq 'HASH';
return $template;
}
## Detect file format based on extension.
## Recognizes .yaml, .yml, and .json extensions.
##
## Arguments:
## $filename - Path to file
##
## Returns:
## String: 'yaml' or 'json'
## Dies if extension not recognized
sub detectFileFormat {
my ($filename) = @_;
return 'yaml' if $filename =~ /\.ya?ml$/i;
return 'json' if $filename =~ /\.json$/i;
die "Config file must be YAML (.yaml/.yml) or JSON (.json)\n";
}
## Load a YAML file using available YAML library.
## Tries YAML::XS, YAML::Tiny, and YAML in order.
##
## Arguments:
## $filename - Path to YAML file
##
## Returns:
## Perl data structure from YAML file
## Dies if no YAML library available
sub loadYamlFile {
my ($filename) = @_;
for my $yamlModule ('YAML::XS', 'YAML::Tiny', 'YAML') {
if (eval "require $yamlModule; 1") {
$yamlModule->import('LoadFile');
return LoadFile($filename);
}
}
die "No YAML library available. Install YAML::XS, YAML::Tiny, or YAML\n";
}
## Load a JSON file using available JSON library.
## Tries JSON::XS, JSON::PP, and JSON in order.
##
## Arguments:
## $filename - Path to JSON file
##
## Returns:
## Perl data structure from JSON file
## Dies if no JSON library available
sub loadJsonFile {
my ($filename) = @_;
for my $jsonModule ('JSON::XS', 'JSON::PP', 'JSON') {
if (eval "require $jsonModule; 1") {
my $jsonText = read_file($filename);
return $jsonModule->new->decode($jsonText);
}
}
die "No JSON library available. Install JSON::XS, JSON::PP, or JSON\n";
}
## Load config file and detect its format.
## Handles both YAML and JSON formats automatically.
##
## Arguments:
## $configFile - Path to config file
##
## Returns:
## List: ($config_hashref, $format_string)
## Returns ({}, 'yaml') if no file specified
sub loadConfig {
my ($configFile) = @_;
my $config = {};
my $format = 'yaml'; # Default format
if ($configFile && -f $configFile) {
$format = detectFileFormat($configFile);
if ($format eq 'yaml') {
$config = loadYamlFile($configFile);
} elsif ($format eq 'json') {
$config = loadJsonFile($configFile);
}
die "Config must be a hashref\n" unless ref($config) eq 'HASH';
}
return ($config, $format);
}
## Recursively merge template into config.
## Template values are only applied for missing keys in config.
## Handles nested hashes and arrays, tracking changes in messages array.
##
## Arguments:
## $template - Hashref template structure
## $config - Hashref config to merge into
## $path - Current path string for messages (default '')
## $messages - Arrayref to collect change notifications (default [])
##
## Returns:
## List: ($config, $messages) - updated config and array of change messages
sub mergeHash {
my ($template, $config, $path, $messages) = @_;
$path //= ''; # Track the key path for notifications
$messages //= []; # Array to collect notification messages
for my $key (keys %$template) {
my $currentPath = $path ? "$path.$key" : $key;
if (!exists $config->{$key}) {
# Key missing in config, copy from template
$config->{$key} = $template->{$key};
push @$messages, "Added key: $currentPath";
} elsif (ref($template->{$key}) eq 'HASH' && ref($config->{$key}) eq 'HASH') {
# Both are hashes, recurse
mergeHash($template->{$key}, $config->{$key}, $currentPath, $messages);
} elsif (ref($template->{$key}) eq 'ARRAY' && ref($config->{$key}) eq 'ARRAY') {
# Both are arrays, merge by index
my $templateArray = $template->{$key};
my $configArray = $config->{$key};
# Extend config array if template is longer
for my $i (0 .. $#$templateArray) {
if ($i > $#$configArray) {
# Config array is shorter, append from template
push @$configArray, $templateArray->[$i];
push @$messages, "Extended array: $currentPath\[$i\] (added from template)";
} elsif (ref($templateArray->[$i]) eq 'HASH' && ref($configArray->[$i]) eq 'HASH') {
# Both elements are hashes, merge them
mergeHash($templateArray->[$i], $configArray->[$i], "$currentPath\[$i\]", $messages);
}
# Otherwise keep existing config value at this index
}
}
# If key exists in config with different types, keep config value (don't override)
}
return ($config, $messages);
}
## Merge template and config or return whichever is provided.
## Determines merge strategy based on which files are present.
##
## Arguments:
## $template - Hashref from template file
## $config - Hashref from config file
## $hasTemplate - Boolean whether template file was provided
## $hasConfig - Boolean whether config file was provided
##
## Returns:
## List: ($merged_hashref, $messages_arrayref)
sub mergeConfigs {
my ($template, $config, $hasTemplate, $hasConfig) = @_;
if ($hasTemplate && $hasConfig) {
return mergeHash($template, $config);
} elsif ($hasTemplate) {
return ($template, []);
} else {
return ($config, []);
}
}
## Output notification messages to STDERR.
##
## Arguments:
## $messages - Arrayref of message strings
##
## Returns:
## Nothing (void)
sub outputMessages {
my ($messages) = @_;
return unless @$messages;
warn "$_\n" for @$messages;
}
## Format data structure as JSON.
## Tries JSON::XS, JSON::PP, and JSON libraries in order.
## Uses pretty-printing and canonical key ordering.
##
## Arguments:
## $data - Perl data structure to format
##
## Returns:
## String containing JSON representation
## Dies if no JSON library available
sub formatAsJson {
my ($data) = @_;
for my $jsonModule ('JSON::XS', 'JSON::PP', 'JSON') {
if (eval "require $jsonModule; 1") {
my $jsonObj = $jsonModule->new->pretty->canonical;
return $jsonObj->encode($data);
}
}
die "No JSON library available for output. Install JSON::XS, JSON::PP, or JSON\n";
}
## Format data structure as YAML.
## Tries YAML::XS, YAML::Tiny, and YAML libraries in order.
##
## Arguments:
## $data - Perl data structure to format
##
## Returns:
## String containing YAML representation
## Dies if no YAML library available
sub formatAsYaml {
my ($data) = @_;
for my $yamlModule ('YAML::XS', 'YAML::Tiny', 'YAML') {
if (eval "require $yamlModule; 1") {
$yamlModule->import('Dump');
return Dump($data);
}
}
die "No YAML library available for output. Install YAML::XS, YAML::Tiny, or YAML\n";
}
## Format data structure as YAML or JSON based on format parameter.
##
## Arguments:
## $data - Perl data structure to format
## $format - String: 'yaml' or 'json'
##
## Returns:
## String containing formatted output
sub formatOutput {
my ($data, $format) = @_;
if ($format eq 'json') {
return formatAsJson($data);
} else {
return formatAsYaml($data);
}
}
## Write content to file or STDOUT.
##
## Arguments:
## $content - String content to write
## $outputFile - Path to output file, or undef for STDOUT
##
## Returns:
## Nothing (void)
sub writeOutput {
my ($content, $outputFile) = @_;
if ($outputFile) {
open my $fh, '>', $outputFile or die "Cannot write to '$outputFile': $!\n";
print $fh $content;
close $fh;
warn "Output written to: $outputFile\n";
} else {
print $content;
}
}
## Prompt user whether to save changes.
##
## Arguments:
## None
##
## Returns:
## Boolean: true if user wants to save (answered 'y' or 'Y')
sub promptSave {
print "\nSave changes? (y/n): ";
my $input = <STDIN>;
chomp $input;
return $input =~ /^y/i;
}
## Backup original file and save new content.
## Renames original file with .bak suffix before writing new content.
##
## Arguments:
## $filename - Path to file to save
## $content - String content to write
##
## Returns:
## Nothing (void)
## Dies on file operation errors
sub backupAndSave {
my ($filename, $content) = @_;
# Create backup by renaming original file
my $backupFile = "$filename.bak";
if (-f $filename) {
rename $filename, $backupFile or die "Cannot create backup '$backupFile': $!\n";
warn "Original file backed up to: $backupFile\n";
}
# Write new content to original filename
open my $fh, '>', $filename or die "Cannot write to '$filename': $!\n";
print $fh $content;
close $fh;
warn "Changes saved to: $filename\n";
}
## Collect values and types from all configs for a given key.
##
## Arguments:
## $configs - Arrayref of hashrefs
## $key - Key to check in each config
##
## Returns:
## List: (\@values, \@types, $allExist)
sub collectConfigValues {
my ($configs, $key) = @_;
my @values;
my @types;
my $allExist = 1;
for my $i (0 .. $#$configs) {
my $config = $configs->[$i];
if (!exists $config->{$key}) {
push @values, undef;
push @types, 'missing';
$allExist = 0;
} else {
push @values, $config->{$key};
push @types, ref($config->{$key}) || 'scalar';
}
}
return (\@values, \@types, $allExist);
}
## Format value for display in comparison report.
##
## Arguments:
## $value - Value to format
## $path - Path string for the value
##
## Returns:
## String representation of value
sub formatValueForComparison {
my ($value, $path) = @_;
if (!defined($value)) {
return '<missing>';
} elsif (ref($value)) {
return "key: $path [" . ref($value) . "]";
} else {
return "key: $path '$value'";
}
}
## Record a difference between config files.
##
## Arguments:
## $diffs - Arrayref to append difference to
## $path - String path to the difference
## $values - Arrayref of values from each config
## $filenames - Arrayref of filenames
## $diffType - 'missing' or 'different'
##
## Returns:
## Nothing (modifies $diffs in place)
sub recordDifference {
my ($diffs, $path, $values, $filenames, $diffType) = @_;
my %fileValues;
for my $i (0 .. $#$filenames) {
$fileValues{$filenames->[$i]} = formatValueForComparison($values->[$i], $path);
}
push @$diffs, {
path => $path,
values => \%fileValues,
diffType => $diffType
};
}
## Check if all elements in array have the same type.
##
## Arguments:
## $types - Arrayref of type strings
##
## Returns:
## Boolean: true if all types match
sub allSameType {
my ($types) = @_;
my $firstType = $types->[0];
for my $type (@$types) {
return 0 if $type ne $firstType;
}
return 1;
}
## Compare scalar values across configs.
##
## Arguments:
## $values - Arrayref of scalar values
## $filenames - Arrayref of filenames
## $path - Current path string
## $diffs - Arrayref to collect differences
##
## Returns:
## Nothing (modifies $diffs in place)
sub compareScalarValues {
my ($values, $filenames, $path, $diffs) = @_;
my $firstVal = $values->[0];
my $allSame = 1;
for my $val (@$values) {
if (!defined($val) || !defined($firstVal) || $val ne $firstVal) {
$allSame = 0;
last;
}
}
recordDifference($diffs, $path, $values, $filenames, 'different') unless $allSame;
}
## Compare array elements across configs.
##
## Arguments:
## $values - Arrayref of arrayrefs to compare
## $configs - Arrayref of config hashrefs
## $filenames - Arrayref of filenames
## $path - Current path string
## $diffs - Arrayref to collect differences
##
## Returns:
## Nothing (modifies $diffs in place)
sub compareArrayElements {
my ($values, $configs, $filenames, $path, $diffs) = @_;
# Find maximum array length
my $maxLen = 0;
$maxLen = @$_ > $maxLen ? @$_ : $maxLen for @$values;
# Compare each index position
for my $idx (0 .. $maxLen - 1) {
my @elemValues;
my @elemTypes;
my $allElemExist = 1;
# Collect values at this index from all configs
for my $i (0 .. $#$configs) {
if ($idx >= @{$values->[$i]}) {
push @elemValues, undef;
push @elemTypes, 'missing';
$allElemExist = 0;
} else {
push @elemValues, $values->[$i]->[$idx];
push @elemTypes, ref($values->[$i]->[$idx]) || 'scalar';
}
}
my $arrayPath = "$path\[$idx\]";
# Handle missing elements
if (!$allElemExist) {
recordDifference($diffs, $arrayPath, \@elemValues, $filenames, 'missing');
next;
}
# Handle type mismatches
if (!allSameType(\@elemTypes)) {
recordDifference($diffs, $arrayPath, \@elemValues, $filenames, 'different');
next;
}
# Recurse based on type
my $firstElemType = $elemTypes[0];
if ($firstElemType eq 'HASH') {
compareConfigs(\@elemValues, $filenames, $arrayPath, $diffs);
} elsif ($firstElemType eq 'ARRAY') {
compareConfigs(\@elemValues, $filenames, $arrayPath, $diffs);
} elsif ($firstElemType eq 'scalar') {
compareScalarValues(\@elemValues, $filenames, $arrayPath, $diffs);
}
}
}
## Recursively compare multiple config structures.
## Identifies keys that exist in some configs but not others,
## and values that differ across configs.
##
## Arguments:
## $configs - Arrayref of hashrefs, each representing a config file
## $filenames - Arrayref of filenames corresponding to each config
## $path - Current path string (default '')
## $diffs - Arrayref to collect differences (default [])
##
## Returns:
## Arrayref of hashrefs, each describing a difference with keys:
## path - String path to the differing value
## values - Hashref mapping filename to value at that path
## diffType - 'missing' (key absent in some files) or 'different' (values differ)
sub compareConfigs {
my ($configs, $filenames, $path, $diffs) = @_;
$path //= '';
$diffs //= [];
# Collect all unique keys across all configs
my %allKeys;
for my $config (@$configs) {
next unless ref($config) eq 'HASH';
$allKeys{$_} = 1 for keys %$config;
}
# Check each key across all configs
for my $key (sort keys %allKeys) {
my $currentPath = $path ? "$path.$key" : $key;
my ($values, $types, $allExist) = collectConfigValues($configs, $key);
# If key missing from some configs, record it
if (!$allExist) {
recordDifference($diffs, $currentPath, $values, $filenames, 'missing');
next;
}
# Check if all values are the same type
if (!allSameType($types)) {
recordDifference($diffs, $currentPath, $values, $filenames, 'different');
} elsif ($types->[0] eq 'HASH') {
# All are hashes - recurse
compareConfigs($values, $filenames, $currentPath, $diffs);
} elsif ($types->[0] eq 'ARRAY') {
# All are arrays - compare by index
compareArrayElements($values, $configs, $filenames, $currentPath, $diffs);
} elsif ($types->[0] eq 'scalar') {
# All are scalars - compare values
compareScalarValues($values, $filenames, $currentPath, $diffs);
}
}
return $diffs;
}
## Generate a formatted comparison report.
## Creates a readable report showing all differences between config files.
##
## Arguments:
## $diffs - Arrayref of difference records from compareConfigs()
## $filenames - Arrayref of config filenames
##
## Returns:
## String containing formatted report
sub generateComparisonReport {
my ($diffs, $filenames) = @_;
my $report = "\n" . "=" x 80 . "\n";
$report .= "Configuration Comparison Report\n";
$report .= "=" x 80 . "\n\n";
$report .= "Comparing files:\n";
for my $i (0 .. $#$filenames) {
$report .= sprintf " [%d] %s\n", $i + 1, $filenames->[$i];
}
$report .= "\n";
if (@$diffs == 0) {
$report .= "No differences found. All config files are identical.\n\n";
return $report;
}
$report .= sprintf "Found %d difference%s:\n\n", scalar(@$diffs), @$diffs == 1 ? '' : 's';
for my $i (0 .. $#$diffs) {
my $diff = $diffs->[$i];
$report .= sprintf "[%d] Path: %s\n", $i + 1, $diff->{path};
$report .= sprintf " Type: %s\n", $diff->{diffType} eq 'missing' ? 'Key missing in some files' : 'Different values';
for my $filename (sort keys %{$diff->{values}}) {
$report .= sprintf " %-40s %s\n", $filename . ':', $diff->{values}->{$filename};
}
$report .= "\n";
}
$report .= "=" x 80 . "\n";
return $report;
}
# ============================================================================
# MAIN
# ============================================================================
my $opts = parseCommandLine();
# Comparison mode - load multiple configs and compare
if ($opts->{compareMode}) {
my @configs;
my @formats;
for my $configFile (@{$opts->{configFiles}}) {
my ($config, $format) = loadConfig($configFile);
push @configs, $config;
push @formats, $format;
}
my $diffs = compareConfigs(\@configs, $opts->{configFiles});
my $report = generateComparisonReport($diffs, $opts->{configFiles});
if ($opts->{outputFile}) {
writeOutput($report, $opts->{outputFile});
} else {
print $report;
}
exit 0;
}
# Normal mode - single config file with optional template
my $template = loadTemplate($opts->{templateFile});
my $configFile = @{$opts->{configFiles}} > 0 ? $opts->{configFiles}->[0] : undef;
my ($config, $outputFormat) = loadConfig($configFile);
my ($merged, $messages) = mergeConfigs($template, $config, $opts->{templateFile}, $configFile);
outputMessages($messages);
# Enter interactive edit mode if requested
if ($opts->{editMode}) {
print "\n*** Interactive Edit Mode ***\n";
print "Navigate through the configuration and edit values.\n";
print "Commands: select number to edit, 0=back, q=quit\n";
editHash($merged);
print "\n*** Exiting Edit Mode ***\n\n";
}
# Determine output format - if output file specified, use its extension
if ($opts->{outputFile}) {
$outputFormat = detectFileFormat($opts->{outputFile});
}
my $outputContent = formatOutput($merged, $outputFormat);
# Handle output based on whether output file is specified
if ($opts->{outputFile}) {
# Output file specified, write directly
writeOutput($outputContent, $opts->{outputFile});
} elsif ($configFile && promptSave()) {
# No output file, but config file exists and user wants to save
backupAndSave($configFile, $outputContent);
} else {
# No output file and either no config or user declined save, output to STDOUT
writeOutput($outputContent, undef);
}
Generated by GNU Enscript 1.6.5.90.