lib/Object/Configure.pm

        start → end → jump
        

    1: package Object::Configure;
    2: 
    3: use strict;
    4: use warnings;
    5: 
    6: use Carp;
    7: use Config::Abstraction 0.38;
    8: use File::Spec;
    9: use Log::Abstraction 0.26;
   10: use Params::Get 0.13;
   11: use Return::Set;
   12: use Scalar::Util qw(blessed weaken);
   13: use Time::HiRes qw(time);
   14: use File::stat;
   15: 
   16: # Global registry to track configured objects for hot reload
   17: our %_object_registry = ();
   18: our %_config_watchers = ();
   19: our %_config_file_stats = ();
   20: 
   21: # Keep track of the original USR1 handler for chaining
   22: our $_original_usr1_handler;
   23: 
   24: =head1 NAME
   25: 
   26: Object::Configure - Runtime Configuration for an Object
   27: 
   28: =head1 VERSION
   29: 
   30: 0.21
   31: 
   32: =cut
   33: 
   34: our $VERSION = 0.21;
   35: 
   36: =head1 SYNOPSIS
   37: 
   38: The C<Object::Configure> module is a lightweight utility designed to inject runtime parameters into other classes,
   39: primarily by layering configuration and logging support,
   40: when instatiating objects.
   41: 
   42: L<Log::Abstraction> and L<Config::Abstraction> are modules developed to solve a specific need,
   43: runtime configurability without needing to rewrite or hardcode behaviours.
   44: The goal is to allow individual modules to enable or disable features on the fly,
   45: and to do it using whatever configuration system the user prefers.
   46: 
   47: Although the initial aim was general configurability,
   48: the primary use case that's emerged has been fine-grained logging control,
   49: more flexible and easier to manage than what you'd typically do with L<Log::Log4perl>.
   50: For example,
   51: you might want one module to log verbosely while another stays quiet,
   52: and be able to toggle that dynamically - without making invasive changes to each module.
   53: 
   54: To tie it all together,
   55: there is C<Object::Configure>.
   56: It sits on L<Log::Abstraction> and L<Config::Abstraction>,
   57: and with just a couple of extra lines in a class constructor,
   58: you can hook in this behaviour seamlessly.
   59: The intent is to keep things modular and reusable,
   60: especially across larger systems or in situations where you want user-selectable behaviour.
   61: 
   62: Add this to your constructor:
   63: 
   64:    package My::Module;
   65: 
   66:    use Object::Configure;
   67:    use Params::Get;
   68: 
   69:    sub new {
   70:         my $class = shift;
   71:         my $params = Object::Configure::configure($class, @_ ? \@_ : undef);	# Reads in the runtime configuration settings
   72:         # or my $params = Object::Configure::configure($class, { @_ });
   73: 
   74:         return bless $params, $class;
   75:     }
   76: 
   77: Throughout your class, add code such as:
   78: 
   79:     sub method
   80:     {
   81:         my $self = shift;
   82: 
   83:         $self->{'logger'}->trace(ref($self), ': ', __LINE__, ' entering method');
   84:     }
   85: 
   86: =head3 CONFIGURATION INHERITANCE
   87: 
   88: C<Object::Configure> supports configuration inheritance, allowing child classes to inherit and override configuration settings from their parent classes.
   89: When a class is configured, the module automatically traverses the inheritance hierarchy (using C<@ISA>) and loads configuration files for each ancestor class in the chain.
   90: 
   91: Configuration files are loaded in order from the most general (base class) to the most specific (child class), with later files overriding earlier ones. For example, if C<My::Child::Class> inherits from C<My::Parent::Class>, which inherits from C<My::Base::Class>, the module will:
   92: 
   93: =over 4
   94: 
   95: =item 1. Load C<my-base-class.yml> (or .conf, .json, etc.) if it exists
   96: 
   97: =item 2. Load C<my-parent-class.yml> if it exists, overriding base settings
   98: 
   99: =item 3. Load C<my-child-class.yml>, overriding both parent and base settings
  100: 
  101: =back
  102: 
  103: The configuration files should be named using lowercase versions of the class name with C<::> replaced by hyphens (C<->).
  104: For example, C<My::Parent::Class> would use C<my-parent-class.yml>.
  105: 
  106: This allows you to define common settings in a base class configuration file and selectively override them in child class configurations, promoting DRY (Don't Repeat Yourself) principles and making it easier to manage configuration across class hierarchies.
  107: 
  108: Example:
  109: 
  110:     # File: ~/.conf/my-base-class.yml
  111:     ---
  112:     My__Base__Class:
  113:       timeout: 30
  114:       retries: 3
  115:       log_level: info
  116: 
  117:     # File: ~/.conf/my-child-class.yml
  118:     ---
  119:     My__Child__Class:
  120:       timeout: 60
  121:       # Inherits retries: 3 and log_level: info from parent
  122: 
  123:     # Result: Child class gets timeout=60, retries=3, log_level=info
  124: 
  125: Parent configuration files are optional.
  126: If a parent class's configuration file doesn't exist, the module simply skips it and continues up the inheritance chain.
  127: All discovered configuration files are tracked in the C<_config_files> array for hot reload support.
  128: 
  129: =head3 UNIVERSAL CONFIGURATION
  130: 
  131: All Perl classes implicitly inherit from C<UNIVERSAL>.
  132: C<Object::Configure> takes advantage of this to provide a mechanism for universal configuration settings
  133: that apply to all classes by default.
  134: 
  135: If you create a configuration file named C<universal.yml> (or C<universal.conf>, C<universal.json>, etc.)
  136: in your configuration directory,
  137: the settings in its C<UNIVERSAL> section will be inherited by all classes that use C<Object::Configure>,
  138: unless explicitly overridden by class-specific configuration files.
  139: 
  140: This is particularly useful for setting application-wide defaults such as logging levels,
  141: timeout values,
  142: or other common parameters that should apply across all modules.
  143: 
  144: Example C<~/.conf/universal.yml>:
  145: 
  146:     ---
  147:     UNIVERSAL:
  148:       timeout: 30
  149:       retries: 3
  150:       logger:
  151:         level: info
  152: 
  153: With this universal configuration file in place,
  154: all classes will inherit these default values.
  155: Individual classes can override any of these settings in their own configuration files:
  156: 
  157: Example C<~/.conf/my-special-class.yml>:
  158: 
  159:     ---
  160:     My__Special__Class:
  161:       timeout: 120
  162:       # Inherits retries: 3 and logger.level: info from UNIVERSAL
  163: 
  164: The universal configuration is loaded first in the inheritance chain,
  165: followed by parent class configurations,
  166: and finally the specific class configuration,
  167: with later configurations overriding earlier ones.
  168: 
  169: =head2 CHANGING BEHAVIOUR AT RUN TIME
  170: 
  171: =head3 USING A CONFIGURATION FILE
  172: 
  173: To control behavior at runtime, C<Object::Configure> supports loading settings from a configuration file via L<Config::Abstraction>.
  174: 
  175: A minimal example of a config file (C<~/.conf/local.conf>) might look like:
  176: 
  177:    [My__Module]
  178:    logger.file = /var/log/mymodule.log
  179: 
  180: The C<configure()> function will read this file,
  181: overlay it onto your default parameters,
  182: and initialize the logger accordingly.
  183: 
  184: If the file is not readable and no config_dirs are provided,
  185: the module will throw an error.
  186: To be clear, in this case, inheritance is not followed.
  187: 
  188: This mechanism allows dynamic tuning of logging behavior (or other parameters you expose) without modifying code.
  189: 
  190: More details to be written.
  191: 
  192: =head3 USING ENVIRONMENT VARIABLES
  193: 
  194: C<Object::Configure> also supports runtime configuration via environment variables,
  195: without requiring a configuration file.
  196: 
  197: Environment variables are read automatically when you use the C<configure()> function,
  198: thanks to its integration with L<Config::Abstraction>.
  199: These variables should be prefixed with your class name, followed by a double colon.
  200: 
  201: For example, to enable syslog logging for your C<My::Module> class,
  202: you could set:
  203: 
  204:     export My__Module__logger__file=/var/log/mymodule.log
  205: 
  206: This would be equivalent to passing the following in your constructor:
  207: 
  208:      My::Module->new(logger => Log::Abstraction->new({ file => '/var/log/mymodule.log' });
  209: 
  210: All environment variables are read and merged into the default parameters under the section named after your class.
  211: This allows centralized and temporary control of settings (e.g., for production diagnostics or ad hoc testing) without modifying code or files.
  212: 
  213: Note that environment variable settings take effect regardless of whether a configuration file is used,
  214: and are applied during the call to C<configure()>.
  215: 
  216: More details to be written.
  217: 
  218: =head2 HOT RELOAD
  219: 
  220: Hot reload is not supported on Windows.
  221: 
  222: =head3 Basic Hot Reload Setup
  223: 
  224:     package My::App;
  225:     use Object::Configure;
  226: 
  227:     sub new {
  228:         my $class = shift;
  229:         my $params = Object::Configure::configure($class, @_ ? \@_ : undef);
  230:         my $self = bless $params, $class;
  231: 
  232:         # Register for hot reload
  233:         Object::Configure::register_object($class, $self) if $params->{_config_file};
  234: 
  235:         return $self;
  236:     }
  237: 
  238:     # Optional: Define a reload hook
  239:     sub _on_config_reload {
  240:         my ($self, $new_config) = @_;
  241:         print "My::App config was reloaded!\n";
  242:         # Custom reload logic here
  243:     }
  244: 
  245: =head3 Enable Hot Reload in Your Main Application
  246: 
  247:     # Enable hot reload with custom callback
  248:     Object::Configure::enable_hot_reload(
  249:         interval => 5,  # Check every 5 seconds
  250:         callback => sub {
  251:             print "Configuration files have been reloaded!\n";
  252:         }
  253:     );
  254: 
  255:     # Your application continues running...
  256:     # Config changes will be automatically detected and applied
  257: 
  258: =head3 Manual Reload
  259: 
  260:     # Manually trigger a reload
  261:     my $count = Object::Configure::reload_config();
  262:     print "Reloaded configuration for $count objects\n";
  263: 
  264: =encoding utf8
  265: 
  266: =head1 SUBROUTINES/METHODS
  267: 
  268: =head2 configure
  269: 
  270: Configure your class at runtime with hot reload support.
  271: 
  272: Takes arguments:
  273: 
  274: =over 4
  275: 
  276: =item * C<class>
  277: 
  278: =item * C<params>
  279: 
  280: A hashref containing default parameters to be used in the constructor.
  281: 
  282: =item * C<carp_on_warn>
  283: 
  284: If set to 1, call C<Carp::carp> on C<warn()>.
  285: This value is also read from the configuration file,
  286: which will take precedence.
  287: The default is 0.
  288: 
  289: =item * C<croak_on_error>
  290: 
  291: If set to 1, call C<Carp::croak> on C<error()>.
  292: This value is also read from the configuration file,
  293: which will take precedence.
  294: The default is 1.
  295: 
  296: =item * C<logger>
  297: 
  298: The logger to use.
  299: If none is given, an instatiation of L<Log::Abstraction> will be created, unless the logger is set to NULL.
  300: 
  301: =item * C<schema>
  302: 
  303: A L<Params::Validate::Strict> compatible schema to validate the configuration file against.
  304: 
  305: =back
  306: 
  307: Returns a hash ref containing the new values for the constructor.
  308: 
  309: Now you can set up a configuration file and environment variables to configure your object.
  310: 
  311: =head3 API Specification
  312: 
  313: =head4 Input
  314: 
  315:     schema => {
  316:         class => {
  317:             type => 'string',
  318:             required => 1,
  319:             description => 'Fully-qualified class name'
  320:         },
  321:         params => {
  322:             type => 'hashref',
  323:             optional => 1,
  324:             default => {},
  325:             schema => {
  326:                 config_file => {
  327:                     type => 'string',
  328:                     optional => 1,
  329:                     description => 'Configuration file basename'
  330:                 }, config_dirs => {
  331:                     type => 'arrayref',
  332:                     optional => 1,
  333:                     description => 'Directories to search for config files'
  334:                 }, logger => {
  335:                     type => [qw(hashref coderef object string arrayref)],
  336:                     optional => 1,
  337:                     description => 'Logger configuration or instance'
  338:                 }, carp_on_warn => {
  339:                     type => 'boolean',
  340:                     optional => 1,
  341:                     default => 0,
  342:                     description => 'Use Carp::carp for warnings'
  343:                 }, croak_on_error => {
  344:                     type => 'boolean',
  345:                     optional => 1,
  346:                     default => 1,
  347:                     description => 'Use Carp::croak for errors'
  348:                 }
  349:             }
  350:         }
  351:     }
  352: 
  353: =head4 Output
  354: 
  355:     type => 'hashref',
  356:     description => 'Merged configuration parameters',
  357:     schema => {
  358:         logger => {
  359:             type => 'object',
  360:             isa => 'Log::Abstraction',
  361:             description => 'Initialized logger instance'
  362:         },
  363:         _config_file => {
  364:             type => 'string',
  365:             optional => 1,
  366:             description => 'Primary configuration file path'
  367:         },
  368:         _config_files => {
  369:             type => 'arrayref',
  370:             optional => 1,
  371:             description => 'All loaded configuration file paths'
  372:         }
  373:     }
  374: 
  375: =head3 Formal Specification
  376: 
  377:     configure: Class × Params → ConfigHash
  378: 
  379:     Given:
  380:     - C: set of all class names
  381:     - P: set of all parameter hashes
  382:     - F: set of all file paths
  383:     - H: set of all configuration hashes
  384: 
  385:     State:
  386:     - ConfigFiles: F → H (maps file paths to configuration content)
  387:     - EnvVars: String → String (environment variables)
  388:     - InheritanceChain: C → seq C (ordered sequence of ancestor classes)
  389: 
  390:     Pre-condition:
  391:     ∀ class ∈ C, params ∈ P •
  392:         class ≠ ∅ ∧
  393:         (params.config_file ≠ ∅ ⇒
  394:             (∃ dir ∈ params.config_dirs • readable(dir/params.config_file)) ∨
  395:             readable(params.config_file))
  396: 
  397:     Post-condition:
  398:     ∀ result ∈ H •
  399:         result = params ⊕
  400:                  (⊕ f ∈ InheritanceConfigFiles(class) • ConfigFiles(f)) ⊕
  401:                  (⊕ v ∈ RelevantEnvVars(class) • v) ∧
  402:         result.logger ∈ Log::Abstraction ∧
  403:         (∀ k ∈ dom params •
  404:             (params(k) ∈ CodeRef ∨ blessed(params(k))) ⇒ result(k) = params(k))
  405: 
  406:     where ⊕ denotes hash merge with right-precedence
  407: 
  408: =cut
  409: 
  410: sub configure {
●411 → 426 → 434●411 → 426 → 0  411: 	my $class = $_[0];
  412: 	my $params = $_[1] || {};	# Contains the defaults, the run time config will overwrite them
  413: 	my $array;
  414: 
  415: 	croak(__PACKAGE__, ': configure: what class do you want to configure?') if(!defined($class) || $class eq '');
  416: 
  417: 	# Stash coderefs and blessed objects EXCEPT logger (which needs special handling)
  418: 
  419: 	# Config::Abstraction treats unknown scalar values as config file paths and will
  420: 	# attempt to read them, which corrupts coderefs and object references.
  421: 	# We must remove these from $params before calling configure(), then restore them
  422: 	# afterward. The logger parameter has its own special handling below, so we skip it here.
  423: 	# This automatic stashing means users don't need to implement the stash-delete-restore
  424: 	# pattern in their own constructors.
  425: 	my %stashed_values;
  426: 	foreach my $key (keys %$params) {
  427: 		next if $key eq 'logger';	# logger has its own special handling below
  428: 		my $value = $params->{$key};
  429: 		if(ref($value) eq 'CODE' || blessed($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  430: 			$stashed_values{$key} = delete $params->{$key};
  431: 		}
  432: 	}
  433: 
●434 → 434 → 438●434 → 434 → 0  434: 	if(exists($params->{'logger'}) && (ref($params->{'logger'}) eq 'ARRAY')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  435: 		$array = delete $params->{'logger'};
  436: 	}
  437: 
●438 → 452 → 517●438 → 452 → 0  438: 	my $original_class = $class;
  439: 	$class =~ s/::/__/g;
  440: 
  441: 	# Store config file path for hot reload
  442: 	my $config_file = $params->{'config_file'};
  443: 	my $config_dirs = $params->{'config_dirs'};
  444: 
  445: 	# Get inheritance chain for finding ancestor config files
  446: 	my @inheritance_chain = _get_inheritance_chain($original_class);
  447: 
  448: 	# Build list of config files to load (ancestor to child order)
  449: 	my @config_files_to_load = ();
  450: 	my %tracked_files = ();
  451: 
  452: 	if ($config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  453: 		# Check if primary config file is readable (unless config_dirs provided)
  454: 		if ((!$config_dirs) && (!-r $config_file)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  455: 			croak("$class: ", $config_file, ": $!");
  456: 		}
  457: 
  458: 		# Find config files for each class in the hierarchy
  459: 		# Important: iterate in reverse order (base -> parent -> child)
  460: 		foreach my $ancestor_class (reverse @inheritance_chain) {
  461: 			my $ancestor_config_file = _find_class_config_file(
  462: 				$ancestor_class,
  463: 				$config_file,
  464: 				$config_dirs
  465: 			);
  466: 
  467: 			# Skip if this is the primary config file - it will be added at the end
  468: 			if ($ancestor_config_file && $ancestor_config_file eq $config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  469: 				next;
  470: 			}
  471: 
  472: 			# Only add if we found a file and haven't already added it
  473: 			if ($ancestor_config_file && -r $ancestor_config_file && !$tracked_files{$ancestor_config_file}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  474: 				push @config_files_to_load, {
  475: 					file => $ancestor_config_file,
  476: 					class => $ancestor_class
  477: 				};
  478: 				$tracked_files{$ancestor_config_file} = 1;
  479: 
  480: 				# Track for hot reload
  481: 				if (-f $ancestor_config_file) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_481_5: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  482: 					$_config_file_stats{$ancestor_config_file} = stat($ancestor_config_file);
  483: 				}
  484: 			}
  485: 		}
  486: 
  487: 		# Ensure the primary config file is included LAST (highest priority)
  488: 		# This handles the case where the primary file doesn't match the class name pattern
  489: 		if ($config_file && !$tracked_files{$config_file} && -r $config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  490: 			push @config_files_to_load, {
  491: 				file => $config_file,
  492: 				class => $original_class
  493: 			};
  494: 			$tracked_files{$config_file} = 1;
  495: 
  496: 			if (-f $config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  497: 				$_config_file_stats{$config_file} = stat($config_file);
  498: 			}
  499: 		}
  500: 
  501: 		if(!scalar(@config_files_to_load)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  502: 			# Can't find an inheritence tree
  503: 			foreach my $dir(@{$config_dirs}) {
  504: 				my $candidate = File::Spec->catfile($dir, $config_file);
  505: 				if(-r $candidate) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  506: 					push @config_files_to_load, {
  507: 						file => $candidate,
  508: 						class => $original_class
  509: 					};
  510: 					last;  # CRITICAL: Stop at first readable file
  511: 				}
  512: 			}
  513: 		}
  514: 	}
  515: 
  516: 	# Load and merge configurations from all files
●517 → 517 → 603●517 → 517 → 0  517: 	if (@config_files_to_load) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  518: 		# Sort by class hierarchy to ensure correct order (base -> parent -> child)
  519: 		# This must happen AFTER all files are collected
  520: 		if (@config_files_to_load) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  521: 			my %class_order;
  522: 			for my $i (0..$#inheritance_chain) {
  523: 				$class_order{$inheritance_chain[$i]} = $i;
  524: 			}
  525: 			@config_files_to_load = sort {
  526: 				($class_order{$a->{class}} // 999) <=> ($class_order{$b->{class}} // 999)
  527: 			} @config_files_to_load;
  528: 		}
  529: 
  530: 		# Start with the passed-in defaults
  531: 		my $merged_params = { %$params };
  532: 
  533: 		foreach my $config_info (@config_files_to_load) {
  534: 			my $cfg_file = $config_info->{file};
  535: 			my $cfg_class = $config_info->{class};
  536: 			my $section_name = $cfg_class;
  537: 			$section_name =~ s/::/__/g;
  538: 
  539: 			# When loading individual config files for inheritance,
  540: 			# don't pass config_dirs - just load the specific file
  541: 			my $config = Config::Abstraction->new(
  542: 				config_file => $cfg_file,
  543: 				env_prefix => "${section_name}__"
  544: 			);
  545: 
  546: 			if ($config) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  547: 				# Get this config file's values for the section
  548: 				my $this_config = $config->merge_defaults(
  549: 					defaults => {},
  550: 					section => $section_name,
  551: 					merge => 1,
  552: 					deep => 1
  553: 				);
  554: 
  555: 				# Deep merge: later configs override earlier ones
  556: 				$merged_params = _deep_merge($merged_params, $this_config);
  557: 			} elsif ($@) {
  558: 				carp("Warning: Can't load configuration from $cfg_file: $@");
  559: 			}
  560: 		}
  561: 
  562: 		$params = $merged_params;
  563: 	} elsif (my $config = Config::Abstraction->new(env_prefix => "${class}__")) {
  564: 		# Handle environment variables with inheritance
  565: 		my $merged_config = {};
  566: 
  567: 		# Merge ancestor configurations from environment
  568: 		foreach my $ancestor_class (reverse @inheritance_chain) {
  569: 			my $section_name = $ancestor_class;
  570: 			$section_name =~ s/::/__/g;
  571: 
  572: 			my $ancestor_env_config = Config::Abstraction->new(
  573: 				env_prefix => "${section_name}__"
  574: 			);
  575: 
  576: 			if ($ancestor_env_config) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  577: 				my $ancestor_config = $ancestor_env_config->merge_defaults(
  578: 					defaults => {},
  579: 					section => $section_name,
  580: 					merge => 1,
  581: 					deep => 1
  582: 				);
  583: 				$merged_config = _deep_merge($merged_config, $ancestor_config);
  584: 			}
  585: 		}
  586: 
  587: 		$params = $config->merge_defaults(
  588: 			defaults => $params,
  589: 			section => $class,
  590: 			merge => 1,
  591: 			deep => 1
  592: 		);
  593: 
  594: 		# Apply inherited config
  595: 		$params = _deep_merge($merged_config, $params);
  596: 
  597: 		# Track this config file for hot reload
  598: 		if ($params->{config_path} && -f $params->{config_path}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_598_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  599: 			$_config_file_stats{$params->{config_path}} = stat($params->{config_path});
  600: 		}
  601: 	}
  602: 
●603 → 607 → 640●603 → 607 → 0  603: 	my $croak_on_error = exists($params->{'croak_on_error'}) ? $params->{'croak_on_error'} : 1;
  604: 	my $carp_on_warn = exists($params->{'carp_on_warn'}) ? $params->{'carp_on_warn'} : 0;
  605: 
  606: 	# Load the default logger
  607: 	if (my $logger = $params->{'logger'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  608: 		if(!ref($logger) && $logger eq 'NULL') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  609: 			# Explicitly keep NULL - do not create a logger
  610: 			# The logger param stays as the string 'NULL'
  611: 		} elsif(ref($logger) eq 'HASH') {
  612: 			if(exists $logger->{'syslog'}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_612_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  613: 				$params->{'logger'} = Log::Abstraction->new({
  614: 					carp_on_warn => $carp_on_warn,
  615: 					syslog => $logger->{'syslog'},
  616: 					%{$logger}
  617: 				});
  618: 			} else {
  619: 				$params->{'logger'} = Log::Abstraction->new({
  620: 					carp_on_warn => $carp_on_warn,
  621: 					%{$logger}
  622: 				});
  623: 			}
  624: 		} elsif(!blessed($logger) || !$logger->isa('Log::Abstraction')) {
  625: 			$params->{'logger'} = Log::Abstraction->new({
  626: 				carp_on_warn => $carp_on_warn,
  627: 				logger => $logger
  628: 			});
  629: 		}
  630: 	} elsif ($array) {
  631: 		$params->{'logger'} = Log::Abstraction->new(
  632: 			array => $array,
  633: 			carp_on_warn => $carp_on_warn
  634: 		);
  635: 		undef $array;
  636: 	} else {
  637: 		$params->{'logger'} = Log::Abstraction->new(carp_on_warn => $carp_on_warn);
  638: 	}
  639: 
●640 → 640 → 652●640 → 640 → 0  640: 	if(exists($params->{'logger'}) && ref($params->{'logger'})) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_640_2: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  641: 		if ($array && !$params->{'logger'}->{'array'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  642: 			$params->{'logger'}->{'array'} = $array;
  643: 		}
  644: 
  645: 		if ($array && !$params->{'logger'}->{'array'}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  646: 			$params->{'logger'}->{'array'} = $array;
  647: 		}
  648: 	}
  649: 
  650: 	# Store config file path in params for hot reload
  651: 	# Preserve user-provided internal keys
●652 → 652 → 655●652 → 652 → 0  652: 	if (!exists($params->{_config_file})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  653: 		$params->{_config_file} = $config_file if defined($config_file);
  654: 	}
●655 → 655 → 660●655 → 655 → 0  655: 	if (!exists($params->{_config_files})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  656: 		$params->{_config_files} = [map { $_->{file} } @config_files_to_load] if @config_files_to_load;
  657: 	}
  658: 
  659: 	# Restore stashed coderefs and objects via hash slice
●660 → 662 → 0  660: 	@{$params}{keys %stashed_values} = values %stashed_values if %stashed_values;
  661: 
  662: 	return Return::Set::set_return($params, { 'type' => 'hashref' });
  663: }
  664: 
  665: # Find the appropriate config file for a given class
  666: # Looks for class-specific config files based on naming conventions
  667: sub _find_class_config_file {
●668 → 690 → 697●668 → 690 → 0  668: 	my ($class, $base_config_file, $config_dirs) = @_;
  669: 
  670: 	# Convert class name to file-friendly format
  671: 	my $class_file = lc($class);
  672: 	$class_file =~ s/::/-/g;
  673: 
  674: 	# Extract directory and extension from base config file using File::Spec
  675: 	# so that path separators are handled correctly on all platforms
  676: 	my ($base_vol, $base_dir_part, $base_name_ext) = File::Spec->splitpath($base_config_file);
  677: 	my (undef, $base_ext) = $base_name_ext =~ /^(.*?)(\.[^.]+)?$/;
  678: 	$base_ext //= '';	# $2 is undef when there is no extension
  679: 	my $base_dir = File::Spec->catpath($base_vol, $base_dir_part, '');
  680: 
  681: 	# Try base directory patterns first
  682: 	my @base_patterns = (
  683: 		File::Spec->catfile($base_dir, "${class_file}${base_ext}"),
  684: 		File::Spec->catfile($base_dir, "${class_file}.conf"),
  685: 		File::Spec->catfile($base_dir, "${class_file}.yml"),
  686: 		File::Spec->catfile($base_dir, "${class_file}.yaml"),
  687: 		File::Spec->catfile($base_dir, "${class_file}.json"),
  688: 	);
  689: 
  690: 	foreach my $pattern (@base_patterns) {
  691: 		if (-r $pattern && -f $pattern) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  692: 			return $pattern;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  693: 		}
  694: 	}
  695: 
  696: 	# Then try config_dirs in order - fully check each dir before moving to next
●697 → 697 → 716●697 → 697 → 0  697: 	if ($config_dirs && ref($config_dirs) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  698: 		foreach my $dir (@$config_dirs) {
  699: 			# Remove trailing slash if present
  700: 			$dir =~ s{/$}{};
  701: 			my @dir_patterns = (
  702: 				"${dir}/${class_file}${base_ext}",
  703: 				"${dir}/${class_file}.conf",
  704: 				"${dir}/${class_file}.yml",
  705: 				"${dir}/${class_file}.yaml",
  706: 				"${dir}/${class_file}.json",
  707: 			);
  708: 			foreach my $pattern (@dir_patterns) {
  709: 				if (-r $pattern && -f $pattern) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  710: 					return $pattern;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  711: 				}
  712: 			}
  713: 		}
  714: 	}
  715: 
●716 → 716 → 0  716: 	return undef;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  717: }
  718: 
  719: # Helper function to get the inheritance chain for a class
  720: sub _get_inheritance_chain {
  721: 	my ($class) = @_;
  722: 	my @chain = ();
  723: 	my %seen = ();
  724: 
  725: 	_walk_isa($class, \@chain, \%seen);
  726: 
  727: 	return @chain;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  728: }
  729: 
  730: # Recursive function to walk the @ISA hierarchy
  731: sub _walk_isa {
●732 → 742 → 753●732 → 742 → 0  732: 	my ($class, $chain, $seen) = @_;
  733: 
  734: 	return if $seen->{$class}++;
  735: 
  736: 	# Get the @ISA array for this class
  737: 	no strict 'refs';
  738: 	my @isa = @{"${class}::ISA"};
  739: 	use strict 'refs';
  740: 
  741: 	# Recursively process parent classes first
  742: 	foreach my $parent (@isa) {
  743: 		# Skip common base classes that won't have configs
  744: 		# next if $parent eq 'Exporter';
  745: 		# next if $parent eq 'DynaLoader';
  746: 		# next if $parent eq 'UNIVERSAL';
  747: 
  748: 		_walk_isa($parent, $chain, $seen);
  749: 	}
  750: 
  751: 	# If this class has no parents and isn't UNIVERSAL itself,
  752: 	# explicitly add UNIVERSAL as a parent
●753 → 753 → 758●753 → 753 → 0  753: 	if (!@isa && $class ne 'UNIVERSAL') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  754: 		_walk_isa('UNIVERSAL', $chain, $seen);
  755: 	}
  756: 
  757: 	# Add current class to chain (after parents)
●758 → 758 → 0  758: 	push @$chain, $class;
  759: }
  760: 
  761: # Deep merge two hash references
  762: # Second hash takes precedence over first
  763: sub _deep_merge {
●764 → 771 → 779●764 → 771 → 0  764: 	my ($base, $overlay) = @_;
  765: 
  766: 	return $overlay unless ref($base) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
  767: 	return $overlay unless ref($overlay) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
  768: 
  769: 	my $result = { %$base };
  770: 
  771: 	foreach my $key (keys %$overlay) {
  772: 		if (ref($overlay->{$key}) eq 'HASH' && ref($result->{$key}) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  773: 			$result->{$key} = _deep_merge($result->{$key}, $overlay->{$key});
  774: 		} else {
  775: 			$result->{$key} = $overlay->{$key};
  776: 		}
  777: 	}
  778: 
●779 → 779 → 0  779: 	return $result;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  780: }
  781: 
  782: 
  783: =head2 instantiate($class,...)
  784: 
  785: Create and configure an object of a third-party class without modifying the class itself.
  786: 
  787: =head3 Purpose
  788: 
  789: Provides a convenient way to make third-party classes (those you cannot modify) configurable
  790: at runtime using Object::Configure. This is a wrapper that calls C<configure> and then
  791: instantiates the class.
  792: 
  793: =head3 Arguments
  794: 
  795: Takes a hash or hashref with the following keys:
  796: 
  797: =over 4
  798: 
  799: =item * C<class> (Required)
  800: 
  801: The fully-qualified class name to instantiate (e.g., C<'LWP::UserAgent'>).
  802: 
  803: =item * Additional keys
  804: 
  805: Any additional keys are passed through to C<configure> and then to the class constructor.
  806: 
  807: =back
  808: 
  809: =head3 Returns
  810: 
  811: A blessed object of the specified class, configured according to the parameters and
  812: configuration files.
  813: 
  814: =head3 Side Effects
  815: 
  816: =over 4
  817: 
  818: =item * Calls C<configure> (see its side effects)
  819: 
  820: =item * Calls the C<new> method on the specified class
  821: 
  822: =item * Registers the object for hot reload if a configuration file was used
  823: 
  824: =back
  825: 
  826: =head3 Notes
  827: 
  828: The specified class must have a C<new> method that accepts a hashref of parameters.
  829: This is a "quick and dirty" way to add configuration support to classes you don't control.
  830: 
  831: =head3 Usage Example
  832: 
  833:     use Object::Configure;
  834: 
  835:     # Configure LWP::UserAgent from a config file
  836:     my $ua = Object::Configure::instantiate(
  837:         class => 'LWP::UserAgent',
  838:         config_file => 'lwp.yml',
  839:         config_dirs => ['/etc/myapp'],
  840:         timeout => 30
  841:     );
  842: 
  843: =head3 API Specification
  844: 
  845: =head4 Input
  846: 
  847:     schema => {
  848:         class => {
  849:             type => 'string',
  850:             required => 1,
  851:             description => 'Class name to instantiate',
  852:             can => 'new'
  853:         }
  854:     }
  855: 
  856: =head4 Output
  857: 
  858:     type => 'object',
  859:     description => 'Instance of the specified class'
  860: 
  861: =head3 Formal Specification
  862: 
  863:     instantiate: Params → Object
  864: 
  865:     Given:
  866:     - P: set of all parameter hashes
  867:     - C: set of all class names
  868:     - O: set of all objects
  869: 
  870:     Pre-condition:
  871:     ∀ params ∈ P •
  872:         params.class ∈ C ∧
  873:         params.class.can('new')
  874: 
  875:     Post-condition:
  876:     ∀ result ∈ O •
  877:         ∃ config ∈ H •
  878:             config = configure(params.class, params) ∧
  879:             result = params.class.new(config) ∧
  880:             blessed(result) = params.class ∧
  881:             (config._config_file ≠ ∅ ⇒
  882:                 result ∈ _object_registry(params.class))
  883: 
  884: =cut
  885: 
  886: sub instantiate
  887: {
●888 → 896 → 900●888 → 896 → 0  888: 	my $params = Params::Get::get_params('class', @_);
  889: 
  890: 	my $class = $params->{'class'};
  891: 	$params = configure($class, $params);
  892: 
  893: 	my $obj = $class->new($params);
  894: 
  895: 	# Register object for hot reload if config file is used
  896: 	if ($params->{_config_file}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  897: 		register_object($class, $obj);
  898: 	}
  899: 
●900 → 900 → 0  900: 	return $obj;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  901: }
  902: 
  903: =head1 HOT RELOAD FEATURES
  904: 
  905: =head2 enable_hot_reload
  906: 
  907: Enable automatic hot reloading of configuration files when they are modified.
  908: 
  909: =head3 Purpose
  910: 
  911: Starts a background process that monitors configuration files for changes and automatically
  912: reloads them into registered objects. This allows runtime configuration updates without
  913: restarting the application.
  914: 
  915: =head3 Arguments
  916: 
  917: Takes a hash with the following optional keys:
  918: 
  919: =over 4
  920: 
  921: =item * C<interval> (Optional, default: 10)
  922: 
  923: Number of seconds between configuration file checks. Lower values provide faster
  924: response to changes but consume more CPU.
  925: 
  926: =item * C<callback> (Optional)
  927: 
  928: A coderef to execute after configuration files are reloaded. Useful for logging
  929: or triggering application-specific reload behavior.
  930: 
  931: =back
  932: 
  933: =head3 Returns
  934: 
  935: The process ID (PID) of the background watcher process on success.
  936: Returns immediately if hot reload is already enabled.
  937: 
  938: =head3 Side Effects
  939: 
  940: =over 4
  941: 
  942: =item * Forks a background process to monitor configuration files
  943: 
  944: =item * The background process sends SIGUSR1 to the parent when changes are detected
  945: 
  946: =item * Stores the watcher PID in C<%_config_watchers>
  947: 
  948: =item * May throw an exception (via C<croak>) if the fork fails
  949: 
  950: =back
  951: 
  952: =head3 Notes
  953: 
  954: Hot reload is not supported on Windows due to lack of SIGUSR1 signal support.
  955: The background process runs indefinitely until C<disable_hot_reload> is called.
  956: Objects must be registered via C<register_object> to receive configuration updates.
  957: 
  958: =head3 Usage Example
  959: 
  960:     use Object::Configure;
  961: 
  962:     # Enable hot reload with 5-second check interval
  963:     Object::Configure::enable_hot_reload(
  964:         interval => 5,
  965:         callback => sub {
  966:             my $timestamp = localtime;
  967:             print "[$timestamp] Configuration reloaded\n";
  968:         }
  969:     );
  970: 
  971:     # Application continues running...
  972:     while (1) {
  973:         # Do work...
  974:         sleep(1);
  975:     }
  976: 
  977: =head3 API Specification
  978: 
  979: =head4 Input
  980: 
  981:     schema => {
  982:         interval => {
  983:             type => 'integer',
  984:             optional => 1,
  985:             default => 10,
  986:             min => 1,
  987:             description => 'Check interval in seconds'
  988:         },
  989:         callback => {
  990:             type => 'coderef',
  991:             optional => 1,
  992:             description => 'Code to execute after reload'
  993:         }
  994:     }
  995: 
  996: =head4 Output
  997: 
  998:     type => 'integer',
  999:     description => 'PID of background watcher process',
 1000:     condition => 'value > 0'
 1001: 
 1002: =head3 Formal Specification
 1003: 
 1004:     enable_hot_reload: Interval × Callback → PID
 1005: 
 1006:     Given:
 1007:     - I: set of positive integers (intervals in seconds)
 1008:     - CB: set of code references
 1009:     - PID: set of process identifiers
 1010: 
 1011:     State:
 1012:     - _config_watchers: {pid: PID, callback: CB}
 1013:     - _config_file_stats: F → Stat
 1014: 
 1015:     Pre-condition:
 1016:     ∀ interval ∈ I, callback ∈ CB ∪ {∅} •
 1017:         interval ≥ 1 ∧
 1018:         _config_watchers = ∅ ∧
 1019:         OS ≠ 'MSWin32'
 1020: 
 1021:     Post-condition:
 1022:     ∀ result ∈ PID •
 1023:         result > 0 ∧
 1024:         _config_watchers.pid = result ∧
 1025:         _config_watchers.callback = callback ∧
 1026:         (∀ t ∈ Time •
 1027:             (t mod interval = 0) ⇒
 1028:                 (∃ f ∈ dom _config_file_stats •
 1029:                     mtime(f) > _config_file_stats(f).mtime ⇒
 1030:                         send_signal(SIGUSR1, parent_process)))
 1031: 
 1032: =cut
 1033: 
 1034: 
 1035: sub enable_hot_reload {
●1036 → 1045 → 0 1036: 	my %params = @_;
 1037: 
 1038: 	my $interval = $params{interval} || 10;
 1039: 	my $callback = $params{callback};
 1040: 
 1041: 	# Don't start multiple watchers
 1042: 	return if %_config_watchers;
 1043: 
 1044: 	# Fork a background process to watch config files
 1045: 	if (my $pid = fork()) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1046: 		# Parent process - store the watcher PID
 1047: 		$_config_watchers{pid} = $pid;
 1048: 		$_config_watchers{callback} = $callback;
 1049: 		return $pid;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1050: 	} elsif (defined $pid) {
 1051: 		# Child process - run the file watcher
 1052: 		_run_config_watcher($interval, $callback);
 1053: 		exit 0;
 1054: 	} else {
 1055: 		croak("Failed to fork config watcher: $!");
 1056: 	}
 1057: }
 1058: 
 1059: =head2 disable_hot_reload
 1060: 
 1061: Disable hot reloading and terminate the background watcher process.
 1062: 
 1063: =head3 Purpose
 1064: 
 1065: Cleanly shuts down the hot reload system by terminating the background watcher
 1066: process and clearing internal state.
 1067: 
 1068: =head3 Arguments
 1069: 
 1070: None.
 1071: 
 1072: =head3 Returns
 1073: 
 1074: Nothing.
 1075: 
 1076: =head3 Side Effects
 1077: 
 1078: =over 4
 1079: 
 1080: =item * Sends SIGTERM to the background watcher process
 1081: 
 1082: =item * Waits for the watcher process to terminate
 1083: 
 1084: =item * Clears C<%_config_watchers> state
 1085: 
 1086: =back
 1087: 
 1088: =head3 Notes
 1089: 
 1090: Safe to call even if hot reload is not currently enabled.
 1091: The function blocks until the watcher process has fully terminated.
 1092: 
 1093: =head3 Usage Example
 1094: 
 1095:     use Object::Configure;
 1096: 
 1097:     # Enable hot reload
 1098:     Object::Configure::enable_hot_reload(interval => 5);
 1099: 
 1100:     # ... application runs ...
 1101: 
 1102:     # Clean shutdown
 1103:     Object::Configure::disable_hot_reload();
 1104: 
 1105: =head3 API Specification
 1106: 
 1107: =head4 Input
 1108: 
 1109:     schema => {}
 1110: 
 1111: =head4 Output
 1112: 
 1113:     type => 'void'
 1114: 
 1115: =head3 Formal Specification
 1116: 
 1117:     disable_hot_reload: () → ()
 1118: 
 1119:     State:
 1120:     - _config_watchers: {pid: PID, callback: CB}
 1121: 
 1122:     Pre-condition:
 1123:     true
 1124: 
 1125:     Post-condition:
 1126:     _config_watchers = ∅ ∧
 1127:     (∀ p ∈ PID •
 1128:         p = _config_watchers.pid@pre ⇒
 1129:             ¬alive(p))
 1130: 
 1131: =cut
 1132: 
 1133: sub disable_hot_reload {
 1134: 	## MUTANT_SKIP_BEGIN
●1135 → 1135 → 0 1135: 	if (my $pid = $_config_watchers{pid}) {
 1136: 		# Guard against non-numeric PIDs (e.g. from mutation testing)
 1137: 		if($pid =~ /\A[0-9]+\z/ && $pid > 0) {
 1138: 			kill('TERM', $pid);
 1139: 
 1140: 			# Wait up to 5 seconds for the child to exit; if it doesn't respond
 1141: 			# to SIGTERM, escalate to SIGKILL to avoid hanging indefinitely
 1142: 			my $deadline = time() + 5;
 1143: 			my $kid;
 1144: 			do {
 1145: 				$kid = waitpid($pid, POSIX::WNOHANG());
 1146: 				if($kid == 0 && time() < $deadline) {
 1147: 					select undef, undef, undef, 0.1;	# sleep 100ms between polls
 1148: 				}
 1149: 			} while($kid == 0 && time() < $deadline);
 1150: 
 1151: 			# Escalate if still alive after timeout
 1152: 			if($kid == 0) {
 1153: 				kill('KILL', $pid);
 1154: 				waitpid($pid, 0);	# SIGKILL is not deferrable; this wait is safe
 1155: 			}
 1156: 		}
 1157: 		%_config_watchers = ();
 1158: 	}
 1159: 	## MUTANT_SKIP_END
 1160: }
 1161: 
 1162: =head2 reload_config
 1163: 
 1164: Manually trigger configuration reload for all registered objects.
 1165: 
 1166: =head3 Purpose
 1167: 
 1168: Forces an immediate reload of configuration from files for all objects that have been
 1169: registered for hot reload. This is useful for testing or forcing a reload without
 1170: waiting for the automatic file monitoring to detect changes.
 1171: 
 1172: =head3 Arguments
 1173: 
 1174: None.
 1175: 
 1176: =head3 Returns
 1177: 
 1178: An integer count of how many objects had their configuration successfully reloaded.
 1179: 
 1180: =head3 Side Effects
 1181: 
 1182: =over 4
 1183: 
 1184: =item * Reads configuration files from disk
 1185: 
 1186: =item * Updates object properties with new configuration values
 1187: 
 1188: =item * Calls C<_on_config_reload> hook on objects that implement it
 1189: 
 1190: =item * Cleans up dead weak references from C<%_object_registry>
 1191: 
 1192: =item * May emit warnings if configuration reload fails for any object
 1193: 
 1194: =back
 1195: 
 1196: =head3 Notes
 1197: 
 1198: Only objects registered via C<register_object> are reloaded.
 1199: Objects are updated in-place; their identity does not change.
 1200: Private properties (those starting with C<_>) are not updated during reload.
 1201: 
 1202: =head3 Usage Example
 1203: 
 1204:     use Object::Configure;
 1205: 
 1206:     # Create and register objects
 1207:     my $obj = My::Module->new(config_file => 'app.yml');
 1208: 
 1209:     # Manually edit app.yml...
 1210: 
 1211:     # Force immediate reload
 1212:     my $count = Object::Configure::reload_config();
 1213:     print "Reloaded configuration for $count objects\n";
 1214: 
 1215: =head3 API Specification
 1216: 
 1217: =head4 Input
 1218: 
 1219:     schema => {}
 1220: 
 1221: =head4 Output
 1222: 
 1223:     type => 'integer',
 1224:     description => 'Number of objects successfully reloaded',
 1225:     condition => 'value >= 0'
 1226: 
 1227: =head3 Formal Specification
 1228: 
 1229:     reload_config: () → ℕ
 1230: 
 1231:     State:
 1232:     - _object_registry: C → seq ObjectRef
 1233:     - ConfigFiles: F → H
 1234: 
 1235:     Pre-condition:
 1236:     true
 1237: 
 1238:     Post-condition:
 1239:     ∀ result ∈ ℕ •
 1240:         result = |{obj ∈ flatten(ran _object_registry) |
 1241:                    obj ≠ ∅ ∧
 1242:                    obj._config_file ∈ dom ConfigFiles}| ∧
 1243:         (∀ obj ∈ flatten(ran _object_registry) •
 1244:             obj ≠ ∅ ∧ obj._config_file ∈ dom ConfigFiles ⇒
 1245:                 (∀ k ∈ dom ConfigFiles(obj._config_file) •
 1246:                     k ∉ PrivateKeys ⇒
 1247:                         obj(k)@post = ConfigFiles(obj._config_file)(k)))
 1248: 
 1249:     where PrivateKeys = {k | k starts with '_'}
 1250: 
 1251: =cut
 1252: 
 1253: sub reload_config {
●1254 → 1256 → 1278●1254 → 1256 → 0 1254: 	my $reloaded_count = 0;
 1255: 
 1256: 	foreach my $class_key (keys %_object_registry) {
 1257: 		my $objects = $_object_registry{$class_key};
 1258: 
 1259: 		# Clean up dead object references
 1260: 		@$objects = grep { defined $_ } @$objects;
 1261: 
 1262: 		foreach my $obj_ref (@$objects) {
 1263: 			if (my $obj = $$obj_ref) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1264: 				eval {
 1265: 					_reload_object_config($obj);
 1266: 					$reloaded_count++;
 1267: 				};
 1268: 				if ($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1269: 					warn "Failed to reload config for object: $@";
 1270: 				}
 1271: 			}
 1272: 		}
 1273: 
 1274: 		# Remove empty entries
 1275: 		delete $_object_registry{$class_key} unless @$objects;
 1276: 	}
 1277: 
●1278 → 1278 → 0 1278: 	return $reloaded_count;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1279: }
 1280: 
 1281: # Internal function to run the config file watcher
 1282: sub _run_config_watcher {
●1283 → 1289 → 0 1283: 	my ($interval, $callback) = @_;
 1284: 
 1285: 	# Set up signal handlers for clean shutdown
 1286: 	local $SIG{TERM} = sub { exit 0 };
 1287: 	local $SIG{INT} = sub { exit 0 };
 1288: 
 1289: 	while (1) {
 1290: 		sleep($interval);
 1291: 
 1292: 		my $changes_detected = 0;
 1293: 
 1294: 		# Check each monitored config file
 1295: 		foreach my $config_file (keys %_config_file_stats) {
 1296: 			if (-f $config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1297: 				my $current_stat = stat($config_file);
 1298: 				my $stored_stat = $_config_file_stats{$config_file};
 1299: 
 1300: 				# Compare modification times
 1301: 				if ((!$stored_stat) || ($current_stat->mtime > $stored_stat->mtime)) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1302: 					$_config_file_stats{$config_file} = $current_stat;
 1303: 					$changes_detected = 1;
 1304: 				}
 1305: 			} else {
 1306: 				# File was deleted
 1307: 				delete $_config_file_stats{$config_file};
 1308: 				$changes_detected = 1;
 1309: 			}
 1310: 		}
 1311: 
 1312: 		if($changes_detected) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1312_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1313: 			if($^O ne 'MSWin32') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1314: 				# Reload configurations in the main process
 1315: 				# Use a signal or shared memory mechanism
 1316: 				if(my $parent_pid = getppid()) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1317: 					kill('USR1', $parent_pid);
 1318: 				}
 1319: 			}
 1320: 		}
 1321: 	}
 1322: }
 1323: 
 1324: # Internal function to reload a single object's configuration
 1325: sub _reload_object_config {
●1326 → 1337 → 1344●1326 → 1337 → 0 1326: 	my $obj = $_[0];
 1327: 
 1328: 	return unless blessed($obj);
 1329: 
 1330: 	my $class = ref($obj);
 1331: 	my $original_class = $class;
 1332: 	$class =~ s/::/__/g;
 1333: 
 1334: 	# Get the original config file path(s) if they exist
 1335: 	# Use the full path from _config_files if available, otherwise try _config_file
 1336: 	my $config_file;
 1337: 	if ($obj->{_config_files} && ref($obj->{_config_files}) eq 'ARRAY' && @{$obj->{_config_files}}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1338: 		# Use the last (most specific) config file
 1339: 		$config_file = $obj->{_config_files}[-1];
 1340: 	} else {
 1341: 		$config_file = $obj->{_config_file} || $obj->{config_file};
 1342: 	}
 1343: 
●1344 → 1352 → 1384●1344 → 1352 → 0 1344: 	return unless $config_file && -f $config_file;
 1345: 
 1346: 	# Reload the configuration
 1347: 	my $config = Config::Abstraction->new(
 1348: 		config_file => $config_file,
 1349: 		env_prefix => "${class}__"
 1350: 	);
 1351: 
 1352: 	if ($config) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1353: 		# Use merge_defaults with empty defaults to get just the config values
 1354: 		my $new_params = $config->merge_defaults(
 1355: 			defaults => {},
 1356: 			section => $class,
 1357: 			merge => 1,
 1358: 			deep => 1
 1359: 		);
 1360: 
 1361: 		# Update object properties, preserving non-config data
 1362: 		foreach my $key (keys %$new_params) {
 1363: 			next if $key =~ /^_/;	# Skip private properties
 1364: 
 1365: 			if($key =~ /^logger/ && $new_params->{$key} ne 'NULL') {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1365_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1366: 				# Handle logger reconfiguration specially
 1367: 				_reconfigure_logger($obj, $key, $new_params->{$key});
 1368: 			} else {
 1369: 				$obj->{$key} = $new_params->{$key};
 1370: 			}
 1371: 		}
 1372: 
 1373: 		# Call object's reload hook if it exists
 1374: 		if ($obj->can('_on_config_reload')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1375: 			$obj->_on_config_reload($new_params);
 1376: 		}
 1377: 
 1378: 		# Log the reload if logger exists
 1379: 		if ($obj->{logger} && $obj->{logger}->can('info')) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1379_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1380: 			$obj->{logger}->info("Configuration reloaded for $original_class");
 1381: 		}
 1382: 	}
 1383: 
●1384 → 1384 → 0 1384: 	return;
 1385: }
 1386: 
 1387: # Internal function to reconfigure the logger
 1388: sub _reconfigure_logger
 1389: {
●1390 → 1392 → 0 1390: 	my ($obj, $key, $logger_config) = @_;
 1391: 
 1392: 	if (ref($logger_config) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1393: 		# Create new logger with new config
 1394: 		my $carp_on_warn = $obj->{carp_on_warn} || 0;
 1395: 
 1396: 		if ($logger_config->{syslog}) {

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_1396_3: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

 1397: 			$obj->{$key} = Log::Abstraction->new({
 1398: 				carp_on_warn => $carp_on_warn,
 1399: 				syslog => $logger_config->{syslog},
 1400: 				%$logger_config
 1401: 			});
 1402: 		} else {
 1403: 			$obj->{$key} = Log::Abstraction->new({
 1404: 				carp_on_warn => $carp_on_warn,
 1405: 				%$logger_config
 1406: 			});
 1407: 		}
 1408: 	} else {
 1409: 		$obj->{$key} = $logger_config;
 1410: 	}
 1411: }
 1412: 
 1413: =head2 register_object($class, $obj)
 1414: 
 1415: Register an object for hot reload monitoring.
 1416: 
 1417: =head3 Purpose
 1418: 
 1419: Adds an object to the hot reload registry so it will receive automatic configuration
 1420: updates when files change. Uses weak references to prevent memory leaks.
 1421: 
 1422: =head3 Arguments
 1423: 
 1424: =over 4
 1425: 
 1426: =item * C<class> (Required)
 1427: 
 1428: The class name of the object, used for organizing the registry.
 1429: 
 1430: =item * C<obj> (Required)
 1431: 
 1432: The object instance to register. Must be a blessed reference.
 1433: 
 1434: =back
 1435: 
 1436: =head3 Returns
 1437: 
 1438: Nothing.
 1439: 
 1440: =head3 Side Effects
 1441: 
 1442: =over 4
 1443: 
 1444: =item * Adds a weak reference to the object in C<%_object_registry>
 1445: 
 1446: =item * Sets up SIGUSR1 signal handler on first call (Unix-like systems only)
 1447: 
 1448: =item * Stores the original SIGUSR1 handler for later restoration
 1449: 
 1450: =back
 1451: 
 1452: =head3 Notes
 1453: 
 1454: Objects are stored using weak references, so they will be automatically
 1455: garbage collected when no other references exist.
 1456: The SIGUSR1 handler chains to any existing handler that was installed.
 1457: On Windows, the signal handler is not installed (SIGUSR1 does not exist).
 1458: 
 1459: =head3 Usage Example
 1460: 
 1461:     package My::Module;
 1462:     use Object::Configure;
 1463: 
 1464:     sub new {
 1465:         my $class = shift;
 1466:         my $params = Object::Configure::configure($class, {
 1467:             config_file => 'mymodule.yml',
 1468:         });
 1469:         my $self = bless $params, $class;
 1470: 
 1471:         # Register for hot reload
 1472:         Object::Configure::register_object($class, $self)
 1473:             if $params->{_config_file};
 1474: 
 1475:         return $self;
 1476:     }
 1477: 
 1478: =head3 API Specification
 1479: 
 1480: =head4 Input
 1481: 
 1482:     schema => {
 1483:         class => {
 1484:             type => 'string',
 1485:             required => 1,
 1486:             description => 'Class name for registry organization'
 1487:         },
 1488:         obj => {
 1489:             type => 'object',
 1490:             required => 1,
 1491:             description => 'Blessed object instance to register'
 1492:         }
 1493:     }
 1494: 
 1495: =head4 Output
 1496: 
 1497:     type => 'void'
 1498: 
 1499: =head3 Formal Specification
 1500: 
 1501:     register_object: C × O → ()
 1502: 
 1503:     Given:
 1504:     - C: set of class names
 1505:     - O: set of blessed objects
 1506:     - OR: C → seq WeakRef(O) (object registry)
 1507: 
 1508:     State:
 1509:     - _object_registry: OR
 1510:     - _original_usr1_handler: SignalHandler ∪ {∅}
 1511:     - $SIG{USR1}: SignalHandler
 1512: 
 1513:     Pre-condition:
 1514:     ∀ class ∈ C, obj ∈ O •
 1515:         class ≠ ∅ ∧
 1516:         obj ≠ ∅ ∧
 1517:         blessed(obj) ≠ ∅
 1518: 
 1519:     Post-condition:
 1520:     ∀ class ∈ C, obj ∈ O •
 1521:         ∃ ref ∈ _object_registry(class) •
 1522:             weak(ref) = obj ∧
 1523:         (_original_usr1_handler = ∅@pre ⇒
 1524:             (_original_usr1_handler@post = $SIG{USR1}@pre ∧
 1525:              $SIG{USR1}@post = reload_config_handler))
 1526: 
 1527: =cut
 1528: 
 1529: sub register_object
 1530: {
●1531 → 1542 → 1571●1531 → 1542 → 0 1531: 	my ($class, $obj) = @_;
 1532: 
 1533: 	croak(__PACKAGE__, '::register_object: Usage ($class, $obj)') unless(defined($class) && defined($obj));
 1534: 
 1535: 	# Use weak references to avoid memory leaks
 1536: 	my $obj_ref = \$obj;
 1537: 	weaken($$obj_ref);
 1538: 
 1539: 	push @{$_object_registry{$class}}, $obj_ref;
 1540: 
 1541: 	# Set up signal handler for hot reload (only once)
 1542: 	if (!defined $_original_usr1_handler) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1543: 		# Store the existing handler (could be DEFAULT, IGNORE, or a code ref)
 1544: 		$_original_usr1_handler = $SIG{USR1} || 'DEFAULT';
 1545: 
 1546: 		return if($^O eq 'MSWin32');	# There is no SIGUSR1 on Windows
 1547: 
 1548: 		$SIG{USR1} = sub {
 1549: 			# Handle our hot reload first
 1550: 			reload_config();
 1551: 			if ($_config_watchers{callback}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1552: 				$_config_watchers{callback}->();
 1553: 			}
 1554: 
 1555: 			# Chain to the original handler if it exists and is callable
 1556: 			if (ref($_original_usr1_handler) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1557: 				$_original_usr1_handler->();
 1558: 			} elsif ($_original_usr1_handler eq 'DEFAULT') {
 1559: 				# Let the default handler run (which typically does nothing for USR1)
 1560: 				# We don't need to explicitly call it
 1561: 			} elsif ($_original_usr1_handler eq 'IGNORE') {
 1562: 				# Do nothing - the signal was being ignored
 1563: 			}
 1564: 			# Note: If it was some other string, it was probably a custom handler name
 1565: 			# but we can't easily call those, so we'll just warn
 1566: 			elsif ($_original_usr1_handler ne 'DEFAULT' && $_original_usr1_handler ne 'IGNORE') {
 1567: 				warn "Object::Configure: Cannot chain to non-code USR1 handler: $_original_usr1_handler";
 1568: 			}
 1569: 		};
 1570: 	}
●1571 → 1571 → 0 1571: 	return;	# ensure the functions return nothing (void/empty list)
 1572: }
 1573: 
 1574: =head2 restore_signal_handlers
 1575: 
 1576: Restore original signal handlers and disable hot reload integration.
 1577: 
 1578: =head3 Purpose
 1579: 
 1580: Restores the signal handler that was in place before Object::Configure installed
 1581: its SIGUSR1 handler. This is useful for clean shutdown or when transferring
 1582: control to another hot reload system.
 1583: 
 1584: =head3 Arguments
 1585: 
 1586: None.
 1587: 
 1588: =head3 Returns
 1589: 
 1590: Nothing.
 1591: 
 1592: =head3 Side Effects
 1593: 
 1594: =over 4
 1595: 
 1596: =item * Restores C<$SIG{USR1}> to its original value
 1597: 
 1598: =item * Clears C<$_original_usr1_handler> internal state
 1599: 
 1600: =back
 1601: 
 1602: =head3 Notes
 1603: 
 1604: Safe to call even if Object::Configure never installed a signal handler.
 1605: On Windows, this function has no effect (SIGUSR1 does not exist).
 1606: 
 1607: =head3 Usage Example
 1608: 
 1609:     use Object::Configure;
 1610: 
 1611:     # Objects are registered...
 1612: 
 1613:     # Clean shutdown
 1614:     Object::Configure::disable_hot_reload();
 1615:     Object::Configure::restore_signal_handlers();
 1616: 
 1617: =head3 API Specification
 1618: 
 1619: =head4 Input
 1620: 
 1621:     schema => {}
 1622: 
 1623: =head4 Output
 1624: 
 1625:     type => 'void'
 1626: 
 1627: =head3 Formal Specification
 1628: 
 1629:     restore_signal_handlers: () → ()
 1630: 
 1631:     State:
 1632:     - _original_usr1_handler: SignalHandler ∪ {∅}
 1633:     - $SIG{USR1}: SignalHandler
 1634: 
 1635:     Pre-condition:
 1636:     true
 1637: 
 1638:     Post-condition:
 1639:     $SIG{USR1}@post = _original_usr1_handler@pre ∧
 1640:     _original_usr1_handler@post = ∅
 1641: 
 1642: =cut
 1643: 
 1644: sub restore_signal_handlers
 1645: {
●1646 → 1646 → 1651●1646 → 1646 → 0 1646: 	if (defined $_original_usr1_handler) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1647: 		$SIG{USR1} = $_original_usr1_handler if($^O ne 'MSWin32');	# There is no SIGUSR1 on Windows
 1648: 		$_original_usr1_handler = undef;
 1649: 	}
 1650: 
●1651 → 1651 → 0 1651: 	return;	# ensure the functions return nothing (void/empty list)
 1652: }
 1653: 
 1654: =head2 get_signal_handler_info
 1655: 
 1656: Get information about the current signal handler setup for debugging.
 1657: 
 1658: =head3 Purpose
 1659: 
 1660: Returns diagnostic information about the signal handler state, useful for
 1661: debugging signal handler chains or verifying hot reload configuration.
 1662: 
 1663: =head3 Arguments
 1664: 
 1665: None.
 1666: 
 1667: =head3 Returns
 1668: 
 1669: A hashref containing the following keys:
 1670: 
 1671: =over 4
 1672: 
 1673: =item * C<original_usr1>
 1674: 
 1675: The signal handler that was installed before Object::Configure's handler,
 1676: or undef if no handler was present.
 1677: 
 1678: =item * C<current_usr1>
 1679: 
 1680: The currently installed SIGUSR1 handler.
 1681: 
 1682: =item * C<hot_reload_active>
 1683: 
 1684: Boolean indicating whether Object::Configure's hot reload handler is active.
 1685: 
 1686: =item * C<watcher_pid>
 1687: 
 1688: The PID of the background watcher process, or undef if not running.
 1689: 
 1690: =back
 1691: 
 1692: =head3 Side Effects
 1693: 
 1694: None.
 1695: 
 1696: =head3 Notes
 1697: 
 1698: This is primarily a debugging aid and is not needed for normal operation.
 1699: 
 1700: =head3 Usage Example
 1701: 
 1702:     use Object::Configure;
 1703:     use Data::Dumper;
 1704: 
 1705:     Object::Configure::enable_hot_reload();
 1706: 
 1707:     my $info = Object::Configure::get_signal_handler_info();
 1708:     print Dumper($info);
 1709:     # $VAR1 = {
 1710:     #     'original_usr1' => 'DEFAULT',
 1711:     #     'current_usr1' => CODE(0x...),
 1712:     #     'hot_reload_active' => 1,
 1713:     #     'watcher_pid' => 12345
 1714:     # };
 1715: 
 1716: =head3 API Specification
 1717: 
 1718: =head4 Input
 1719: 
 1720:     schema => {}
 1721: 
 1722: =head4 Output
 1723: 
 1724:     type => 'hashref',
 1725:     schema => {
 1726:         original_usr1 => {
 1727:             type => [qw(coderef string undef)],
 1728:             description => 'Original SIGUSR1 handler'
 1729:         },
 1730:         current_usr1 => {
 1731:             type => [qw(coderef string undef)],
 1732:             description => 'Current SIGUSR1 handler'
 1733:         },
 1734:         hot_reload_active => {
 1735:             type => 'boolean',
 1736:             description => 'Whether hot reload is active'
 1737:         },
 1738:         watcher_pid => {
 1739:             type => [qw(integer undef)],
 1740:             description => 'Background watcher process PID'
 1741:         }
 1742:     }
 1743: 
 1744: =head3 Formal Specification
 1745: 
 1746:     get_signal_handler_info: () → InfoHash
 1747: 
 1748:     Given:
 1749:     - IH: set of all info hashes
 1750: 
 1751:     State:
 1752:     - _original_usr1_handler: SignalHandler ∪ {∅}
 1753:     - $SIG{USR1}: SignalHandler ∪ {∅}
 1754:     - _config_watchers: {pid: PID, callback: CB}
 1755: 
 1756:     Pre-condition:
 1757:     true
 1758: 
 1759:     Post-condition:
 1760:     ∀ result ∈ IH •
 1761:         result.original_usr1 = _original_usr1_handler ∧
 1762:         result.current_usr1 = $SIG{USR1} ∧
 1763:         result.hot_reload_active = (_original_usr1_handler ≠ ∅) ∧
 1764:         result.watcher_pid = _config_watchers.pid
 1765: 
 1766: =cut
 1767: 
 1768: sub get_signal_handler_info {
 1769: 	return {
 1770: 		original_usr1 => $_original_usr1_handler,
 1771: 		current_usr1 => $SIG{USR1},
 1772: 		hot_reload_active => defined $_original_usr1_handler,
 1773: 		watcher_pid => $_config_watchers{pid},
 1774: 	};
 1775: }
 1776: 
 1777: # Cleanup on module destruction
 1778: END {
 1779: 	disable_hot_reload();
 1780: 
 1781: 	# Restore original USR1 handler if we modified it
 1782: 	restore_signal_handlers();
 1783: }
 1784: 
 1785: =head1 SEE ALSO
 1786: 
 1787: =over 4
 1788: 
 1789: =item * L<Config::Abstraction>
 1790: 
 1791: =item * L<Log::Abstraction>
 1792: 
 1793: =item * L<Test Dashboard|https://nigelhorne.github.io/Object-Configure/coverage/>
 1794: 
 1795: =back
 1796: 
 1797: =head1 SUPPORT
 1798: 
 1799: This module is provided as-is without any warranty.
 1800: 
 1801: Please report any bugs or feature requests to C<bug-object-configure at rt.cpan.org>,
 1802: or through the web interface at
 1803: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Object-Configure>.
 1804: I will be notified, and then you'll
 1805: automatically be notified of progress on your bug as I make changes.
 1806: 
 1807: You can find documentation for this module with the perldoc command.
 1808: 
 1809:     perldoc Object::Configure
 1810: 
 1811: =head1 LICENCE AND COPYRIGHT
 1812: 
 1813: Copyright 2025-2026 Nigel Horne.
 1814: 
 1815: Usage is subject to GPL2 licence terms.
 1816: If you use it,
 1817: please let me know.
 1818: 
 1819: =cut
 1820: 
 1821: 1;