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 mro;
   11: use Params::Get 0.13;
   12: use Readonly;
   13: use Return::Set;
   14: use Scalar::Util qw(blessed weaken);
   15: use Time::HiRes qw(time);
   16: use File::stat;
   17: use POSIX qw(WNOHANG);
   18: 
   19: # Avoid magic literals scattered across hot paths and signal handlers.
   20: # Centralising here makes global search-replace safe and self-documents intent.
   21: Readonly my $OS_WINDOWS   => 'MSWin32';
   22: Readonly my $LOGGER_NULL  => 'NULL';
   23: Readonly my $SIG_DEFAULT  => 'DEFAULT';
   24: Readonly my $SIG_IGNORE   => 'IGNORE';
   25: Readonly my $POLL_SLEEP   => 0.1;   # seconds between waitpid polls in disable_hot_reload
   26: Readonly my $KILL_TIMEOUT => 5;     # seconds before SIGKILL escalation after SIGTERM
   27: 
   28: # Global registry — intentionally package-level so that the END block and
   29: # signal handlers installed in one call site share state with all others.
   30: # This is a deliberate singleton design; see LIMITATIONS for the trade-offs.
   31: our %_object_registry   = ();
   32: our %_config_watchers   = ();
   33: our %_config_file_stats = ();
   34: 
   35: # Saved before we install our SIGUSR1 handler so we can chain and restore it.
   36: our $_original_usr1_handler;
   37: 
   38: =head1 NAME
   39: 
   40: Object::Configure - Runtime Configuration for an Object
   41: 
   42: =head1 VERSION
   43: 
   44: 0.23
   45: 
   46: =cut
   47: 
   48: our $VERSION = 0.23;
   49: 
   50: =head1 SYNOPSIS
   51: 
   52: The C<Object::Configure> module is a lightweight utility designed to inject runtime parameters into other classes,
   53: primarily by layering configuration and logging support,
   54: when instatiating objects.
   55: 
   56: L<Log::Abstraction> and L<Config::Abstraction> are modules developed to solve a specific need,
   57: runtime configurability without needing to rewrite or hardcode behaviours.
   58: The goal is to allow individual modules to enable or disable features on the fly,
   59: and to do it using whatever configuration system the user prefers.
   60: 
   61: Although the initial aim was general configurability,
   62: the primary use case that's emerged has been fine-grained logging control,
   63: more flexible and easier to manage than what you'd typically do with L<Log::Log4perl>.
   64: For example,
   65: you might want one module to log verbosely while another stays quiet,
   66: and be able to toggle that dynamically - without making invasive changes to each module.
   67: 
   68: To tie it all together,
   69: there is C<Object::Configure>.
   70: It sits on L<Log::Abstraction> and L<Config::Abstraction>,
   71: and with just a couple of extra lines in a class constructor,
   72: you can hook in this behaviour seamlessly.
   73: The intent is to keep things modular and reusable,
   74: especially across larger systems or in situations where you want user-selectable behaviour.
   75: 
   76: Add this to your constructor:
   77: 
   78:    package My::Module;
   79: 
   80:    use Object::Configure;
   81:    use Params::Get;
   82: 
   83:    sub new {
   84:         my $class = shift;
   85:         my $params = Object::Configure::configure($class, @_ ? \@_ : undef);	# Reads in the runtime configuration settings
   86:         # or my $params = Object::Configure::configure($class, { @_ });
   87: 
   88:         return bless $params, $class;
   89:     }
   90: 
   91: Throughout your class, add code such as:
   92: 
   93:     sub method
   94:     {
   95:         my $self = shift;
   96: 
   97:         $self->{'logger'}->trace(ref($self), ': ', __LINE__, ' entering method');
   98:     }
   99: 
  100: =head3 CONFIGURATION INHERITANCE
  101: 
  102: C<Object::Configure> supports configuration inheritance, allowing child classes to inherit and override configuration settings from their parent classes.
  103: 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.
  104: 
  105: 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:
  106: 
  107: =over 4
  108: 
  109: =item 1. Load C<my-base-class.yml> (or .conf, .json, etc.) if it exists
  110: 
  111: =item 2. Load C<my-parent-class.yml> if it exists, overriding base settings
  112: 
  113: =item 3. Load C<my-child-class.yml>, overriding both parent and base settings
  114: 
  115: =back
  116: 
  117: The configuration files should be named using lowercase versions of the class name with C<::> replaced by hyphens (C<->).
  118: For example, C<My::Parent::Class> would use C<my-parent-class.yml>.
  119: 
  120: 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.
  121: 
  122: Example:
  123: 
  124:     # File: ~/.conf/my-base-class.yml
  125:     ---
  126:     My__Base__Class:
  127:       timeout: 30
  128:       retries: 3
  129:       log_level: info
  130: 
  131:     # File: ~/.conf/my-child-class.yml
  132:     ---
  133:     My__Child__Class:
  134:       timeout: 60
  135:       # Inherits retries: 3 and log_level: info from parent
  136: 
  137:     # Result: Child class gets timeout=60, retries=3, log_level=info
  138: 
  139: Parent configuration files are optional.
  140: If a parent class's configuration file doesn't exist, the module simply skips it and continues up the inheritance chain.
  141: All discovered configuration files are tracked in the C<_config_files> array for hot reload support.
  142: 
  143: =head3 UNIVERSAL CONFIGURATION
  144: 
  145: All Perl classes implicitly inherit from C<UNIVERSAL>.
  146: C<Object::Configure> takes advantage of this to provide a mechanism for universal configuration settings
  147: that apply to all classes by default.
  148: 
  149: If you create a configuration file named C<universal.yml> (or C<universal.conf>, C<universal.json>, etc.)
  150: in your configuration directory,
  151: the settings in its C<UNIVERSAL> section will be inherited by all classes that use C<Object::Configure>,
  152: unless explicitly overridden by class-specific configuration files.
  153: 
  154: This is particularly useful for setting application-wide defaults such as logging levels,
  155: timeout values,
  156: or other common parameters that should apply across all modules.
  157: 
  158: Example C<~/.conf/universal.yml>:
  159: 
  160:     ---
  161:     UNIVERSAL:
  162:       timeout: 30
  163:       retries: 3
  164:       logger:
  165:         level: info
  166: 
  167: With this universal configuration file in place,
  168: all classes will inherit these default values.
  169: Individual classes can override any of these settings in their own configuration files:
  170: 
  171: Example C<~/.conf/my-special-class.yml>:
  172: 
  173:     ---
  174:     My__Special__Class:
  175:       timeout: 120
  176:       # Inherits retries: 3 and logger.level: info from UNIVERSAL
  177: 
  178: The universal configuration is loaded first in the inheritance chain,
  179: followed by parent class configurations,
  180: and finally the specific class configuration,
  181: with later configurations overriding earlier ones.
  182: 
  183: =head2 CHANGING BEHAVIOUR AT RUN TIME
  184: 
  185: =head3 USING A CONFIGURATION FILE
  186: 
  187: To control behavior at runtime, C<Object::Configure> supports loading settings from a configuration file via L<Config::Abstraction>.
  188: 
  189: A minimal example of a config file (C<~/.conf/local.conf>) might look like:
  190: 
  191:    [My__Module]
  192:    logger.file = /var/log/mymodule.log
  193: 
  194: The C<configure()> function will read this file,
  195: overlay it onto your default parameters,
  196: and initialize the logger accordingly.
  197: 
  198: If the file is not readable and no config_dirs are provided,
  199: the module will throw an error.
  200: To be clear, in this case, inheritance is not followed.
  201: 
  202: This mechanism allows dynamic tuning of logging behavior (or other parameters you expose) without modifying code.
  203: 
  204: More details to be written.
  205: 
  206: =head3 USING ENVIRONMENT VARIABLES
  207: 
  208: C<Object::Configure> also supports runtime configuration via environment variables,
  209: without requiring a configuration file.
  210: 
  211: Environment variables are read automatically when you use the C<configure()> function,
  212: thanks to its integration with L<Config::Abstraction>.
  213: These variables should be prefixed with your class name, followed by a double colon.
  214: 
  215: For example, to enable syslog logging for your C<My::Module> class,
  216: you could set:
  217: 
  218:     export My__Module__logger__file=/var/log/mymodule.log
  219: 
  220: This would be equivalent to passing the following in your constructor:
  221: 
  222:      My::Module->new(logger => Log::Abstraction->new({ file => '/var/log/mymodule.log' });
  223: 
  224: All environment variables are read and merged into the default parameters under the section named after your class.
  225: This allows centralized and temporary control of settings (e.g., for production diagnostics or ad hoc testing) without modifying code or files.
  226: 
  227: Note that environment variable settings take effect regardless of whether a configuration file is used,
  228: and are applied during the call to C<configure()>.
  229: 
  230: More details to be written.
  231: 
  232: =head2 HOT RELOAD
  233: 
  234: Hot reload is not supported on Windows.
  235: 
  236: =head3 Basic Hot Reload Setup
  237: 
  238:     package My::App;
  239:     use Object::Configure;
  240: 
  241:     sub new {
  242:         my $class = shift;
  243:         my $params = Object::Configure::configure($class, @_ ? \@_ : undef);
  244:         my $self = bless $params, $class;
  245: 
  246:         # Register for hot reload
  247:         Object::Configure::register_object($class, $self) if $params->{_config_file};
  248: 
  249:         return $self;
  250:     }
  251: 
  252:     # Optional: Define a reload hook
  253:     sub _on_config_reload {
  254:         my ($self, $new_config) = @_;
  255:         print "My::App config was reloaded!\n";
  256:         # Custom reload logic here
  257:     }
  258: 
  259: =head3 Enable Hot Reload in Your Main Application
  260: 
  261:     # Enable hot reload with custom callback
  262:     Object::Configure::enable_hot_reload(
  263:         interval => 5,  # Check every 5 seconds
  264:         callback => sub {
  265:             print "Configuration files have been reloaded!\n";
  266:         }
  267:     );
  268: 
  269:     # Your application continues running...
  270:     # Config changes will be automatically detected and applied
  271: 
  272: =head3 Manual Reload
  273: 
  274:     # Manually trigger a reload
  275:     my $count = Object::Configure::reload_config();
  276:     print "Reloaded configuration for $count objects\n";
  277: 
  278: =encoding utf8
  279: 
  280: =head1 SUBROUTINES/METHODS
  281: 
  282: =head2 configure
  283: 
  284: Configure your class at runtime with hot reload support.
  285: 
  286: Takes arguments:
  287: 
  288: =over 4
  289: 
  290: =item * C<class>
  291: 
  292: =item * C<params>
  293: 
  294: A hashref containing default parameters to be used in the constructor.
  295: 
  296: =item * C<carp_on_warn>
  297: 
  298: If set to 1, call C<Carp::carp> on C<warn()>.
  299: This value is also read from the configuration file,
  300: which will take precedence.
  301: The default is 0.
  302: 
  303: =item * C<croak_on_error>
  304: 
  305: If set to 1, call C<Carp::croak> on C<error()>.
  306: This value is also read from the configuration file,
  307: which will take precedence.
  308: The default is 1.
  309: 
  310: =item * C<logger>
  311: 
  312: The logger to use.
  313: If none is given, an instatiation of L<Log::Abstraction> will be created, unless the logger is set to NULL.
  314: 
  315: =item * C<schema>
  316: 
  317: A L<Params::Validate::Strict> compatible schema to validate the configuration file against.
  318: 
  319: =back
  320: 
  321: Returns a hash ref containing the new values for the constructor.
  322: 
  323: Now you can set up a configuration file and environment variables to configure your object.
  324: 
  325: =head3 API Specification
  326: 
  327: =head4 Input
  328: 
  329:     schema => {
  330:         class => {
  331:             type => 'string',
  332:             required => 1,
  333:             description => 'Fully-qualified class name'
  334:         },
  335:         params => {
  336:             type => 'hashref',
  337:             optional => 1,
  338:             default => {},
  339:             schema => {
  340:                 config_file => {
  341:                     type => 'string',
  342:                     optional => 1,
  343:                     description => 'Configuration file basename'
  344:                 }, config_dirs => {
  345:                     type => 'arrayref',
  346:                     optional => 1,
  347:                     description => 'Directories to search for config files'
  348:                 }, logger => {
  349:                     type => [qw(hashref coderef object string arrayref)],
  350:                     optional => 1,
  351:                     description => 'Logger configuration or instance'
  352:                 }, carp_on_warn => {
  353:                     type => 'boolean',
  354:                     optional => 1,
  355:                     default => 0,
  356:                     description => 'Use Carp::carp for warnings'
  357:                 }, croak_on_error => {
  358:                     type => 'boolean',
  359:                     optional => 1,
  360:                     default => 1,
  361:                     description => 'Use Carp::croak for errors'
  362:                 }
  363:             }
  364:         }
  365:     }
  366: 
  367: =head4 Output
  368: 
  369:     type => 'hashref',
  370:     description => 'Merged configuration parameters',
  371:     schema => {
  372:         logger => {
  373:             type => 'object',
  374:             isa => 'Log::Abstraction',
  375:             description => 'Initialized logger instance'
  376:         },
  377:         _config_file => {
  378:             type => 'string',
  379:             optional => 1,
  380:             description => 'Primary configuration file path'
  381:         },
  382:         _config_files => {
  383:             type => 'arrayref',
  384:             optional => 1,
  385:             description => 'All loaded configuration file paths'
  386:         }
  387:     }
  388: 
  389: =head3 MESSAGES
  390: 
  391: =over 4
  392: 
  393: =item * C<configure: what class do you want to configure?> -- class argument was undef or empty string. Pass the calling package name as the first argument.
  394: 
  395: =item * C<CLASS: FILE: OS-error> -- the config_file is not readable and no config_dirs were supplied. Check file permissions or supply config_dirs.
  396: 
  397: =item * C<Warning: Can't load configuration from FILE: DETAIL> -- Config::Abstraction rejected the file. Check YAML/JSON/conf syntax.
  398: 
  399: =back
  400: 
  401: =head3 PSEUDOCODE
  402: 
  403:     configure(class, params):
  404:         croak if class is empty
  405:         stash coderefs/objects from params (Config::Abstraction cannot hold them)
  406:         if params.logger is arrayref: move to $array_logger
  407:         build inheritance chain via mro::get_linear_isa (base -> child, UNIVERSAL first)
  408:         if config_file given:
  409:             croak if not readable and no config_dirs
  410:             for each ancestor class (child -> base order): find & collect matching config file
  411:             add primary config file last (highest priority)
  412:             sort collected files base -> child
  413:             deep-merge each file's section into params
  414:         else if environment variables exist:
  415:             merge env vars for each ancestor then for the class itself
  416:         determine carp_on_warn / croak_on_error
  417:         build logger via _build_logger(spec, carp_on_warn)
  418:         store _config_file and _config_files for hot reload
  419:         restore stashed coderefs/objects
  420:         return params
  421: 
  422: =cut
  423: 
  424: sub configure {
●425 → 440 → 448  425: 	my $class  = $_[0];
  426: 	my $params = $_[1] || {};	# caller's defaults; config file values override them
  427: 	my $array_logger;		# stash for an arrayref logger spec (Config::Abstraction rejects refs)
  428: 
  429: 	croak(__PACKAGE__, ': configure: what class do you want to configure?')
  430: 		if !defined($class) || $class eq '';
  431: 
  432: 	# Config::Abstraction, Log::Abstraction, and Return::Set all use eval internally
  433: 	# Protect the caller's $@ from being clobbered by our internal eval blocks.
  434: 	local $@;
  435: 
  436: 	# Config::Abstraction treats unknown scalar values as config file paths and will
  437: 	# attempt to read them, corrupting coderefs and object references.
  438: 	# Stash them here and restore after merging so callers never need this pattern.
  439: 	my %stashed_values;
  440: 	foreach my $key (keys %$params) {
  441: 		next if $key eq 'logger';	# logger has its own path through _build_logger
  442: 		my $value = $params->{$key};
  443: 		if(ref($value) eq 'CODE' || blessed($value)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  444: 			$stashed_values{$key} = delete $params->{$key};
  445: 		}
  446: 	}
  447: 
●448 → 448 → 452  448: 	if(exists($params->{'logger'}) && ref($params->{'logger'}) eq 'ARRAY') {

					

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

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

  449: 		$array_logger = delete $params->{'logger'};
  450: 	}
  451: 
●452 → 466 → 509  452: 	my $original_class = $class;
  453: 	$class =~ s/::/__/g;
  454: 
  455: 	my $config_file = $params->{'config_file'};
  456: 	my $config_dirs = $params->{'config_dirs'};
  457: 
  458: 	# _get_inheritance_chain returns [UNIVERSAL, ..., Base, Child] (base-first).
  459: 	# Reversing it below gives child-first for the discovery loop; the sort
  460: 	# that follows re-establishes base-first order for actual loading.
  461: 	my @inheritance_chain = _get_inheritance_chain($original_class);
  462: 
  463: 	my @config_files_to_load = ();
  464: 	my %tracked_files        = ();
  465: 
  466: 	if($config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  467: 		# Fail early so the error message carries the OS errno string while $!
  468: 		# is still fresh from the -r test, giving a locale-correct message.
  469: 		if(!$config_dirs && !-r $config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  470: 			croak("$class: ", $config_file, ": $!");
  471: 		}
  472: 
  473: 		foreach my $ancestor_class (reverse @inheritance_chain) {
  474: 			my $ancestor_config_file = _find_class_config_file(
  475: 				$ancestor_class,
  476: 				$config_file,
  477: 				$config_dirs
  478: 			);
  479: 
  480: 			# Primary file is added separately at the end (highest priority)
  481: 			next if $ancestor_config_file && $ancestor_config_file eq $config_file;
  482: 
  483: 			if($ancestor_config_file && -r $ancestor_config_file && !$tracked_files{$ancestor_config_file}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  484: 				push @config_files_to_load, { file => $ancestor_config_file, class => $ancestor_class };
  485: 				$tracked_files{$ancestor_config_file} = 1;
  486: 				$_config_file_stats{$ancestor_config_file} = stat($ancestor_config_file)
  487: 					if -f $ancestor_config_file;
  488: 			}
  489: 		}
  490: 
  491: 		if($config_file && !$tracked_files{$config_file} && -r $config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  492: 			push @config_files_to_load, { file => $config_file, class => $original_class };
  493: 			$tracked_files{$config_file} = 1;
  494: 			$_config_file_stats{$config_file} = stat($config_file)
  495: 				if -f $config_file;
  496: 		}
  497: 
  498: 		if(!scalar(@config_files_to_load)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  499: 			foreach my $dir (@{$config_dirs}) {
  500: 				my $candidate = File::Spec->catfile($dir, $config_file);
  501: 				if(-r $candidate) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  502: 					push @config_files_to_load, { file => $candidate, class => $original_class };
  503: 					last;	# stop at first readable hit; later dirs are lower priority
  504: 				}
  505: 			}
  506: 		}
  507: 	}
  508: 
●509 → 509 → 585  509: 	if(@config_files_to_load) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  510: 		# Sort so that base-class files are loaded before child files.
  511: 		# %class_order is keyed on the chain (UNIVERSAL=0, ..., Child=N).
  512: 		my %class_order;
  513: 		for my $i (0 .. $#inheritance_chain) {
  514: 			$class_order{ $inheritance_chain[$i] } = $i;
  515: 		}
  516: 		@config_files_to_load = sort {
  517: 			($class_order{ $a->{class} } // 999) <=> ($class_order{ $b->{class} } // 999)
  518: 		} @config_files_to_load;
  519: 
  520: 		my $merged_params = { %$params };
  521: 
  522: 		foreach my $config_info (@config_files_to_load) {
  523: 			my $cfg_file    = $config_info->{file};
  524: 			my $cfg_class   = $config_info->{class};
  525: 			my $section_name = $cfg_class;
  526: 			$section_name =~ s/::/__/g;
  527: 
  528: 			# Load only the specific file; do not re-pass config_dirs to avoid
  529: 			# re-scanning directories and picking up the wrong file for this class.
  530: 			my $config = Config::Abstraction->new(
  531: 				config_file => $cfg_file,
  532: 				env_prefix  => "${section_name}__"
  533: 			);
  534: 
  535: 			if($config) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  536: 				my $this_config = $config->merge_defaults(
  537: 					defaults => {},
  538: 					section  => $section_name,
  539: 					merge    => 1,
  540: 					deep     => 1
  541: 				);
  542: 				$merged_params = _deep_merge($merged_params, $this_config);
  543: 			} elsif($@) {
  544: 				carp("Warning: Can't load configuration from $cfg_file: $@");
  545: 			}
  546: 		}
  547: 
  548: 		$params = $merged_params;
  549: 	} elsif(my $config = Config::Abstraction->new(env_prefix => "${class}__")) {
  550: 		# No config file: honour environment variables across the full ancestor chain.
  551: 		my $merged_config = {};
  552: 
  553: 		# Iterate base-first so that each more-specific class overrides the more
  554: 		# general one: UNIVERSAL → GrandParent → Parent → Child.
  555: 		foreach my $ancestor_class (@inheritance_chain) {
  556: 			my $section_name = $ancestor_class;
  557: 			$section_name =~ s/::/__/g;
  558: 
  559: 			my $ancestor_env_config = Config::Abstraction->new(env_prefix => "${section_name}__");
  560: 			if($ancestor_env_config) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  561: 				my $ancestor_config = $ancestor_env_config->merge_defaults(
  562: 					defaults => {},
  563: 					section  => $section_name,
  564: 					merge    => 1,
  565: 					deep     => 1
  566: 				);
  567: 				$merged_config = _deep_merge($merged_config, $ancestor_config);
  568: 			}
  569: 		}
  570: 
  571: 		$params = $config->merge_defaults(
  572: 			defaults => $params,
  573: 			section  => $class,
  574: 			merge    => 1,
  575: 			deep     => 1
  576: 		);
  577: 
  578: 		$params = _deep_merge($merged_config, $params);
  579: 
  580: 		if($params->{config_path} && -f $params->{config_path}) {

					

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

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

  581: 			$_config_file_stats{ $params->{config_path} } = stat($params->{config_path});
  582: 		}
  583: 	}
  584: 
●585 → 595 → 598  585: 	my $croak_on_error = exists($params->{'croak_on_error'}) ? $params->{'croak_on_error'} : 1;
  586: 	my $carp_on_warn   = exists($params->{'carp_on_warn'})   ? $params->{'carp_on_warn'}   : 0;
  587: 
  588: 	# User-supplied logger always wins over config-file logger.
  589: 	# $array_logger is defined when the caller passed an arrayref; it was deleted from
  590: 	# $params before config merging so the merge couldn't overwrite it.  Config-file logger
  591: 	# (a hashref from YAML) is only used when the caller gave no explicit logger at all.
  592: 	my $logger_spec = defined($array_logger) ? $array_logger : $params->{'logger'};
  593: 	$params->{'logger'} = _build_logger($logger_spec, $carp_on_warn);
  594: 
  595: 	if(!exists($params->{_config_file})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  596: 		$params->{_config_file} = $config_file if defined $config_file;
  597: 	}
●598 → 598 → 604  598: 	if(!exists($params->{_config_files})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  599: 		$params->{_config_files} = [ map { $_->{file} } @config_files_to_load ]
  600: 			if @config_files_to_load;
  601: 	}
  602: 
  603: 	# Re-attach stashed coderefs/objects via hash slice
  604: 	@{$params}{ keys %stashed_values } = values %stashed_values if %stashed_values;
  605: 
  606: 	return Return::Set::set_return($params, { 'type' => 'hashref' });
  Mutants (Total: 2, Killed: 2, Survived: 0)
  607: }
  608: 
  609: =head2 instantiate($class,...)
  610: 
  611: Create and configure an object of a third-party class without modifying the class itself.
  612: 
  613: =head3 Purpose
  614: 
  615: Provides a convenient way to make third-party classes (those you cannot modify) configurable
  616: at runtime using Object::Configure. This is a wrapper that calls C<configure> and then
  617: instantiates the class.
  618: 
  619: =head3 Arguments
  620: 
  621: Takes a hash or hashref with the following keys:
  622: 
  623: =over 4
  624: 
  625: =item * C<class> (Required)
  626: 
  627: The fully-qualified class name to instantiate (e.g., C<'LWP::UserAgent'>).
  628: 
  629: =item * Additional keys
  630: 
  631: Any additional keys are passed through to C<configure> and then to the class constructor.
  632: 
  633: =back
  634: 
  635: =head3 Returns
  636: 
  637: A blessed object of the specified class, configured according to the parameters and
  638: configuration files.
  639: 
  640: =head3 Side Effects
  641: 
  642: =over 4
  643: 
  644: =item * Calls C<configure> (see its side effects)
  645: 
  646: =item * Calls the C<new> method on the specified class
  647: 
  648: =item * Registers the object for hot reload if a configuration file was used
  649: 
  650: =back
  651: 
  652: =head3 Notes
  653: 
  654: The specified class must have a C<new> method that accepts a hashref of parameters.
  655: This is a "quick and dirty" way to add configuration support to classes you don't control.
  656: 
  657: =head3 Usage Example
  658: 
  659:     use Object::Configure;
  660: 
  661:     # Configure LWP::UserAgent from a config file
  662:     my $ua = Object::Configure::instantiate(
  663:         class => 'LWP::UserAgent',
  664:         config_file => 'lwp.yml',
  665:         config_dirs => ['/etc/myapp'],
  666:         timeout => 30
  667:     );
  668: 
  669: =head3 API Specification
  670: 
  671: =head4 Input
  672: 
  673:     schema => {
  674:         class => {
  675:             type => 'string',
  676:             required => 1,
  677:             description => 'Class name to instantiate',
  678:             can => 'new'
  679:         }
  680:     }
  681: 
  682: =head4 Output
  683: 
  684:     type => 'object',
  685:     description => 'Instance of the specified class'
  686: 
  687: =cut
  688: 
  689: sub instantiate
  690: {
  691: 	my $params = Params::Get::get_params('class', @_);
  692: 
  693: 	my $class = $params->{'class'};
  694: 	$params = configure($class, $params);
  695: 
  696: 	my $obj = $class->new($params);
  697: 
  698: 	register_object($class, $obj) if $params->{_config_file};
  699: 
  700: 	return $obj;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  701: }
  702: 
  703: =head1 HOT RELOAD FEATURES
  704: 
  705: =head2 enable_hot_reload
  706: 
  707: Enable automatic hot reloading of configuration files when they are modified.
  708: 
  709: =head3 Purpose
  710: 
  711: Starts a background process that monitors configuration files for changes and automatically
  712: reloads them into registered objects. This allows runtime configuration updates without
  713: restarting the application.
  714: 
  715: =head3 Arguments
  716: 
  717: Takes a hash with the following optional keys:
  718: 
  719: =over 4
  720: 
  721: =item * C<interval> (Optional, default: 10)
  722: 
  723: Number of seconds between configuration file checks. Lower values provide faster
  724: response to changes but consume more CPU.
  725: 
  726: =item * C<callback> (Optional)
  727: 
  728: A coderef to execute after configuration files are reloaded. Useful for logging
  729: or triggering application-specific reload behavior.
  730: 
  731: =back
  732: 
  733: =head3 Returns
  734: 
  735: The process ID (PID) of the background watcher process on success.
  736: Returns immediately if hot reload is already enabled.
  737: 
  738: =head3 Side Effects
  739: 
  740: =over 4
  741: 
  742: =item * Forks a background process to monitor configuration files
  743: 
  744: =item * The background process sends SIGUSR1 to the parent when changes are detected
  745: 
  746: =item * Stores the watcher PID in C<%_config_watchers>
  747: 
  748: =item * May throw an exception (via C<croak>) if the fork fails
  749: 
  750: =back
  751: 
  752: =head3 Notes
  753: 
  754: Hot reload is not supported on Windows due to lack of SIGUSR1 signal support.
  755: The background process runs indefinitely until C<disable_hot_reload> is called.
  756: Objects must be registered via C<register_object> to receive configuration updates.
  757: 
  758: =head3 Usage Example
  759: 
  760:     use Object::Configure;
  761: 
  762:     # Enable hot reload with 5-second check interval
  763:     Object::Configure::enable_hot_reload(
  764:         interval => 5,
  765:         callback => sub {
  766:             my $timestamp = localtime;
  767:             print "[$timestamp] Configuration reloaded\n";
  768:         }
  769:     );
  770: 
  771:     # Application continues running...
  772:     while (1) {
  773:         # Do work...
  774:         sleep(1);
  775:     }
  776: 
  777: =head3 API Specification
  778: 
  779: =head4 Input
  780: 
  781:     schema => {
  782:         interval => {
  783:             type => 'integer',
  784:             optional => 1,
  785:             default => 10,
  786:             min => 1,
  787:             description => 'Check interval in seconds'
  788:         },
  789:         callback => {
  790:             type => 'coderef',
  791:             optional => 1,
  792:             description => 'Code to execute after reload'
  793:         }
  794:     }
  795: 
  796: =head4 Output
  797: 
  798:     type => 'integer',
  799:     description => 'PID of background watcher process',
  800:     condition => 'value > 0'
  801: 
  802: =cut
  803: 
  804: sub enable_hot_reload {
●805 → 812 → 0  805: 	my %params = @_;
  806: 
  807: 	my $interval = $params{interval} || 10;
  808: 	my $callback = $params{callback};
  809: 
  810: 	return if %_config_watchers;	# already watching; avoid double-fork
  811: 
  812: 	if(my $pid = fork()) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  813: 		$_config_watchers{pid}      = $pid;
  814: 		$_config_watchers{callback} = $callback;
  815: 		return $pid;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  816: 	} elsif(defined $pid) {
  817: 		# Child: run forever, signal parent on change
  818: 		_run_config_watcher($interval, $callback);
  819: 		exit 0;
  820: 	} else {
  821: 		croak("Failed to fork config watcher: $!");
  822: 	}
  823: }
  824: 
  825: =head2 disable_hot_reload
  826: 
  827: Disable hot reloading and terminate the background watcher process.
  828: 
  829: =head3 Purpose
  830: 
  831: Cleanly shuts down the hot reload system by terminating the background watcher
  832: process and clearing internal state.
  833: 
  834: =head3 Arguments
  835: 
  836: None.
  837: 
  838: =head3 Returns
  839: 
  840: Nothing.
  841: 
  842: =head3 Side Effects
  843: 
  844: =over 4
  845: 
  846: =item * Sends SIGTERM to the background watcher process
  847: 
  848: =item * Waits for the watcher process to terminate
  849: 
  850: =item * Clears C<%_config_watchers> state
  851: 
  852: =back
  853: 
  854: =head3 Notes
  855: 
  856: Safe to call even if hot reload is not currently enabled.
  857: The function blocks until the watcher process has fully terminated.
  858: 
  859: =head3 Usage Example
  860: 
  861:     use Object::Configure;
  862: 
  863:     # Enable hot reload
  864:     Object::Configure::enable_hot_reload(interval => 5);
  865: 
  866:     # ... application runs ...
  867: 
  868:     # Clean shutdown
  869:     Object::Configure::disable_hot_reload();
  870: 
  871: =head3 API Specification
  872: 
  873: =head4 Input
  874: 
  875:     schema => {}
  876: 
  877: =head4 Output
  878: 
  879:     type => 'void'
  880: 
  881: =cut
  882: 
  883: sub disable_hot_reload {
  884: 	## MUTANT_SKIP_BEGIN
●885 → 885 → 0  885: 	if(my $pid = $_config_watchers{pid}) {
  886: 		if($pid =~ /\A[0-9]+\z/ && $pid > 0) {
  887: 			kill('TERM', $pid);
  888: 
  889: 			# Poll up to KILL_TIMEOUT seconds; escalate to SIGKILL if SIGTERM is ignored.
  890: 			# SIGKILL cannot be caught or deferred so the subsequent waitpid is always safe.
  891: 			my $deadline = time() + $KILL_TIMEOUT;
  892: 			my $kid;
  893: 			do {
  894: 				$kid = waitpid($pid, WNOHANG);
  895: 				if($kid == 0 && time() < $deadline) {
  896: 					select undef, undef, undef, $POLL_SLEEP;
  897: 				}
  898: 			} while($kid == 0 && time() < $deadline);
  899: 
  900: 			if($kid == 0) {
  901: 				kill('KILL', $pid);
  902: 				waitpid($pid, 0);
  903: 			}
  904: 		}
  905: 		%_config_watchers = ();
  906: 	}
  907: 	## MUTANT_SKIP_END
  908: }
  909: 
  910: =head2 reload_config
  911: 
  912: Manually trigger configuration reload for all registered objects.
  913: 
  914: =head3 Purpose
  915: 
  916: Forces an immediate reload of configuration from files for all objects that have been
  917: registered for hot reload. This is useful for testing or forcing a reload without
  918: waiting for the automatic file monitoring to detect changes.
  919: 
  920: =head3 Arguments
  921: 
  922: None.
  923: 
  924: =head3 Returns
  925: 
  926: An integer count of how many objects had their configuration successfully reloaded.
  927: 
  928: =head3 Side Effects
  929: 
  930: =over 4
  931: 
  932: =item * Reads configuration files from disk
  933: 
  934: =item * Updates object properties with new configuration values
  935: 
  936: =item * Calls C<_on_config_reload> hook on objects that implement it
  937: 
  938: =item * Cleans up dead weak references from C<%_object_registry>
  939: 
  940: =item * May emit warnings if configuration reload fails for any object
  941: 
  942: =back
  943: 
  944: =head3 Notes
  945: 
  946: Only objects registered via C<register_object> are reloaded.
  947: Objects are updated in-place; their identity does not change.
  948: Private properties (those starting with C<_>) are not updated during reload.
  949: 
  950: =head3 Usage Example
  951: 
  952:     use Object::Configure;
  953: 
  954:     # Create and register objects
  955:     my $obj = My::Module->new(config_file => 'app.yml');
  956: 
  957:     # Manually edit app.yml...
  958: 
  959:     # Force immediate reload
  960:     my $count = Object::Configure::reload_config();
  961:     print "Reloaded configuration for $count objects\n";
  962: 
  963: =head3 API Specification
  964: 
  965: =head4 Input
  966: 
  967:     schema => {}
  968: 
  969: =head4 Output
  970: 
  971:     type => 'integer',
  972:     description => 'Number of objects successfully reloaded',
  973:     condition => 'value >= 0'
  974: 
  975: =cut
  976: 
  977: sub reload_config {
●978 → 980 → 1002  978: 	my $reloaded_count = 0;
  979: 
  980: 	foreach my $class_key (keys %_object_registry) {
  981: 		my $objects = $_object_registry{$class_key};
  982: 
  983: 		@$objects = grep { defined $_ } @$objects;	# prune garbage-collected weak refs
  984: 
  985: 		foreach my $obj_ref (@$objects) {
  986: 			if(my $obj = $$obj_ref) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  987: 				# Protect the caller's $@ from being clobbered by our internal eval blocks.
  988: 				local $@;
  989: 				eval {
  990: 					_reload_object_config($obj);
  991: 					$reloaded_count++;
  992: 				};
  993: 				if($@) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  994: 					carp("Failed to reload config for object: $@");
  995: 				}
  996: 			}
  997: 		}
  998: 
  999: 		delete $_object_registry{$class_key} unless @$objects;
 1000: 	}
 1001: 
 1002: 	return $reloaded_count;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1003: }
 1004: 
 1005: =head2 register_object($class, $obj)
 1006: 
 1007: Register an object for hot reload monitoring.
 1008: 
 1009: =head3 Purpose
 1010: 
 1011: Adds an object to the hot reload registry so it will receive automatic configuration
 1012: updates when files change. Uses weak references to prevent memory leaks.
 1013: 
 1014: =head3 Arguments
 1015: 
 1016: =over 4
 1017: 
 1018: =item * C<class> (Required)
 1019: 
 1020: The class name of the object, used for organizing the registry.
 1021: 
 1022: =item * C<obj> (Required)
 1023: 
 1024: The object instance to register. Must be a blessed reference.
 1025: 
 1026: =back
 1027: 
 1028: =head3 Returns
 1029: 
 1030: Nothing.
 1031: 
 1032: =head3 Side Effects
 1033: 
 1034: =over 4
 1035: 
 1036: =item * Adds a weak reference to the object in C<%_object_registry>
 1037: 
 1038: =item * Sets up SIGUSR1 signal handler on first call (Unix-like systems only)
 1039: 
 1040: =item * Stores the original SIGUSR1 handler for later restoration
 1041: 
 1042: =back
 1043: 
 1044: =head3 Notes
 1045: 
 1046: Objects are stored using weak references, so they will be automatically
 1047: garbage collected when no other references exist.
 1048: The SIGUSR1 handler chains to any existing handler that was installed.
 1049: On Windows, the signal handler is not installed (SIGUSR1 does not exist).
 1050: 
 1051: =head3 Usage Example
 1052: 
 1053:     package My::Module;
 1054:     use Object::Configure;
 1055: 
 1056:     sub new {
 1057:         my $class = shift;
 1058:         my $params = Object::Configure::configure($class, {
 1059:             config_file => 'mymodule.yml',
 1060:         });
 1061:         my $self = bless $params, $class;
 1062: 
 1063:         # Register for hot reload
 1064:         Object::Configure::register_object($class, $self)
 1065:             if $params->{_config_file};
 1066: 
 1067:         return $self;
 1068:     }
 1069: 
 1070: =head3 API Specification
 1071: 
 1072: =head4 Input
 1073: 
 1074:     schema => {
 1075:         class => {
 1076:             type => 'string',
 1077:             required => 1,
 1078:             description => 'Class name for registry organization'
 1079:         },
 1080:         obj => {
 1081:             type => 'object',
 1082:             required => 1,
 1083:             description => 'Blessed object instance to register'
 1084:         }
 1085:     }
 1086: 
 1087: =head4 Output
 1088: 
 1089:     type => 'void'
 1090: 
 1091: =cut
 1092: 
 1093: sub register_object
 1094: {
●1095 → 1108 → 1128 1095: 	my ($class, $obj) = @_;
 1096: 
 1097: 	croak(__PACKAGE__, '::register_object: Usage ($class, $obj)')
 1098: 		unless defined($class) && defined($obj);
 1099: 
 1100: 	my $obj_ref = \$obj;
 1101: 	weaken($$obj_ref);
 1102: 	push @{ $_object_registry{$class} }, $obj_ref;
 1103: 
 1104: 	# Install SIGUSR1 handler exactly once.  We save the previous handler so
 1105: 	# we can chain to it (another module may have installed one) and restore it
 1106: 	# on shutdown.  On Windows SIGUSR1 does not exist so we skip the signal work
 1107: 	# but still save $_original_usr1_handler so restore_signal_handlers is safe.
 1108: 	if(!defined $_original_usr1_handler) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1109: 		$_original_usr1_handler = $SIG{USR1} || $SIG_DEFAULT;
 1110: 
 1111: 		return if $^O eq $OS_WINDOWS;
 1112: 
 1113: 		$SIG{USR1} = sub {
 1114: 			reload_config();
 1115: 			$_config_watchers{callback}->() if $_config_watchers{callback};
 1116: 
 1117: 			if(ref($_original_usr1_handler) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1118: 				$_original_usr1_handler->();
 1119: 			} elsif($_original_usr1_handler eq $SIG_DEFAULT
 1120: 			     || $_original_usr1_handler eq $SIG_IGNORE) {
 1121: 				# DEFAULT for USR1 is typically a no-op; IGNORE means discard
 1122: 			} else {
 1123: 				carp("Object::Configure: Cannot chain to non-code USR1 handler: $_original_usr1_handler");
 1124: 			}
 1125: 		};
 1126: 	}
 1127: 
 1128: 	return;
 1129: }
 1130: 
 1131: =head2 restore_signal_handlers
 1132: 
 1133: Restore original signal handlers and disable hot reload integration.
 1134: 
 1135: =head3 Purpose
 1136: 
 1137: Restores the signal handler that was in place before Object::Configure installed
 1138: its SIGUSR1 handler. This is useful for clean shutdown or when transferring
 1139: control to another hot reload system.
 1140: 
 1141: =head3 Arguments
 1142: 
 1143: None.
 1144: 
 1145: =head3 Returns
 1146: 
 1147: Nothing.
 1148: 
 1149: =head3 Side Effects
 1150: 
 1151: =over 4
 1152: 
 1153: =item * Restores C<$SIG{USR1}> to its original value
 1154: 
 1155: =item * Clears C<$_original_usr1_handler> internal state
 1156: 
 1157: =back
 1158: 
 1159: =head3 Notes
 1160: 
 1161: Safe to call even if Object::Configure never installed a signal handler.
 1162: On Windows, this function has no effect (SIGUSR1 does not exist).
 1163: 
 1164: =head3 Usage Example
 1165: 
 1166:     use Object::Configure;
 1167: 
 1168:     # Objects are registered...
 1169: 
 1170:     # Clean shutdown
 1171:     Object::Configure::disable_hot_reload();
 1172:     Object::Configure::restore_signal_handlers();
 1173: 
 1174: =head3 API Specification
 1175: 
 1176: =head4 Input
 1177: 
 1178:     schema => {}
 1179: 
 1180: =head4 Output
 1181: 
 1182:     type => 'void'
 1183: 
 1184: =cut
 1185: 
 1186: sub restore_signal_handlers
 1187: {
●1188 → 1188 → 1193 1188: 	if(defined $_original_usr1_handler) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1189: 		$SIG{USR1} = $_original_usr1_handler unless $^O eq $OS_WINDOWS;
 1190: 		$_original_usr1_handler = undef;
 1191: 	}
 1192: 
 1193: 	return;
 1194: }
 1195: 
 1196: =head2 get_signal_handler_info
 1197: 
 1198: Get information about the current signal handler setup for debugging.
 1199: 
 1200: =head3 Purpose
 1201: 
 1202: Returns diagnostic information about the signal handler state, useful for
 1203: debugging signal handler chains or verifying hot reload configuration.
 1204: 
 1205: =head3 Arguments
 1206: 
 1207: None.
 1208: 
 1209: =head3 Returns
 1210: 
 1211: A hashref containing the following keys:
 1212: 
 1213: =over 4
 1214: 
 1215: =item * C<original_usr1>
 1216: 
 1217: The signal handler that was installed before Object::Configure's handler,
 1218: or undef if no handler was present.
 1219: 
 1220: =item * C<current_usr1>
 1221: 
 1222: The currently installed SIGUSR1 handler.
 1223: 
 1224: =item * C<hot_reload_active>
 1225: 
 1226: Boolean indicating whether Object::Configure's hot reload handler is active.
 1227: 
 1228: =item * C<watcher_pid>
 1229: 
 1230: The PID of the background watcher process, or undef if not running.
 1231: 
 1232: =back
 1233: 
 1234: =head3 Notes
 1235: 
 1236: This is primarily a debugging aid and is not needed for normal operation.
 1237: 
 1238: =head3 Usage Example
 1239: 
 1240:     use Object::Configure;
 1241:     use Data::Dumper;
 1242: 
 1243:     Object::Configure::enable_hot_reload();
 1244: 
 1245:     my $info = Object::Configure::get_signal_handler_info();
 1246:     print Dumper($info);
 1247:     # $VAR1 = {
 1248:     #     'original_usr1' => 'DEFAULT',
 1249:     #     'current_usr1' => CODE(0x...),
 1250:     #     'hot_reload_active' => 1,
 1251:     #     'watcher_pid' => 12345
 1252:     # };
 1253: 
 1254: =head3 API Specification
 1255: 
 1256: =head4 Input
 1257: 
 1258:     schema => {}
 1259: 
 1260: =head4 Output
 1261: 
 1262:     type => 'hashref',
 1263:     schema => {
 1264:         original_usr1 => {
 1265:             type => [qw(coderef string undef)],
 1266:             description => 'Original SIGUSR1 handler'
 1267:         },
 1268:         current_usr1 => {
 1269:             type => [qw(coderef string undef)],
 1270:             description => 'Current SIGUSR1 handler'
 1271:         },
 1272:         hot_reload_active => {
 1273:             type => 'boolean',
 1274:             description => 'Whether hot reload is active'
 1275:         },
 1276:         watcher_pid => {
 1277:             type => [qw(integer undef)],
 1278:             description => 'Background watcher process PID'
 1279:         }
 1280:     }
 1281: 
 1282: =cut
 1283: 
 1284: sub get_signal_handler_info {
 1285: 	return {
 1286: 		original_usr1    => $_original_usr1_handler,
 1287: 		current_usr1     => $SIG{USR1},
 1288: 		hot_reload_active => defined $_original_usr1_handler,
 1289: 		watcher_pid      => $_config_watchers{pid},
 1290: 	};
 1291: }
 1292: 
 1293: # ----------------------------------------------------------------------------
 1294: # Private helpers
 1295: # All routines below are implementation details; callers must not rely on them.
 1296: # ----------------------------------------------------------------------------
 1297: 
 1298: # Purpose:   Consolidate all logger-creation paths into one place.
 1299: #            Called from configure() and _reconfigure_logger() to eliminate
 1300: #            the duplication that existed between the two.
 1301: # Entry:     $spec may be: undef (want default), the string 'NULL' (no logging),
 1302: #            an ARRAY ref (log-capture array), a HASH ref (options for Log::Abstraction),
 1303: #            a pre-built Log::Abstraction instance (pass through), or any other
 1304: #            scalar (treated as a logger name / file path).
 1305: #            $carp_on_warn is a boolean controlling Carp::carp integration.
 1306: # Exit:      Returns a Log::Abstraction instance, or the string 'NULL'.
 1307: # Side:      May allocate a new Log::Abstraction object.
 1308: sub _build_logger {
●1309 → 1321 → 1325 1309: 	my ($spec, $carp_on_warn) = @_;
 1310: 	$carp_on_warn //= 0;
 1311: 
 1312: 	return Log::Abstraction->new(carp_on_warn => $carp_on_warn)
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1313: 		unless defined $spec;
 1314: 
 1315: 	return $LOGGER_NULL
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1316: 		if !ref($spec) && $spec eq $LOGGER_NULL;
 1317: 
 1318: 	return $spec

					

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

				
BOOL_NEGATE_1318_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1318_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1319: 		if blessed($spec) && $spec->isa('Log::Abstraction');
 1320: 
 1321: 	if(ref($spec) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1322: 		return Log::Abstraction->new(array => $spec, carp_on_warn => $carp_on_warn);
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1323: 	}
 1324: 
●1325 → 1325 → 1330 1325: 	if(ref($spec) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1326: 		return Log::Abstraction->new({ carp_on_warn => $carp_on_warn, %$spec });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1327: 	}
 1328: 
 1329: 	# Scalar: a logger name, file path, or other string identifier passed to L::A
 1330: 	return Log::Abstraction->new({ carp_on_warn => $carp_on_warn, logger => $spec });
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1331: }
 1332: 
 1333: # Purpose:   Build the ancestor chain needed for config-file discovery and env merging.
 1334: #            Uses the class's own MRO (DFS or C3) via mro::get_linear_isa, which is
 1335: #            more correct than a hardcoded DFS walk and handles diamond inheritance.
 1336: #            UNIVERSAL is added explicitly because mro::get_linear_isa does not include
 1337: #            it unless it appears in @ISA, yet Object::Configure supports universal.yml.
 1338: # Entry:     $class is a fully-qualified class name that has already been loaded.
 1339: # Exit:      Returns a list in base-first order: (UNIVERSAL, ..., GrandParent, Parent, Class).
 1340: sub _get_inheritance_chain {
 1341: 	my ($class) = @_;
 1342: 
 1343: 	my @mro = @{ mro::get_linear_isa($class) };
 1344: 
 1345: 	# mro::get_linear_isa returns child-first; reverse to get base-first.
 1346: 	# UNIVERSAL is implicit in Perl's type system but not always in the MRO list,
 1347: 	# so append it when absent to ensure universal.yml is picked up.
 1348: 	push @mro, 'UNIVERSAL' unless grep { $_ eq 'UNIVERSAL' } @mro;
 1349: 
 1350: 	return reverse @mro;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1351: }
 1352: 
 1353: # Purpose:   Find a config file for a specific ancestor class using the same
 1354: #            naming convention as the primary config file (directory + extension).
 1355: # Entry:     $class is a fully-qualified class name.
 1356: #            $base_config_file is the primary config file path (provides dir and ext).
 1357: #            $config_dirs is an optional arrayref of additional search directories.
 1358: # Exit:      Returns a readable file path, or undef if nothing found.
 1359: sub _find_class_config_file {
●1360 → 1378 → 1382 1360: 	my ($class, $base_config_file, $config_dirs) = @_;
 1361: 
 1362: 	my $class_file = lc($class);
 1363: 	$class_file =~ s/::/-/g;
 1364: 
 1365: 	my ($base_vol, $base_dir_part, $base_name_ext) = File::Spec->splitpath($base_config_file);
 1366: 	my (undef, $base_ext) = $base_name_ext =~ /^(.*?)(\.[^.]+)?$/;
 1367: 	$base_ext //= '';
 1368: 	my $base_dir = File::Spec->catpath($base_vol, $base_dir_part, '');
 1369: 
 1370: 	my @base_patterns = (
 1371: 		File::Spec->catfile($base_dir, "${class_file}${base_ext}"),
 1372: 		File::Spec->catfile($base_dir, "${class_file}.conf"),
 1373: 		File::Spec->catfile($base_dir, "${class_file}.yml"),
 1374: 		File::Spec->catfile($base_dir, "${class_file}.yaml"),
 1375: 		File::Spec->catfile($base_dir, "${class_file}.json"),
 1376: 	);
 1377: 
 1378: 	foreach my $pattern (@base_patterns) {
 1379: 		return $pattern if -r $pattern && -f $pattern;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1380: 	}
 1381: 
●1382 → 1382 → 1397 1382: 	if($config_dirs && ref($config_dirs) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1383: 		foreach my $dir (@$config_dirs) {
 1384: 			$dir =~ s{/$}{};
 1385: 			foreach my $pattern (
 1386: 				"${dir}/${class_file}${base_ext}",
 1387: 				"${dir}/${class_file}.conf",
 1388: 				"${dir}/${class_file}.yml",
 1389: 				"${dir}/${class_file}.yaml",
 1390: 				"${dir}/${class_file}.json",
 1391: 			) {
 1392: 				return $pattern if -r $pattern && -f $pattern;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1393: 			}
 1394: 		}
 1395: 	}
 1396: 
 1397: 	return undef;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1398: }
 1399: 
 1400: # Purpose:   Run as the forked watcher child.  Polls %_config_file_stats and
 1401: #            sends SIGUSR1 to the parent when any file changes.
 1402: # Entry:     $interval >= 1 (seconds). $callback is unused in the child (it runs
 1403: #            in the parent's SIGUSR1 handler).
 1404: # Exit:      Never returns; terminates via SIGTERM/SIGINT handlers.
 1405: # Side:      Modifies %_config_file_stats entries in the child's address space only.
 1406: sub _run_config_watcher {
●1407 → 1412 → 0 1407: 	my ($interval, $callback) = @_;
 1408: 
 1409: 	local $SIG{TERM} = sub { exit 0 };
 1410: 	local $SIG{INT}  = sub { exit 0 };
 1411: 
 1412: 	while(1) {
 1413: 		sleep($interval);
 1414: 
 1415: 		my $changes_detected = 0;
 1416: 
 1417: 		foreach my $config_file (keys %_config_file_stats) {
 1418: 			if(-f $config_file) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1419: 				my $current_stat = stat($config_file);
 1420: 				my $stored_stat  = $_config_file_stats{$config_file};
 1421: 
 1422: 				if(!$stored_stat || $current_stat->mtime > $stored_stat->mtime) {
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1423: 					$_config_file_stats{$config_file} = $current_stat;
 1424: 					$changes_detected = 1;
 1425: 				}
 1426: 			} else {
 1427: 				delete $_config_file_stats{$config_file};
 1428: 				$changes_detected = 1;
 1429: 			}
 1430: 		}
 1431: 
 1432: 		if($changes_detected && $^O ne $OS_WINDOWS) {

					

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

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

 1433: 			if(my $parent_pid = getppid()) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1434: 				kill('USR1', $parent_pid);
 1435: 			}
 1436: 		}
 1437: 	}
 1438: }
 1439: 
 1440: # Purpose:   Reload a single object's configuration from disk and update its fields.
 1441: #            Private properties (prefix '_') are intentionally skipped to avoid
 1442: #            clobbering internal bookkeeping set at construction time.
 1443: # Entry:     $obj must be a blessed reference with a {_config_file} or {_config_files} key.
 1444: # Exit:      Returns nothing; updates $obj in-place.
 1445: # Side:      Reads from disk. Calls $obj->_on_config_reload if the method exists.
 1446: sub _reload_object_config {
●1447 → 1457 → 1463 1447: 	my $obj = $_[0];
 1448: 
 1449: 	return unless blessed($obj);
 1450: 
 1451: 	my $class          = ref($obj);
 1452: 	my $original_class = $class;
 1453: 	$class =~ s/::/__/g;
 1454: 
 1455: 	# Prefer the most-specific (last) file from the full list; fall back to scalar key
 1456: 	my $config_file;
 1457: 	if($obj->{_config_files} && ref($obj->{_config_files}) eq 'ARRAY' && @{ $obj->{_config_files} }) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1458: 		$config_file = $obj->{_config_files}[-1];
 1459: 	} else {
 1460: 		$config_file = $obj->{_config_file} || $obj->{config_file};
 1461: 	}
 1462: 
●1463 → 1470 → 1501 1463: 	return unless $config_file && -f $config_file;
 1464: 
 1465: 	my $config = Config::Abstraction->new(
 1466: 		config_file => $config_file,
 1467: 		env_prefix  => "${class}__"
 1468: 	);
 1469: 
 1470: 	if($config) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1471: 		my $new_params = $config->merge_defaults(
 1472: 			defaults => {},
 1473: 			section  => $class,
 1474: 			merge    => 1,
 1475: 			deep     => 1
 1476: 		);
 1477: 
 1478: 		foreach my $key (keys %$new_params) {
 1479: 			next if $key =~ /^_/;
 1480: 
 1481: 			if($key eq 'logger') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1482: 				# Only the exact 'logger' key triggers logger reconstruction.
 1483: 				# Keys like 'logger.file' are flat config values, not logger specs.
 1484: 				my $val = $new_params->{$key};
 1485: 				if(ref($val) || (defined($val) && $val ne $LOGGER_NULL)) {

					

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

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

 1486: 					_reconfigure_logger($obj, $key, $val);
 1487: 				} else {
 1488: 					$obj->{$key} = $val;
 1489: 				}
 1490: 			} else {
 1491: 				$obj->{$key} = $new_params->{$key};
 1492: 			}
 1493: 		}
 1494: 
 1495: 		$obj->_on_config_reload($new_params) if $obj->can('_on_config_reload');
 1496: 
 1497: 		$obj->{logger}->info("Configuration reloaded for $original_class")
 1498: 			if $obj->{logger} && $obj->{logger}->can('info');
 1499: 	}
 1500: 
 1501: 	return;
 1502: }
 1503: 
 1504: # Purpose:   Replace the logger on an already-constructed object with one
 1505: #            built from a new config value (typically a YAML hashref).
 1506: #            Delegates to _build_logger so logger-creation logic lives in one place.
 1507: # Entry:     $obj is a blessed hashref. $key is the hash key to update (usually 'logger').
 1508: #            $logger_config is the new spec from the config file.
 1509: # Exit:      Returns nothing; updates $obj->{$key} in-place.
 1510: # Side:      May allocate a new Log::Abstraction instance.
 1511: sub _reconfigure_logger
 1512: {
 1513: 	my ($obj, $key, $logger_config) = @_;
 1514: 	my $carp_on_warn = $obj->{carp_on_warn} || 0;
 1515: 	$obj->{$key} = _build_logger($logger_config, $carp_on_warn);
 1516: 	return;
 1517: }
 1518: 
 1519: # Purpose:   Right-precedence deep merge of two hash references.
 1520: #            Scalar/arrayref values in $overlay replace those in $base entirely;
 1521: #            nested hashrefs are merged recursively.
 1522: # Entry:     Both args should be hashrefs (or undef/non-ref, handled gracefully).
 1523: # Exit:      Returns a new hashref; neither input is modified.
 1524: sub _deep_merge {
●1525 → 1532 → 1540 1525: 	my ($base, $overlay) = @_;
 1526: 
 1527: 	return $overlay unless ref($base)    eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1528: 	return $overlay unless ref($overlay) eq 'HASH';
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1529: 
 1530: 	my $result = { %$base };
 1531: 
 1532: 	foreach my $key (keys %$overlay) {
 1533: 		if(ref($overlay->{$key}) eq 'HASH' && ref($result->{$key}) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1534: 			$result->{$key} = _deep_merge($result->{$key}, $overlay->{$key});
 1535: 		} else {
 1536: 			$result->{$key} = $overlay->{$key};
 1537: 		}
 1538: 	}
 1539: 
 1540: 	return $result;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1541: }
 1542: 
 1543: # Clean up the watcher child and restore signal state on interpreter exit.
 1544: END {
 1545: 	disable_hot_reload();
 1546: 	restore_signal_handlers();
 1547: }
 1548: 
 1549: =head1 SEE ALSO
 1550: 
 1551: =over 4
 1552: 
 1553: =item * L<Config::Abstraction>
 1554: 
 1555: =item * L<Log::Abstraction>
 1556: 
 1557: =item * L<Test Dashboard|https://nigelhorne.github.io/Object-Configure/coverage/>
 1558: 
 1559: =back
 1560: 
 1561: =head1 LIMITATIONS
 1562: 
 1563: =over 4
 1564: 
 1565: =item * B<Global singleton state.> C<%_object_registry>, C<%_config_watchers>, and
 1566: C<%_config_file_stats> are package globals.  Two independent subsystems in the same
 1567: process share one hot-reload registry and one SIGUSR1 handler.  There is no
 1568: instance-level isolation.  A proper fix would wrap state in an object and allow
 1569: multiple independent C<Object::Configure> instances, but that would break the
 1570: existing constructor-call API (C<configure($class, \%params)>).
 1571: 
 1572: =item * B<Hot reload is Unix-only.> SIGUSR1 does not exist on Windows.
 1573: All signal-related paths are guarded with C<$^O ne 'MSWin32'>, so the module
 1574: loads on Windows but silently skips hot-reload registration.
 1575: 
 1576: =item * B<configure() is a God function.> At ~120 lines it handles arg validation,
 1577: config-file discovery, MRO walking, multi-file merging, env-var merging, logger
 1578: creation, and hot-reload bookkeeping.  Future versions should decompose this into
 1579: smaller, independently testable units.
 1580: 
 1581: =item * B<_deep_merge reimplements CPAN.> L<Hash::Merge::Simple> or L<Hash::Merge>
 1582: provide tested, feature-complete deep merge.  The internal C<_deep_merge> is 15
 1583: lines and correct for the current use, but does not handle arrayrefs (they are
 1584: replaced wholesale, not merged).  If array-merge semantics are ever needed, switch
 1585: to a CPAN module.
 1586: 
 1587: =item * B<No encapsulation enforcement.> Private helpers (C<_build_logger>,
 1588: C<_get_inheritance_chain>, etc.) are accessible to any caller.  L<Sub::Private>
 1589: (enforce mode) would make accidental external use a compile-time error.  It is not
 1590: added here to avoid a smoker dependency on a less-common module.
 1591: 
 1592: =item * B<configure() signature is positional, instantiate() is named.>  The two
 1593: public constructors have inconsistent calling conventions.  Normalising them to named
 1594: args would require a deprecation cycle.
 1595: 
 1596: =item * B<mro::get_linear_isa and UNIVERSAL.>  Perl's C<mro::get_linear_isa> does
 1597: not include C<UNIVERSAL> in its output unless C<UNIVERSAL> appears explicitly in
 1598: C<@ISA>.  This module appends C<UNIVERSAL> manually so that C<universal.yml> is
 1599: always discovered.  If a future Perl version changes this behaviour the guard
 1600: (C<grep { $_ eq 'UNIVERSAL' }>) remains correct.
 1601: 
 1602: =back
 1603: 
 1604: =head1 Formal Specification
 1605: 
 1606: =head2 configure
 1607: 
 1608:     configure: Class x Params -> ConfigHash
 1609: 
 1610:     Given:
 1611:     - C: set of all class names
 1612:     - P: set of all parameter hashes
 1613:     - F: set of all file paths
 1614:     - H: set of all configuration hashes
 1615: 
 1616:     State:
 1617:     - ConfigFiles: F -> H (maps file paths to configuration content)
 1618:     - EnvVars: String -> String (environment variables)
 1619:     - InheritanceChain: C -> seq C (ordered sequence of ancestor classes)
 1620: 
 1621:     Pre-condition:
 1622:     forall class in C, params in P:
 1623:         class != empty
 1624:         (params.config_file != empty =>
 1625:             (exists dir in params.config_dirs: readable(dir/params.config_file))
 1626:             OR readable(params.config_file))
 1627: 
 1628:     Post-condition:
 1629:     forall result in H:
 1630:         result = params
 1631:                  (+) (merge f in InheritanceConfigFiles(class): ConfigFiles(f))
 1632:                  (+) (merge v in RelevantEnvVars(class): v)
 1633:         result.logger in Log::Abstraction
 1634:         (forall k in dom params:
 1635:             (params(k) in CodeRef OR blessed(params(k))) => result(k) = params(k))
 1636: 
 1637:     where (+) denotes hash merge with right-precedence
 1638: 
 1639: =head2 instantiate
 1640: 
 1641:     instantiate: Params -> Object
 1642: 
 1643:     Given:
 1644:     - P: set of all parameter hashes
 1645:     - C: set of all class names
 1646:     - O: set of all objects
 1647: 
 1648:     Pre-condition:
 1649:     forall params in P:
 1650:         params.class in C
 1651:         params.class.can('new')
 1652: 
 1653:     Post-condition:
 1654:     forall result in O:
 1655:         exists config in H:
 1656:             config = configure(params.class, params)
 1657:             result = params.class.new(config)
 1658:             blessed(result) = params.class
 1659:             (config._config_file != empty =>
 1660:                 result in _object_registry(params.class))
 1661: 
 1662: =head2 enable_hot_reload
 1663: 
 1664:     enable_hot_reload: Interval x Callback -> PID
 1665: 
 1666:     Given:
 1667:     - I: set of positive integers (intervals in seconds)
 1668:     - CB: set of code references
 1669:     - PID: set of process identifiers
 1670: 
 1671:     State:
 1672:     - _config_watchers: {pid: PID, callback: CB}
 1673:     - _config_file_stats: F -> Stat
 1674: 
 1675:     Pre-condition:
 1676:     forall interval in I, callback in CB union {empty}:
 1677:         interval >= 1
 1678:         _config_watchers = empty
 1679:         OS != 'MSWin32'
 1680: 
 1681:     Post-condition:
 1682:     forall result in PID:
 1683:         result > 0
 1684:         _config_watchers.pid = result
 1685:         _config_watchers.callback = callback
 1686:         (forall t in Time:
 1687:             (t mod interval = 0) =>
 1688:                 (exists f in dom _config_file_stats:
 1689:                     mtime(f) > _config_file_stats(f).mtime =>
 1690:                         send_signal(SIGUSR1, parent_process)))
 1691: 
 1692: =head2 disable_hot_reload
 1693: 
 1694:     disable_hot_reload: () -> ()
 1695: 
 1696:     State:
 1697:     - _config_watchers: {pid: PID, callback: CB}
 1698: 
 1699:     Pre-condition:
 1700:     true
 1701: 
 1702:     Post-condition:
 1703:     _config_watchers = empty
 1704:     (forall p in PID:
 1705:         p = _config_watchers.pid@pre =>
 1706:             NOT alive(p))
 1707: 
 1708: =head2 reload_config
 1709: 
 1710:     reload_config: () -> N
 1711: 
 1712:     State:
 1713:     - _object_registry: C -> seq ObjectRef
 1714:     - ConfigFiles: F -> H
 1715: 
 1716:     Pre-condition:
 1717:     true
 1718: 
 1719:     Post-condition:
 1720:     forall result in N:
 1721:         result = |{obj in flatten(ran _object_registry) |
 1722:                    obj != empty
 1723:                    obj._config_file in dom ConfigFiles}|
 1724:         (forall obj in flatten(ran _object_registry):
 1725:             obj != empty AND obj._config_file in dom ConfigFiles =>
 1726:                 (forall k in dom ConfigFiles(obj._config_file):
 1727:                     k NOT in PrivateKeys =>
 1728:                         obj(k)@post = ConfigFiles(obj._config_file)(k)))
 1729: 
 1730:     where PrivateKeys = {k | k starts with '_'}
 1731: 
 1732: =head2 register_object
 1733: 
 1734:     register_object: C x O -> ()
 1735: 
 1736:     Given:
 1737:     - C: set of class names
 1738:     - O: set of blessed objects
 1739:     - OR: C -> seq WeakRef(O) (object registry)
 1740: 
 1741:     State:
 1742:     - _object_registry: OR
 1743:     - _original_usr1_handler: SignalHandler union {empty}
 1744:     - $SIG{USR1}: SignalHandler
 1745: 
 1746:     Pre-condition:
 1747:     forall class in C, obj in O:
 1748:         class != empty
 1749:         obj != empty
 1750:         blessed(obj) != empty
 1751: 
 1752:     Post-condition:
 1753:     forall class in C, obj in O:
 1754:         exists ref in _object_registry(class):
 1755:             weak(ref) = obj
 1756:         (_original_usr1_handler = empty@pre =>
 1757:             (_original_usr1_handler@post = $SIG{USR1}@pre
 1758:              $SIG{USR1}@post = reload_config_handler))
 1759: 
 1760: =head2 restore_signal_handlers
 1761: 
 1762:     restore_signal_handlers: () -> ()
 1763: 
 1764:     State:
 1765:     - _original_usr1_handler: SignalHandler union {empty}
 1766:     - $SIG{USR1}: SignalHandler
 1767: 
 1768:     Pre-condition:
 1769:     true
 1770: 
 1771:     Post-condition:
 1772:     $SIG{USR1}@post = _original_usr1_handler@pre
 1773:     _original_usr1_handler@post = empty
 1774: 
 1775: =head2 get_sigal_handler_info
 1776: 
 1777:     get_signal_handler_info: () -> InfoHash
 1778: 
 1779:     Given:
 1780:     - IH: set of all info hashes
 1781: 
 1782:     State:
 1783:     - _original_usr1_handler: SignalHandler union {empty}
 1784:     - $SIG{USR1}: SignalHandler union {empty}
 1785:     - _config_watchers: {pid: PID, callback: CB}
 1786: 
 1787:     Pre-condition:
 1788:     true
 1789: 
 1790:     Post-condition:
 1791:     forall result in IH:
 1792:         result.original_usr1 = _original_usr1_handler
 1793:         result.current_usr1 = $SIG{USR1}
 1794:         result.hot_reload_active = (_original_usr1_handler != empty)
 1795:         result.watcher_pid = _config_watchers.pid
 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;