File Coverage

File:blib/lib/Object/Configure.pm
Coverage:88.1%

linestmtbrancondsubtimecode
1package Object::Configure;
2
3
21
21
21
1713440
20
277
use strict;
4
21
21
21
31
14
396
use warnings;
5
6
21
21
21
30
18
541
use Carp;
7
21
21
21
4214
822800
334
use Config::Abstraction 0.38;
8
21
21
21
85
22
268
use File::Spec;
9
21
21
21
5680
268201
368
use Log::Abstraction 0.26;
10
21
21
21
61
11
82
use mro;
11
21
21
21
241
108
307
use Params::Get 0.13;
12
21
21
21
33
18
307
use Readonly;
13
21
21
21
29
14
253
use Return::Set;
14
21
21
21
29
13
361
use Scalar::Util qw(blessed weaken);
15
21
21
21
55
14
83
use Time::HiRes qw(time);
16
21
21
21
5033
52416
558
use File::stat;
17
21
21
21
46
18
57
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.
21Readonly my $OS_WINDOWS   => 'MSWin32';
22Readonly my $LOGGER_NULL  => 'NULL';
23Readonly my $SIG_DEFAULT  => 'DEFAULT';
24Readonly my $SIG_IGNORE   => 'IGNORE';
25Readonly my $POLL_SLEEP   => 0.1;   # seconds between waitpid polls in disable_hot_reload
26Readonly 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.
31our %_object_registry   = ();
32our %_config_watchers   = ();
33our %_config_file_stats = ();
34
35# Saved before we install our SIGUSR1 handler so we can chain and restore it.
36our $_original_usr1_handler;
37
38 - 46
=head1 NAME

Object::Configure - Runtime Configuration for an Object

=head1 VERSION

0.23

=cut
47
48our $VERSION = 0.23;
49
50 - 422
=head1 SYNOPSIS

The C<Object::Configure> module is a lightweight utility designed to inject runtime parameters into other classes,
primarily by layering configuration and logging support,
when instatiating objects.

L<Log::Abstraction> and L<Config::Abstraction> are modules developed to solve a specific need,
runtime configurability without needing to rewrite or hardcode behaviours.
The goal is to allow individual modules to enable or disable features on the fly,
and to do it using whatever configuration system the user prefers.

Although the initial aim was general configurability,
the primary use case that's emerged has been fine-grained logging control,
more flexible and easier to manage than what you'd typically do with L<Log::Log4perl>.
For example,
you might want one module to log verbosely while another stays quiet,
and be able to toggle that dynamically - without making invasive changes to each module.

To tie it all together,
there is C<Object::Configure>.
It sits on L<Log::Abstraction> and L<Config::Abstraction>,
and with just a couple of extra lines in a class constructor,
you can hook in this behaviour seamlessly.
The intent is to keep things modular and reusable,
especially across larger systems or in situations where you want user-selectable behaviour.

Add this to your constructor:

   package My::Module;

   use Object::Configure;
   use Params::Get;

   sub new {
        my $class = shift;
        my $params = Object::Configure::configure($class, @_ ? \@_ : undef);    # Reads in the runtime configuration settings
        # or my $params = Object::Configure::configure($class, { @_ });

        return bless $params, $class;
    }

Throughout your class, add code such as:

    sub method
    {
        my $self = shift;

        $self->{'logger'}->trace(ref($self), ': ', __LINE__, ' entering method');
    }

=head3 CONFIGURATION INHERITANCE

C<Object::Configure> supports configuration inheritance, allowing child classes to inherit and override configuration settings from their parent classes.
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.

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:

=over 4

=item 1. Load C<my-base-class.yml> (or .conf, .json, etc.) if it exists

=item 2. Load C<my-parent-class.yml> if it exists, overriding base settings

=item 3. Load C<my-child-class.yml>, overriding both parent and base settings

=back

The configuration files should be named using lowercase versions of the class name with C<::> replaced by hyphens (C<->).
For example, C<My::Parent::Class> would use C<my-parent-class.yml>.

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.

Example:

    # File: ~/.conf/my-base-class.yml
    ---
    My__Base__Class:
      timeout: 30
      retries: 3
      log_level: info

    # File: ~/.conf/my-child-class.yml
    ---
    My__Child__Class:
      timeout: 60
      # Inherits retries: 3 and log_level: info from parent

    # Result: Child class gets timeout=60, retries=3, log_level=info

Parent configuration files are optional.
If a parent class's configuration file doesn't exist, the module simply skips it and continues up the inheritance chain.
All discovered configuration files are tracked in the C<_config_files> array for hot reload support.

=head3 UNIVERSAL CONFIGURATION

All Perl classes implicitly inherit from C<UNIVERSAL>.
C<Object::Configure> takes advantage of this to provide a mechanism for universal configuration settings
that apply to all classes by default.

If you create a configuration file named C<universal.yml> (or C<universal.conf>, C<universal.json>, etc.)
in your configuration directory,
the settings in its C<UNIVERSAL> section will be inherited by all classes that use C<Object::Configure>,
unless explicitly overridden by class-specific configuration files.

This is particularly useful for setting application-wide defaults such as logging levels,
timeout values,
or other common parameters that should apply across all modules.

Example C<~/.conf/universal.yml>:

    ---
    UNIVERSAL:
      timeout: 30
      retries: 3
      logger:
        level: info

With this universal configuration file in place,
all classes will inherit these default values.
Individual classes can override any of these settings in their own configuration files:

Example C<~/.conf/my-special-class.yml>:

    ---
    My__Special__Class:
      timeout: 120
      # Inherits retries: 3 and logger.level: info from UNIVERSAL

The universal configuration is loaded first in the inheritance chain,
followed by parent class configurations,
and finally the specific class configuration,
with later configurations overriding earlier ones.

=head2 CHANGING BEHAVIOUR AT RUN TIME

=head3 USING A CONFIGURATION FILE

To control behavior at runtime, C<Object::Configure> supports loading settings from a configuration file via L<Config::Abstraction>.

A minimal example of a config file (C<~/.conf/local.conf>) might look like:

   [My__Module]
   logger.file = /var/log/mymodule.log

The C<configure()> function will read this file,
overlay it onto your default parameters,
and initialize the logger accordingly.

If the file is not readable and no config_dirs are provided,
the module will throw an error.
To be clear, in this case, inheritance is not followed.

This mechanism allows dynamic tuning of logging behavior (or other parameters you expose) without modifying code.

More details to be written.

=head3 USING ENVIRONMENT VARIABLES

C<Object::Configure> also supports runtime configuration via environment variables,
without requiring a configuration file.

Environment variables are read automatically when you use the C<configure()> function,
thanks to its integration with L<Config::Abstraction>.
These variables should be prefixed with your class name, followed by a double colon.

For example, to enable syslog logging for your C<My::Module> class,
you could set:

    export My__Module__logger__file=/var/log/mymodule.log

This would be equivalent to passing the following in your constructor:

     My::Module->new(logger => Log::Abstraction->new({ file => '/var/log/mymodule.log' });

All environment variables are read and merged into the default parameters under the section named after your class.
This allows centralized and temporary control of settings (e.g., for production diagnostics or ad hoc testing) without modifying code or files.

Note that environment variable settings take effect regardless of whether a configuration file is used,
and are applied during the call to C<configure()>.

More details to be written.

=head2 HOT RELOAD

Hot reload is not supported on Windows.

=head3 Basic Hot Reload Setup

    package My::App;
    use Object::Configure;

    sub new {
        my $class = shift;
        my $params = Object::Configure::configure($class, @_ ? \@_ : undef);
        my $self = bless $params, $class;

        # Register for hot reload
        Object::Configure::register_object($class, $self) if $params->{_config_file};

        return $self;
    }

    # Optional: Define a reload hook
    sub _on_config_reload {
        my ($self, $new_config) = @_;
        print "My::App config was reloaded!\n";
        # Custom reload logic here
    }

=head3 Enable Hot Reload in Your Main Application

    # Enable hot reload with custom callback
    Object::Configure::enable_hot_reload(
        interval => 5,  # Check every 5 seconds
        callback => sub {
            print "Configuration files have been reloaded!\n";
        }
    );

    # Your application continues running...
    # Config changes will be automatically detected and applied

=head3 Manual Reload

    # Manually trigger a reload
    my $count = Object::Configure::reload_config();
    print "Reloaded configuration for $count objects\n";

=encoding utf8

=head1 SUBROUTINES/METHODS

=head2 configure

Configure your class at runtime with hot reload support.

Takes arguments:

=over 4

=item * C<class>

=item * C<params>

A hashref containing default parameters to be used in the constructor.

=item * C<carp_on_warn>

If set to 1, call C<Carp::carp> on C<warn()>.
This value is also read from the configuration file,
which will take precedence.
The default is 0.

=item * C<croak_on_error>

If set to 1, call C<Carp::croak> on C<error()>.
This value is also read from the configuration file,
which will take precedence.
The default is 1.

=item * C<logger>

The logger to use.
If none is given, an instatiation of L<Log::Abstraction> will be created, unless the logger is set to NULL.

=item * C<schema>

A L<Params::Validate::Strict> compatible schema to validate the configuration file against.

=back

Returns a hash ref containing the new values for the constructor.

Now you can set up a configuration file and environment variables to configure your object.

=head3 API Specification

=head4 Input

    schema => {
        class => {
            type => 'string',
            required => 1,
            description => 'Fully-qualified class name'
        },
        params => {
            type => 'hashref',
            optional => 1,
            default => {},
            schema => {
                config_file => {
                    type => 'string',
                    optional => 1,
                    description => 'Configuration file basename'
                }, config_dirs => {
                    type => 'arrayref',
                    optional => 1,
                    description => 'Directories to search for config files'
                }, logger => {
                    type => [qw(hashref coderef object string arrayref)],
                    optional => 1,
                    description => 'Logger configuration or instance'
                }, carp_on_warn => {
                    type => 'boolean',
                    optional => 1,
                    default => 0,
                    description => 'Use Carp::carp for warnings'
                }, croak_on_error => {
                    type => 'boolean',
                    optional => 1,
                    default => 1,
                    description => 'Use Carp::croak for errors'
                }
            }
        }
    }

=head4 Output

    type => 'hashref',
    description => 'Merged configuration parameters',
    schema => {
        logger => {
            type => 'object',
            isa => 'Log::Abstraction',
            description => 'Initialized logger instance'
        },
        _config_file => {
            type => 'string',
            optional => 1,
            description => 'Primary configuration file path'
        },
        _config_files => {
            type => 'arrayref',
            optional => 1,
            description => 'All loaded configuration file paths'
        }
    }

=head3 MESSAGES

=over 4

=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.

=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.

=item * C<Warning: Can't load configuration from FILE: DETAIL> -- Config::Abstraction rejected the file. Check YAML/JSON/conf syntax.

=back

=head3 PSEUDOCODE

    configure(class, params):
        croak if class is empty
        stash coderefs/objects from params (Config::Abstraction cannot hold them)
        if params.logger is arrayref: move to $array_logger
        build inheritance chain via mro::get_linear_isa (base -> child, UNIVERSAL first)
        if config_file given:
            croak if not readable and no config_dirs
            for each ancestor class (child -> base order): find & collect matching config file
            add primary config file last (highest priority)
            sort collected files base -> child
            deep-merge each file's section into params
        else if environment variables exist:
            merge env vars for each ancestor then for the class itself
        determine carp_on_warn / croak_on_error
        build logger via _build_logger(spec, carp_on_warn)
        store _config_file and _config_files for hot reload
        restore stashed coderefs/objects
        return params

=cut
423
424sub configure {
425
204
3051272
        my $class  = $_[0];
426
204
313
        my $params = $_[1] || {};       # caller's defaults; config file values override them
427
204
143
        my $array_logger;               # stash for an arrayref logger spec (Config::Abstraction rejects refs)
428
429
204
558
        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
198
130
        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
198
152
        my %stashed_values;
440
198
260
        foreach my $key (keys %$params) {
441
299
292
                next if $key eq 'logger';       # logger has its own path through _build_logger
442
264
212
                my $value = $params->{$key};
443
264
565
                if(ref($value) eq 'CODE' || blessed($value)) {
444
36
45
                        $stashed_values{$key} = delete $params->{$key};
445                }
446        }
447
448
198
341
        if(exists($params->{'logger'}) && ref($params->{'logger'}) eq 'ARRAY') {
449
5
5
                $array_logger = delete $params->{'logger'};
450        }
451
452
198
157
        my $original_class = $class;
453
198
417
        $class =~ s/::/__/g;
454
455
198
169
        my $config_file = $params->{'config_file'};
456
198
156
        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
198
233
        my @inheritance_chain = _get_inheritance_chain($original_class);
462
463
198
153
        my @config_files_to_load = ();
464
198
174
        my %tracked_files        = ();
465
466
198
193
        if($config_file) {
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
96
300
                if(!$config_dirs && !-r $config_file) {
470
8
148
                        croak("$class: ", $config_file, ": $!");
471                }
472
473
88
89
                foreach my $ancestor_class (reverse @inheritance_chain) {
474
191
2794
                        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
191
246
                        next if $ancestor_config_file && $ancestor_config_file eq $config_file;
482
483
183
361
                        if($ancestor_config_file && -r $ancestor_config_file && !$tracked_files{$ancestor_config_file}) {
484
39
80
                                push @config_files_to_load, { file => $ancestor_config_file, class => $ancestor_class };
485
39
43
                                $tracked_files{$ancestor_config_file} = 1;
486
39
151
                                $_config_file_stats{$ancestor_config_file} = stat($ancestor_config_file)
487                                        if -f $ancestor_config_file;
488                        }
489                }
490
491
88
896
                if($config_file && !$tracked_files{$config_file} && -r $config_file) {
492
27
54
                        push @config_files_to_load, { file => $config_file, class => $original_class };
493
27
28
                        $tracked_files{$config_file} = 1;
494
27
119
                        $_config_file_stats{$config_file} = stat($config_file)
495                                if -f $config_file;
496                }
497
498
88
2106
                if(!scalar(@config_files_to_load)) {
499
41
41
28
28
                        foreach my $dir (@{$config_dirs}) {
500
41
142
                                my $candidate = File::Spec->catfile($dir, $config_file);
501
41
171
                                if(-r $candidate) {
502
38
63
                                        push @config_files_to_load, { file => $candidate, class => $original_class };
503
38
36
                                        last;   # stop at first readable hit; later dirs are lower priority
504                                }
505                        }
506                }
507        }
508
509
190
392
        if(@config_files_to_load) {
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
85
58
                my %class_order;
513
85
132
                for my $i (0 .. $#inheritance_chain) {
514
185
191
                        $class_order{ $inheritance_chain[$i] } = $i;
515                }
516                @config_files_to_load = sort {
517
85
24
137
47
                        ($class_order{ $a->{class} } // 999) <=> ($class_order{ $b->{class} } // 999)
518                } @config_files_to_load;
519
520
85
134
                my $merged_params = { %$params };
521
522
85
91
                foreach my $config_info (@config_files_to_load) {
523
104
225
                        my $cfg_file    = $config_info->{file};
524
104
78
                        my $cfg_class   = $config_info->{class};
525
104
74
                        my $section_name = $cfg_class;
526
104
147
                        $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
104
376
                        my $config = Config::Abstraction->new(
531                                config_file => $cfg_file,
532                                env_prefix  => "${section_name}__"
533                        );
534
535
104
123759
                        if($config) {
536
104
207
                                my $this_config = $config->merge_defaults(
537                                        defaults => {},
538                                        section  => $section_name,
539                                        merge    => 1,
540                                        deep     => 1
541                                );
542
104
7269
                                $merged_params = _deep_merge($merged_params, $this_config);
543                        } elsif($@) {
544
0
0
                                carp("Warning: Can't load configuration from $cfg_file: $@");
545                        }
546                }
547
548
85
727
                $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
4
3362
                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
4
5
                foreach my $ancestor_class (@inheritance_chain) {
556
8
7
                        my $section_name = $ancestor_class;
557
8
12
                        $section_name =~ s/::/__/g;
558
559
8
18
                        my $ancestor_env_config = Config::Abstraction->new(env_prefix => "${section_name}__");
560
8
3439
                        if($ancestor_env_config) {
561
4
10
                                my $ancestor_config = $ancestor_env_config->merge_defaults(
562                                        defaults => {},
563                                        section  => $section_name,
564                                        merge    => 1,
565                                        deep     => 1
566                                );
567
4
307
                                $merged_config = _deep_merge($merged_config, $ancestor_config);
568                        }
569                }
570
571
4
45
                $params = $config->merge_defaults(
572                        defaults => $params,
573                        section  => $class,
574                        merge    => 1,
575                        deep     => 1
576                );
577
578
4
188
                $params = _deep_merge($merged_config, $params);
579
580
4
11
                if($params->{config_path} && -f $params->{config_path}) {
581
0
0
                        $_config_file_stats{ $params->{config_path} } = stat($params->{config_path});
582                }
583        }
584
585
190
64147
        my $croak_on_error = exists($params->{'croak_on_error'}) ? $params->{'croak_on_error'} : 1;
586
190
198
        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
190
227
        my $logger_spec = defined($array_logger) ? $array_logger : $params->{'logger'};
593
190
214
        $params->{'logger'} = _build_logger($logger_spec, $carp_on_warn);
594
595
190
512426
        if(!exists($params->{_config_file})) {
596
187
249
                $params->{_config_file} = $config_file if defined $config_file;
597        }
598
190
221
        if(!exists($params->{_config_files})) {
599
187
104
241
185
                $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
190
22
233
24
        @{$params}{ keys %stashed_values } = values %stashed_values if %stashed_values;
605
606
190
399
        return Return::Set::set_return($params, { 'type' => 'hashref' });
607}
608
609 - 687
=head2 instantiate($class,...)

Create and configure an object of a third-party class without modifying the class itself.

=head3 Purpose

Provides a convenient way to make third-party classes (those you cannot modify) configurable
at runtime using Object::Configure. This is a wrapper that calls C<configure> and then
instantiates the class.

=head3 Arguments

Takes a hash or hashref with the following keys:

=over 4

=item * C<class> (Required)

The fully-qualified class name to instantiate (e.g., C<'LWP::UserAgent'>).

=item * Additional keys

Any additional keys are passed through to C<configure> and then to the class constructor.

=back

=head3 Returns

A blessed object of the specified class, configured according to the parameters and
configuration files.

=head3 Side Effects

=over 4

=item * Calls C<configure> (see its side effects)

=item * Calls the C<new> method on the specified class

=item * Registers the object for hot reload if a configuration file was used

=back

=head3 Notes

The specified class must have a C<new> method that accepts a hashref of parameters.
This is a "quick and dirty" way to add configuration support to classes you don't control.

=head3 Usage Example

    use Object::Configure;

    # Configure LWP::UserAgent from a config file
    my $ua = Object::Configure::instantiate(
        class => 'LWP::UserAgent',
        config_file => 'lwp.yml',
        config_dirs => ['/etc/myapp'],
        timeout => 30
    );

=head3 API Specification

=head4 Input

    schema => {
        class => {
            type => 'string',
            required => 1,
            description => 'Class name to instantiate',
            can => 'new'
        }
    }

=head4 Output

    type => 'object',
    description => 'Instance of the specified class'

=cut
688
689sub instantiate
690{
691
12
97241
        my $params = Params::Get::get_params('class', @_);
692
693
12
164
        my $class = $params->{'class'};
694
12
20
        $params = configure($class, $params);
695
696
12
909
        my $obj = $class->new($params);
697
698
11
51
        register_object($class, $obj) if $params->{_config_file};
699
700
11
18
        return $obj;
701}
702
703 - 802
=head1 HOT RELOAD FEATURES

=head2 enable_hot_reload

Enable automatic hot reloading of configuration files when they are modified.

=head3 Purpose

Starts a background process that monitors configuration files for changes and automatically
reloads them into registered objects. This allows runtime configuration updates without
restarting the application.

=head3 Arguments

Takes a hash with the following optional keys:

=over 4

=item * C<interval> (Optional, default: 10)

Number of seconds between configuration file checks. Lower values provide faster
response to changes but consume more CPU.

=item * C<callback> (Optional)

A coderef to execute after configuration files are reloaded. Useful for logging
or triggering application-specific reload behavior.

=back

=head3 Returns

The process ID (PID) of the background watcher process on success.
Returns immediately if hot reload is already enabled.

=head3 Side Effects

=over 4

=item * Forks a background process to monitor configuration files

=item * The background process sends SIGUSR1 to the parent when changes are detected

=item * Stores the watcher PID in C<%_config_watchers>

=item * May throw an exception (via C<croak>) if the fork fails

=back

=head3 Notes

Hot reload is not supported on Windows due to lack of SIGUSR1 signal support.
The background process runs indefinitely until C<disable_hot_reload> is called.
Objects must be registered via C<register_object> to receive configuration updates.

=head3 Usage Example

    use Object::Configure;

    # Enable hot reload with 5-second check interval
    Object::Configure::enable_hot_reload(
        interval => 5,
        callback => sub {
            my $timestamp = localtime;
            print "[$timestamp] Configuration reloaded\n";
        }
    );

    # Application continues running...
    while (1) {
        # Do work...
        sleep(1);
    }

=head3 API Specification

=head4 Input

    schema => {
        interval => {
            type => 'integer',
            optional => 1,
            default => 10,
            min => 1,
            description => 'Check interval in seconds'
        },
        callback => {
            type => 'coderef',
            optional => 1,
            description => 'Code to execute after reload'
        }
    }

=head4 Output

    type => 'integer',
    description => 'PID of background watcher process',
    condition => 'value > 0'

=cut
803
804sub enable_hot_reload {
805
9
11936
        my %params = @_;
806
807
9
21
        my $interval = $params{interval} || 10;
808
9
11
        my $callback = $params{callback};
809
810
9
16
        return if %_config_watchers;    # already watching; avoid double-fork
811
812
7
6578
        if(my $pid = fork()) {
813
4
148
                $_config_watchers{pid}      = $pid;
814
4
100
                $_config_watchers{callback} = $callback;
815
4
269
                return $pid;
816        } elsif(defined $pid) {
817                # Child: run forever, signal parent on change
818
3
157
                _run_config_watcher($interval, $callback);
819
0
0
                exit 0;
820        } else {
821
0
0
                croak("Failed to fork config watcher: $!");
822        }
823}
824
825 - 881
=head2 disable_hot_reload

Disable hot reloading and terminate the background watcher process.

=head3 Purpose

Cleanly shuts down the hot reload system by terminating the background watcher
process and clearing internal state.

=head3 Arguments

None.

=head3 Returns

Nothing.

=head3 Side Effects

=over 4

=item * Sends SIGTERM to the background watcher process

=item * Waits for the watcher process to terminate

=item * Clears C<%_config_watchers> state

=back

=head3 Notes

Safe to call even if hot reload is not currently enabled.
The function blocks until the watcher process has fully terminated.

=head3 Usage Example

    use Object::Configure;

    # Enable hot reload
    Object::Configure::enable_hot_reload(interval => 5);

    # ... application runs ...

    # Clean shutdown
    Object::Configure::disable_hot_reload();

=head3 API Specification

=head4 Input

    schema => {}

=head4 Output

    type => 'void'

=cut
882
883sub disable_hot_reload {
884        ## MUTANT_SKIP_BEGIN
885
34
18310
        if(my $pid = $_config_watchers{pid}) {
886
4
143
                if($pid =~ /\A[0-9]+\z/ && $pid > 0) {
887
4
35
                        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
4
103
                        my $deadline = time() + $KILL_TIMEOUT;
892
4
44
                        my $kid;
893
4
8
                        do {
894
15
1102144
                                $kid = waitpid($pid, WNOHANG);
895
15
137
                                if($kid == 0 && time() < $deadline) {
896
11
85
                                        select undef, undef, undef, $POLL_SLEEP;
897                                }
898                        } while($kid == 0 && time() < $deadline);
899
900
4
19
                        if($kid == 0) {
901
0
0
                                kill('KILL', $pid);
902
0
0
                                waitpid($pid, 0);
903                        }
904                }
905
4
34
                %_config_watchers = ();
906        }
907        ## MUTANT_SKIP_END
908}
909
910 - 975
=head2 reload_config

Manually trigger configuration reload for all registered objects.

=head3 Purpose

Forces an immediate reload of configuration from files for all objects that have been
registered for hot reload. This is useful for testing or forcing a reload without
waiting for the automatic file monitoring to detect changes.

=head3 Arguments

None.

=head3 Returns

An integer count of how many objects had their configuration successfully reloaded.

=head3 Side Effects

=over 4

=item * Reads configuration files from disk

=item * Updates object properties with new configuration values

=item * Calls C<_on_config_reload> hook on objects that implement it

=item * Cleans up dead weak references from C<%_object_registry>

=item * May emit warnings if configuration reload fails for any object

=back

=head3 Notes

Only objects registered via C<register_object> are reloaded.
Objects are updated in-place; their identity does not change.
Private properties (those starting with C<_>) are not updated during reload.

=head3 Usage Example

    use Object::Configure;

    # Create and register objects
    my $obj = My::Module->new(config_file => 'app.yml');

    # Manually edit app.yml...

    # Force immediate reload
    my $count = Object::Configure::reload_config();
    print "Reloaded configuration for $count objects\n";

=head3 API Specification

=head4 Input

    schema => {}

=head4 Output

    type => 'integer',
    description => 'Number of objects successfully reloaded',
    condition => 'value >= 0'

=cut
976
977sub reload_config {
978
37
589229
        my $reloaded_count = 0;
979
980
37
83
        foreach my $class_key (keys %_object_registry) {
981
35
40
                my $objects = $_object_registry{$class_key};
982
983
35
97
53
114
                @$objects = grep { defined $_ } @$objects;      # prune garbage-collected weak refs
984
985
35
41
                foreach my $obj_ref (@$objects) {
986
97
109
                        if(my $obj = $$obj_ref) {
987                                # Protect the caller's $@ from being clobbered by our internal eval blocks.
988
33
28
                                local $@;
989
33
32
                                eval {
990
33
53
                                        _reload_object_config($obj);
991
33
194
                                        $reloaded_count++;
992                                };
993
33
52
                                if($@) {
994
0
0
                                        carp("Failed to reload config for object: $@");
995                                }
996                        }
997                }
998
999
35
43
                delete $_object_registry{$class_key} unless @$objects;
1000        }
1001
1002
37
52
        return $reloaded_count;
1003}
1004
1005 - 1091
=head2 register_object($class, $obj)

Register an object for hot reload monitoring.

=head3 Purpose

Adds an object to the hot reload registry so it will receive automatic configuration
updates when files change. Uses weak references to prevent memory leaks.

=head3 Arguments

=over 4

=item * C<class> (Required)

The class name of the object, used for organizing the registry.

=item * C<obj> (Required)

The object instance to register. Must be a blessed reference.

=back

=head3 Returns

Nothing.

=head3 Side Effects

=over 4

=item * Adds a weak reference to the object in C<%_object_registry>

=item * Sets up SIGUSR1 signal handler on first call (Unix-like systems only)

=item * Stores the original SIGUSR1 handler for later restoration

=back

=head3 Notes

Objects are stored using weak references, so they will be automatically
garbage collected when no other references exist.
The SIGUSR1 handler chains to any existing handler that was installed.
On Windows, the signal handler is not installed (SIGUSR1 does not exist).

=head3 Usage Example

    package My::Module;
    use Object::Configure;

    sub new {
        my $class = shift;
        my $params = Object::Configure::configure($class, {
            config_file => 'mymodule.yml',
        });
        my $self = bless $params, $class;

        # Register for hot reload
        Object::Configure::register_object($class, $self)
            if $params->{_config_file};

        return $self;
    }

=head3 API Specification

=head4 Input

    schema => {
        class => {
            type => 'string',
            required => 1,
            description => 'Class name for registry organization'
        },
        obj => {
            type => 'object',
            required => 1,
            description => 'Blessed object instance to register'
        }
    }

=head4 Output

    type => 'void'

=cut
1092
1093sub register_object
1094{
1095
68
207131
        my ($class, $obj) = @_;
1096
1097
68
208
        croak(__PACKAGE__, '::register_object: Usage ($class, $obj)')
1098                unless defined($class) && defined($obj);
1099
1100
58
52
        my $obj_ref = \$obj;
1101
58
89
        weaken($$obj_ref);
1102
58
58
40
70
        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
58
82
        if(!defined $_original_usr1_handler) {
1109
32
94
                $_original_usr1_handler = $SIG{USR1} || $SIG_DEFAULT;
1110
1111
32
140
                return if $^O eq $OS_WINDOWS;
1112
1113                $SIG{USR1} = sub {
1114
9
1016148
                        reload_config();
1115
9
16
                        $_config_watchers{callback}->() if $_config_watchers{callback};
1116
1117
9
21
                        if(ref($_original_usr1_handler) eq 'CODE') {
1118
6
9
                                $_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
0
0
                                carp("Object::Configure: Cannot chain to non-code USR1 handler: $_original_usr1_handler");
1124                        }
1125
32
250
                };
1126        }
1127
1128
58
64
        return;
1129}
1130
1131 - 1184
=head2 restore_signal_handlers

Restore original signal handlers and disable hot reload integration.

=head3 Purpose

Restores the signal handler that was in place before Object::Configure installed
its SIGUSR1 handler. This is useful for clean shutdown or when transferring
control to another hot reload system.

=head3 Arguments

None.

=head3 Returns

Nothing.

=head3 Side Effects

=over 4

=item * Restores C<$SIG{USR1}> to its original value

=item * Clears C<$_original_usr1_handler> internal state

=back

=head3 Notes

Safe to call even if Object::Configure never installed a signal handler.
On Windows, this function has no effect (SIGUSR1 does not exist).

=head3 Usage Example

    use Object::Configure;

    # Objects are registered...

    # Clean shutdown
    Object::Configure::disable_hot_reload();
    Object::Configure::restore_signal_handlers();

=head3 API Specification

=head4 Input

    schema => {}

=head4 Output

    type => 'void'

=cut
1185
1186sub restore_signal_handlers
1187{
1188
42
366520
        if(defined $_original_usr1_handler) {
1189
17
58
                $SIG{USR1} = $_original_usr1_handler unless $^O eq $OS_WINDOWS;
1190
17
134
                $_original_usr1_handler = undef;
1191        }
1192
1193
42
349
        return;
1194}
1195
1196 - 1282
=head2 get_signal_handler_info

Get information about the current signal handler setup for debugging.

=head3 Purpose

Returns diagnostic information about the signal handler state, useful for
debugging signal handler chains or verifying hot reload configuration.

=head3 Arguments

None.

=head3 Returns

A hashref containing the following keys:

=over 4

=item * C<original_usr1>

The signal handler that was installed before Object::Configure's handler,
or undef if no handler was present.

=item * C<current_usr1>

The currently installed SIGUSR1 handler.

=item * C<hot_reload_active>

Boolean indicating whether Object::Configure's hot reload handler is active.

=item * C<watcher_pid>

The PID of the background watcher process, or undef if not running.

=back

=head3 Notes

This is primarily a debugging aid and is not needed for normal operation.

=head3 Usage Example

    use Object::Configure;
    use Data::Dumper;

    Object::Configure::enable_hot_reload();

    my $info = Object::Configure::get_signal_handler_info();
    print Dumper($info);
    # $VAR1 = {
    #     'original_usr1' => 'DEFAULT',
    #     'current_usr1' => CODE(0x...),
    #     'hot_reload_active' => 1,
    #     'watcher_pid' => 12345
    # };

=head3 API Specification

=head4 Input

    schema => {}

=head4 Output

    type => 'hashref',
    schema => {
        original_usr1 => {
            type => [qw(coderef string undef)],
            description => 'Original SIGUSR1 handler'
        },
        current_usr1 => {
            type => [qw(coderef string undef)],
            description => 'Current SIGUSR1 handler'
        },
        hot_reload_active => {
            type => 'boolean',
            description => 'Whether hot reload is active'
        },
        watcher_pid => {
            type => [qw(integer undef)],
            description => 'Background watcher process PID'
        }
    }

=cut
1283
1284sub 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
17
11592
        };
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.
1308sub _build_logger {
1309
197
201
        my ($spec, $carp_on_warn) = @_;
1310
197
230
        $carp_on_warn //= 0;
1311
1312
197
450
        return Log::Abstraction->new(carp_on_warn => $carp_on_warn)
1313                unless defined $spec;
1314
1315
52
106
        return $LOGGER_NULL
1316                if !ref($spec) && $spec eq $LOGGER_NULL;
1317
1318
43
103
        return $spec
1319                if blessed($spec) && $spec->isa('Log::Abstraction');
1320
1321
40
78
        if(ref($spec) eq 'ARRAY') {
1322
5
11
                return Log::Abstraction->new(array => $spec, carp_on_warn => $carp_on_warn);
1323        }
1324
1325
35
48
        if(ref($spec) eq 'HASH') {
1326
28
90
                return Log::Abstraction->new({ carp_on_warn => $carp_on_warn, %$spec });
1327        }
1328
1329        # Scalar: a logger name, file path, or other string identifier passed to L::A
1330
7
21
        return Log::Abstraction->new({ carp_on_warn => $carp_on_warn, logger => $spec });
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).
1340sub _get_inheritance_chain {
1341
213
99811
        my ($class) = @_;
1342
1343
213
213
142
599
        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
213
254
241
375
        push @mro, 'UNIVERSAL' unless grep { $_ eq 'UNIVERSAL' } @mro;
1349
1350
213
300
        return reverse @mro;
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.
1359sub _find_class_config_file {
1360
207
25071
        my ($class, $base_config_file, $config_dirs) = @_;
1361
1362
207
178
        my $class_file = lc($class);
1363
207
223
        $class_file =~ s/::/-/g;
1364
1365
207
1250
        my ($base_vol, $base_dir_part, $base_name_ext) = File::Spec->splitpath($base_config_file);
1366
207
628
        my (undef, $base_ext) = $base_name_ext =~ /^(.*?)(\.[^.]+)?$/;
1367
207
232
        $base_ext //= '';
1368
207
474
        my $base_dir = File::Spec->catpath($base_vol, $base_dir_part, '');
1369
1370
207
1882
        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
207
383
        foreach my $pattern (@base_patterns) {
1379
939
2956
                return $pattern if -r $pattern && -f $pattern;
1380        }
1381
1382
183
358
        if($config_dirs && ref($config_dirs) eq 'ARRAY') {
1383
145
113
                foreach my $dir (@$config_dirs) {
1384
144
110
                        $dir =~ s{/$}{};
1385
144
218
                        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
581
2047
                                return $pattern if -r $pattern && -f $pattern;
1393                        }
1394                }
1395        }
1396
1397
148
186
        return undef;
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.
1406sub _run_config_watcher {
1407
3
41
        my ($interval, $callback) = @_;
1408
1409
3
3
320
208
        local $SIG{TERM} = sub { exit 0 };
1410
3
0
123
0
        local $SIG{INT}  = sub { exit 0 };
1411
1412
3
20
        while(1) {
1413
5
2005349
                sleep($interval);
1414
1415
5
85
                my $changes_detected = 0;
1416
1417
2
26
                foreach my $config_file (keys %_config_file_stats) {
1418
2
59
                        if(-f $config_file) {
1419
2
61
                                my $current_stat = stat($config_file);
1420
2
414
                                my $stored_stat  = $_config_file_stats{$config_file};
1421
1422
2
45
                                if(!$stored_stat || $current_stat->mtime > $stored_stat->mtime) {
1423
1
34
                                        $_config_file_stats{$config_file} = $current_stat;
1424
1
8
                                        $changes_detected = 1;
1425                                }
1426                        } else {
1427
0
0
                                delete $_config_file_stats{$config_file};
1428
0
0
                                $changes_detected = 1;
1429                        }
1430                }
1431
1432
2
40
                if($changes_detected && $^O ne $OS_WINDOWS) {
1433
1
26
                        if(my $parent_pid = getppid()) {
1434
1
18
                                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.
1446sub _reload_object_config {
1447
33
36
        my $obj = $_[0];
1448
1449
33
78
        return unless blessed($obj);
1450
1451
33
46
        my $class          = ref($obj);
1452
33
26
        my $original_class = $class;
1453
33
63
        $class =~ s/::/__/g;
1454
1455        # Prefer the most-specific (last) file from the full list; fall back to scalar key
1456
33
26
        my $config_file;
1457
33
27
154
65
        if($obj->{_config_files} && ref($obj->{_config_files}) eq 'ARRAY' && @{ $obj->{_config_files} }) {
1458
27
32
                $config_file = $obj->{_config_files}[-1];
1459        } else {
1460
6
12
                $config_file = $obj->{_config_file} || $obj->{config_file};
1461        }
1462
1463
33
202
        return unless $config_file && -f $config_file;
1464
1465
26
135
        my $config = Config::Abstraction->new(
1466                config_file => $config_file,
1467                env_prefix  => "${class}__"
1468        );
1469
1470
26
19197
        if($config) {
1471
26
73
                my $new_params = $config->merge_defaults(
1472                        defaults => {},
1473                        section  => $class,
1474                        merge    => 1,
1475                        deep     => 1
1476                );
1477
1478
26
1312
                foreach my $key (keys %$new_params) {
1479
31
38
                        next if $key =~ /^_/;
1480
1481
31
43
                        if($key eq 'logger') {
1482                                # Only the exact 'logger' key triggers logger reconstruction.
1483                                # Keys like 'logger.file' are flat config values, not logger specs.
1484
1
1
                                my $val = $new_params->{$key};
1485
1
6
                                if(ref($val) || (defined($val) && $val ne $LOGGER_NULL)) {
1486
0
0
                                        _reconfigure_logger($obj, $key, $val);
1487                                } else {
1488
1
4
                                        $obj->{$key} = $val;
1489                                }
1490                        } else {
1491
30
37
                                $obj->{$key} = $new_params->{$key};
1492                        }
1493                }
1494
1495
26
126
                $obj->_on_config_reload($new_params) if $obj->can('_on_config_reload');
1496
1497                $obj->{logger}->info("Configuration reloaded for $original_class")
1498
26
176
                        if $obj->{logger} && $obj->{logger}->can('info');
1499        }
1500
1501
26
512
        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.
1511sub _reconfigure_logger
1512{
1513
7
9472
        my ($obj, $key, $logger_config) = @_;
1514
7
19
        my $carp_on_warn = $obj->{carp_on_warn} || 0;
1515
7
8
        $obj->{$key} = _build_logger($logger_config, $carp_on_warn);
1516
7
3367
        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.
1524sub _deep_merge {
1525
152
47499
        my ($base, $overlay) = @_;
1526
1527
152
209
        return $overlay unless ref($base)    eq 'HASH';
1528
147
168
        return $overlay unless ref($overlay) eq 'HASH';
1529
1530
140
193
        my $result = { %$base };
1531
1532
140
190
        foreach my $key (keys %$overlay) {
1533
1229
971
                if(ref($overlay->{$key}) eq 'HASH' && ref($result->{$key}) eq 'HASH') {
1534
6
15
                        $result->{$key} = _deep_merge($result->{$key}, $overlay->{$key});
1535                } else {
1536
1223
859
                        $result->{$key} = $overlay->{$key};
1537                }
1538        }
1539
1540
140
504
        return $result;
1541}
1542
1543# Clean up the watcher child and restore signal state on interpreter exit.
1544END {
1545
18
102844
        disable_hot_reload();
1546
18
72
        restore_signal_handlers();
1547}
1548
1549 - 1819
=head1 SEE ALSO

=over 4

=item * L<Config::Abstraction>

=item * L<Log::Abstraction>

=item * L<Test Dashboard|https://nigelhorne.github.io/Object-Configure/coverage/>

=back

=head1 LIMITATIONS

=over 4

=item * B<Global singleton state.> C<%_object_registry>, C<%_config_watchers>, and
C<%_config_file_stats> are package globals.  Two independent subsystems in the same
process share one hot-reload registry and one SIGUSR1 handler.  There is no
instance-level isolation.  A proper fix would wrap state in an object and allow
multiple independent C<Object::Configure> instances, but that would break the
existing constructor-call API (C<configure($class, \%params)>).

=item * B<Hot reload is Unix-only.> SIGUSR1 does not exist on Windows.
All signal-related paths are guarded with C<$^O ne 'MSWin32'>, so the module
loads on Windows but silently skips hot-reload registration.

=item * B<configure() is a God function.> At ~120 lines it handles arg validation,
config-file discovery, MRO walking, multi-file merging, env-var merging, logger
creation, and hot-reload bookkeeping.  Future versions should decompose this into
smaller, independently testable units.

=item * B<_deep_merge reimplements CPAN.> L<Hash::Merge::Simple> or L<Hash::Merge>
provide tested, feature-complete deep merge.  The internal C<_deep_merge> is 15
lines and correct for the current use, but does not handle arrayrefs (they are
replaced wholesale, not merged).  If array-merge semantics are ever needed, switch
to a CPAN module.

=item * B<No encapsulation enforcement.> Private helpers (C<_build_logger>,
C<_get_inheritance_chain>, etc.) are accessible to any caller.  L<Sub::Private>
(enforce mode) would make accidental external use a compile-time error.  It is not
added here to avoid a smoker dependency on a less-common module.

=item * B<configure() signature is positional, instantiate() is named.>  The two
public constructors have inconsistent calling conventions.  Normalising them to named
args would require a deprecation cycle.

=item * B<mro::get_linear_isa and UNIVERSAL.>  Perl's C<mro::get_linear_isa> does
not include C<UNIVERSAL> in its output unless C<UNIVERSAL> appears explicitly in
C<@ISA>.  This module appends C<UNIVERSAL> manually so that C<universal.yml> is
always discovered.  If a future Perl version changes this behaviour the guard
(C<grep { $_ eq 'UNIVERSAL' }>) remains correct.

=back

=head1 Formal Specification

=head2 configure

    configure: Class x Params -> ConfigHash

    Given:
    - C: set of all class names
    - P: set of all parameter hashes
    - F: set of all file paths
    - H: set of all configuration hashes

    State:
    - ConfigFiles: F -> H (maps file paths to configuration content)
    - EnvVars: String -> String (environment variables)
    - InheritanceChain: C -> seq C (ordered sequence of ancestor classes)

    Pre-condition:
    forall class in C, params in P:
        class != empty
        (params.config_file != empty =>
            (exists dir in params.config_dirs: readable(dir/params.config_file))
            OR readable(params.config_file))

    Post-condition:
    forall result in H:
        result = params
                 (+) (merge f in InheritanceConfigFiles(class): ConfigFiles(f))
                 (+) (merge v in RelevantEnvVars(class): v)
        result.logger in Log::Abstraction
        (forall k in dom params:
            (params(k) in CodeRef OR blessed(params(k))) => result(k) = params(k))

    where (+) denotes hash merge with right-precedence

=head2 instantiate

    instantiate: Params -> Object

    Given:
    - P: set of all parameter hashes
    - C: set of all class names
    - O: set of all objects

    Pre-condition:
    forall params in P:
        params.class in C
        params.class.can('new')

    Post-condition:
    forall result in O:
        exists config in H:
            config = configure(params.class, params)
            result = params.class.new(config)
            blessed(result) = params.class
            (config._config_file != empty =>
                result in _object_registry(params.class))

=head2 enable_hot_reload

    enable_hot_reload: Interval x Callback -> PID

    Given:
    - I: set of positive integers (intervals in seconds)
    - CB: set of code references
    - PID: set of process identifiers

    State:
    - _config_watchers: {pid: PID, callback: CB}
    - _config_file_stats: F -> Stat

    Pre-condition:
    forall interval in I, callback in CB union {empty}:
        interval >= 1
        _config_watchers = empty
        OS != 'MSWin32'

    Post-condition:
    forall result in PID:
        result > 0
        _config_watchers.pid = result
        _config_watchers.callback = callback
        (forall t in Time:
            (t mod interval = 0) =>
                (exists f in dom _config_file_stats:
                    mtime(f) > _config_file_stats(f).mtime =>
                        send_signal(SIGUSR1, parent_process)))

=head2 disable_hot_reload

    disable_hot_reload: () -> ()

    State:
    - _config_watchers: {pid: PID, callback: CB}

    Pre-condition:
    true

    Post-condition:
    _config_watchers = empty
    (forall p in PID:
        p = _config_watchers.pid@pre =>
            NOT alive(p))

=head2 reload_config

    reload_config: () -> N

    State:
    - _object_registry: C -> seq ObjectRef
    - ConfigFiles: F -> H

    Pre-condition:
    true

    Post-condition:
    forall result in N:
        result = |{obj in flatten(ran _object_registry) |
                   obj != empty
                   obj._config_file in dom ConfigFiles}|
        (forall obj in flatten(ran _object_registry):
            obj != empty AND obj._config_file in dom ConfigFiles =>
                (forall k in dom ConfigFiles(obj._config_file):
                    k NOT in PrivateKeys =>
                        obj(k)@post = ConfigFiles(obj._config_file)(k)))

    where PrivateKeys = {k | k starts with '_'}

=head2 register_object

    register_object: C x O -> ()

    Given:
    - C: set of class names
    - O: set of blessed objects
    - OR: C -> seq WeakRef(O) (object registry)

    State:
    - _object_registry: OR
    - _original_usr1_handler: SignalHandler union {empty}
    - $SIG{USR1}: SignalHandler

    Pre-condition:
    forall class in C, obj in O:
        class != empty
        obj != empty
        blessed(obj) != empty

    Post-condition:
    forall class in C, obj in O:
        exists ref in _object_registry(class):
            weak(ref) = obj
        (_original_usr1_handler = empty@pre =>
            (_original_usr1_handler@post = $SIG{USR1}@pre
             $SIG{USR1}@post = reload_config_handler))

=head2 restore_signal_handlers

    restore_signal_handlers: () -> ()

    State:
    - _original_usr1_handler: SignalHandler union {empty}
    - $SIG{USR1}: SignalHandler

    Pre-condition:
    true

    Post-condition:
    $SIG{USR1}@post = _original_usr1_handler@pre
    _original_usr1_handler@post = empty

=head2 get_sigal_handler_info

    get_signal_handler_info: () -> InfoHash

    Given:
    - IH: set of all info hashes

    State:
    - _original_usr1_handler: SignalHandler union {empty}
    - $SIG{USR1}: SignalHandler union {empty}
    - _config_watchers: {pid: PID, callback: CB}

    Pre-condition:
    true

    Post-condition:
    forall result in IH:
        result.original_usr1 = _original_usr1_handler
        result.current_usr1 = $SIG{USR1}
        result.hot_reload_active = (_original_usr1_handler != empty)
        result.watcher_pid = _config_watchers.pid

=head1 SUPPORT

This module is provided as-is without any warranty.

Please report any bugs or feature requests to C<bug-object-configure at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Object-Configure>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

You can find documentation for this module with the perldoc command.

    perldoc Object::Configure

=head1 LICENCE AND COPYRIGHT

Copyright 2025-2026 Nigel Horne.

Usage is subject to GPL2 licence terms.
If you use it,
please let me know.

=cut
1820
18211;