
=pod

=encoding UTF-8

=head1 NAME

Extender - Dynamically enhance Perl objects with additional methods from other modules or custom subroutines

=head1 SYNOPSIS

    ############################################################################

    use Extender;

    # Example: Extend an object with methods from a module
    my $object = MyClass->new();
    Extend($object, 'Some::Class');
    $object->method_from_some_class();

    # Example: Extend an object with custom methods
    Extends($object,
        greet => sub { my ($self, $name) = @_; print "Hello, $name!\n"; },
        custom_method => sub { return "Custom method executed"; },
    );
    $object->greet('Alice');
    $object->custom_method();

    ############################################################################

=head1 DESCRIPTION

Extender is a Perl module that facilitates the dynamic extension of objects with methods from other modules or custom-defined subroutines. It allows you to enhance Perl objects - whether hash references, array references, or scalar references - with additional functionalities without altering their original definitions.

=head1 EXPORTED FUNCTIONS

=cut

################################################################################

=head2 Extend($object, $module, @methods)

Extends an object with methods from a specified module.

=head3 Arguments:

=over 4

=item * C<$object> - The object reference to which methods will be added.

=item * C<$module> - The name of the module from which methods will be imported.

=item * C<@methods> - Optional list of method names to import. If none are provided, all exported functions from C<$module> will be imported.

=back

=head3 Description:

This function extends the specified C<$object> by importing methods from the module C<$module>. It dynamically loads the module if it's not already loaded, retrieves the list of exported functions, and adds each specified function as a method to the object.

=head3 Example:

    ############################################################################

    use Extender;

    # Create an object and extend $object with methods from 'Hash::Util'
    my $object = Extend({}, 'Hash::Util', 'keys', 'values');

    # Now $object has 'keys' and 'values' methods from 'Hash::Util'

    ############################################################################

=head3 Supported Object Types: Can be applied to HASH, ARRAY, SCALAR, GLOB references, or a complete class object. For example:

    my $hash_ref = Extend({}, 'HashMethods', 'method1', 'method2');
    my $array_ref = Extend([], 'ArrayMethods', 'method1', 'method2');
    my $scalar_ref = Extend(\(my $scalar = 'value'), 'ScalarMethods', 'method1');
    my $glob_ref = Extend(\*GLOB, 'GlobMethods', 'method1');
    my $class_ref = Extend(MyClass->new(), 'ClassMethods', 'method1');

=head2 Extends($object, %extend)

Extends an object with custom methods.

=head3 Arguments:

=over 4

=item * C<$object> - The object reference to which methods will be added.

=item * C<%extend> - A hash where keys are method names and values are references to subroutines (CODE references). Alternatively, values can be references to scalars containing CODE references.

=back

=head3 Description:

This function extends the specified C<$object> by adding custom methods defined in C<%extend>. Each key-value pair in C<%extend> corresponds to a method name and its associated subroutine reference. If the method name already exists in C<$object>, it will override it.

=head3 Example:

    ############################################################################

    use Extender;

    # Create an object and define custom methods to extend $object
    my $object = Extends(
        {},
        custom_method => sub { return "Custom method" },
        dynamic_method => \"sub { return 'Dynamic method' }",
    );

    # Now $object has 'custom_method' and 'dynamic_method'

    ############################################################################

=head3 Supported Object Types: Can be used with HASH, ARRAY, SCALAR, GLOB references, or class objects. For example:

     Extends($hash_object, hash_method => sub { ... });
     Extends($array_object, array_method => sub { ... });
     Extends($scalar_object, scalar_method => sub { ... });
     Extends($glob_object, glob_method => sub { ... });
     Extends($hash_class, hash_method => sub { ... });
     Extends($array_class, array_method => sub { ... });
     Extends($scalar_class, scalar_method => sub { ... });
     Extends($glob_class, glob_method => sub { ... });

=head2 Alias($object, $existing_method, $new_name)

Creates an alias for an existing method in the object with a new name.

=head3 Arguments:

=over 4

=item * C<$object> - The object reference in which the alias will be created.

=item * C<$existing_method> - The name of the existing method to alias.

=item * C<$new_name> - The new name for the alias.

=back

=head3 Description:

This function creates an alias for an existing method in the object with a new name. It allows referencing the same method implementation using different names within the same object.

=head3 Example:

    ############################################################################

    use Extender;

    my $object = Extends({}, original_method => sub {
        return "Original method";
    });

    # Create an alias 'new_alias' for 'original_method' in $object
    Alias($object, 'original_method', 'new_alias');

    # Using the alias
    print $object->new_alias(), "\n";  # Outputs: Original method

    ############################################################################

=head3 Supported Object Types: Can be used with HASH, ARRAY, SCALAR, GLOB references, or class objects.

=head2 AddMethod($object, $method_name, $code_ref)

Adds a new method to the object.

=head3 Arguments:

=over 4

=item * C<$object> - The object reference to which the method will be added.

=item * C<$method_name> - Name of the method to add. Must be a valid Perl subroutine name (word characters only).

=item * C<$code_ref> - Reference to the subroutine (code reference) that defines the method.

=back

=head3 Description:

This function adds a new method to the object's namespace. It validates the method name and code reference before adding it to the object.

=head3 Example:

    ############################################################################

    use Extender;

    my $object = Extends({}, custom_method => sub {
        my ($self, $arg1, $arg2) = @_;
        return "Custom method called with args: $arg1, $arg2";
    })->AddMethod(custom_method2 => sub {
        my ($self, $arg1, $arg2) = @_;
        return "Custom method2 called with args: $arg1, $arg2";
    });

    # Using the added method
    my $result = $object->custom_method2('foo', 'bar');
    print "$result\n";  # Outputs: Custom method2 called with args: foo, bar

    ############################################################################

=head3 Supported Object Types: Can be used with HASH, ARRAY, SCALAR, GLOB references, or class objects.

=head2 Decorate($object, $method_name, $decorator)

Decorates an existing method of an object with a custom decorator.

=head3 Arguments:

=over 4

=item * C<$object> - The object reference whose method is to be decorated.

=item * C<$method_name> - The name of the method to decorate.

=item * C<$decorator> - A coderef representing the decorator function.

=back

=head3 Description:

This function allows decorating an existing method of an object with a custom decorator function. The original method is replaced with a new subroutine that invokes the decorator function before and/or after invoking the original method.

=head3 Example:

    ############################################################################

    use Extender;

    # Define a decorator function
    sub timing_decorator {
        my ($self, $orig_method, @args) = @_;
        my $start_time = time();
        my $result = $orig_method->($self, @args);
        my $end_time = time();
        my $execution_time = $end_time - $start_time;
        print "Execution time: $execution_time seconds\n";
        return $result;
    }

    my $object = AddMethod({counter => 0}, increment => sub { my ($object)=@_; $object->{counter}++ });

    # Decorate the 'increment' method with timing_decorator
    Decorate($object, 'increment', \&timing_decorator);

    # Invoke the decorated method
    $object->increment();

    # Output the counter value
    print "Counter: ", $object->{counter}, "\n";

    ############################################################################

=head3 Supported Object Types: Can be used with HASH, ARRAY, SCALAR, GLOB references, or class objects.

=head2 ApplyRole($object, $role_class)

Applies a role (mixin) to an object, importing and applying its methods.

=head3 Arguments:

=over 4

=item * C<$object> - The object reference to which the role will be applied.

=item * C<$role_class> - The name of the role class to be applied.

=back

=head3 Description:

This function loads a role class using C<require>, imports its methods into the current package, and applies them to the object using C<apply>.

=head3 Example

    ############################################################################

    # Define a role (mixin)
    package MyRole;
    
    sub apply {
        my ($class, $object) = @_;
        no strict 'refs';
        for my $method (qw/foo bar/) {
            *{"${object}::$method"} = \&{"${class}::$method"};
        }
    }

    sub foo { print "foo\n" }
    sub bar { print "bar\n" }

    ############################################################################

    package main;

    use Extender;

    # Apply the role to an object
    my $object = {};
    ApplyRole($object, 'MyRole');

    # Call the role methods
    $object->foo();  # Outputs: foo
    $object->bar();  # Outputs: bar

    ############################################################################

=head3 Supported Object Types: Can be used with HASH, ARRAY, SCALAR, GLOB references, or class objects.

=head2 InitHook($object, $hook_name, $hook_code)

Adds initialization or destruction hooks to an object.

=head3 Arguments:

=over 4

=item * C<$object> - The object reference to which the hook will be added.

=item * C<$hook_name> - The type of hook to add. Valid values are 'INIT' for initialization and 'DESTRUCT' for destruction.

=item * C<$hook_code> - A code reference to the hook function to be executed.

=back

=head3 Description:

This function adds a code reference to the specified hook array (`_init_hooks` or `_destruct_hooks`) in the object. Hooks can be executed during object initialization or destruction phases.

=head3 Example:

    ############################################################################

    package MyClass;

    sub new {
        my $self = bless {}, shift;
        return $self;
    }

    sub DESTROY {
        my $self = shift;
        # Implement destruction logic if needed
    }

    ############################################################################

    package main;

    use Extender;
    use MyClass;

    InitHook('MyClass', 'INIT', sub {
        print "Initializing object\n";
    });

    InitHook('MyClass', 'DESTRUCT', sub {
        print "Destructing object\n";
    });

    my $object = MyClass->new(); # Output: Initializing object
    undef $object; # Output: Destructing object

    ############################################################################

=head3 Supported Object Types: Can only be used on class names. For example:

    use ClassName;

    InitHook('ClassName', 'INIT', sub { print "Hash object initialized\n" });
    InitHook('ClassName', 'DESTRUCT', sub { print "Array object destructed\n" });

=head2 Unload($object, @methods)

Removes specified methods from the object's namespace.

=head3 Arguments:

=over 4

=item * C<$object> - The object reference from which methods will be removed.

=item * C<@methods> - List of method names to be removed from the object.

=back

=head3 Description:

This function removes specified methods from the object's namespace.
It effectively unloads or deletes methods that were previously added or defined within the object.

=head3 Example:

    ############################################################################

    use Extender;

    my $object = Extends({}, example_method => sub {
        return "Example method";
    });

    # Unload the method from $object
    Unload($object, 'example_method');

    # Attempting to use the unloaded method will fail
    eval {
        $object->example_method();  # This will throw an error
    };
    if ($@) {
        print "Error: $@\n";
    }

    ############################################################################

=head3 Supported Object Types: Can be used with HASH, ARRAY, SCALAR, GLOB references, or class objects.

=head1 USAGE

=head2 Extend an Object with Methods from a Module

    ############################################################################

    use Extender;

    # Extend an object with methods from a module
    my $object = Extend(MyClass->new(), 'Some::Class');

    # Now $object can use any method from Some::Class
    $object->method1(1, 2, 3, 4);

    ############################################################################

=head2 Extend an Object with Custom Methods

    ############################################################################

    use Extender;

    # Extend an object with custom methods
    my $object = Extends(
        MyClass->new(),
        greet => sub { my ($self, $name) = @_; print "Hello, $name!\n"; },
        custom_method => \&some_function,
    );

    # Using the added methods
    $object->greet('Alice');               # Output: Hello, Alice!
    $object->custom_method('Hello');       # Assuming some_function prints something

    ############################################################################

=head2 Adding Methods to Raw Reference Variables

    ############################################################################

    package HashMethods;

    use strict;
    use warnings;
    use Exporter 'import';
    our @EXPORT = qw(set get);

    sub set {
        my ($self, $key, $value) = @_;
        $self->{$key} = $value;
    }

    sub get {
        my ($self, $key) = @_;
        return $self->{$key};
    }

    1;

    ############################################################################

    package ArrayMethods;

    use strict;
    use warnings;
    use Exporter 'import';
    our @EXPORT = qw(add get);

    sub add {
        my ($self, $item) = @_;
        push @$self, $item;
    }

    sub get {
        my ($self, $index) = @_;
        return $self->[$index];
    }

    1;

    ############################################################################

    package ScalarMethods;

    use strict;
    use warnings;
    use Exporter 'import';
    our @EXPORT = qw(set get substr length);

    sub set {
        my ($self, $value) = @_;
        $$self = $value;
    }

    sub get {
        my ($self) = @_;
        return $$self;
    }

    sub substr {
        my $self = shift;
        return substr($$self, @_);
    }

    sub length {
        my ($self) = @_;
        return length $$self;
    }

    1;

    ############################################################################

    package main;

    use strict;
    use warnings;
    use Extender;
    use HashMethods;
    use ArrayMethods;
    use ScalarMethods;

    my $hash_object = {};
    my $array_object = [];
    my $scalar_object = \"";

    # Extend $hash_object with methods from HashMethods
    Extend($hash_object, 'HashMethods', 'set', 'get');

    # Extend $array_object with methods from ArrayMethods
    Extend($array_object, 'ArrayMethods', 'add', 'get');

    # Extend $scalar_object with methods from ScalarMethods
    Extend($scalar_object, 'ScalarMethods', 'set', 'get', 'substr', 'length');

    # Using extended methods for hash object
    $hash_object->set('key', 'value');
    print $hash_object->get('key'), "\n";  # Outputs: value

    # Using extended methods for array object
    $array_object->add('item1');
    $array_object->add('item2');
    print $array_object->get(0), "\n";  # Outputs: item1

    # Using extended methods for scalar object
    $scalar_object->set('John');
    print $scalar_object->get(), "\n";  # Outputs: John
    print $scalar_object->length(), "\n";  # Outputs: 4
    print $scalar_object->substr(1, 2), "\n";  # Outputs: oh
    $scalar_object->substr(1, 2, "ane");
    print $scalar_object->get(), "\n";  # Outputs: Jane

    1;

    ############################################################################

=head2 Adding methods using anonymous subroutines and existing functions

    ############################################################################

    package MyClass;
    sub new {
        my $class = shift;
        return bless {}, $class;
    }

    ############################################################################

    package main;

    use Extender;

    my $object = MyClass->new();

    Extends($object,
        greet => sub { my ($self, $name) = @_; print "Hello, $name!\n"; },
        custom_method => \&some_function,
    );

    # Using the added methods
    $object->greet('Alice'); # Output: Hello, Alice!
    $object->custom_method('Hello'); # Assuming some_function prints something

    ############################################################################

=head2 Using Shared Object for Shared Variable functionality

    ############################################################################

    package main;

    use strict;
    use warnings;
    use threads;
    use threads::shared;
    use Extender;

    ############################################################################

    # Example methods to manipulate shared data

    # Method to set data in a shared hash
    sub set_hash_data {
        my ($self, $key, $value) = @_;
        lock(%{$self});
        $self->{$key} = $value;
    }

    # Method to get data from a shared hash
    sub get_hash_data {
        my ($self, $key) = @_;
        lock(%{$self});
        return $self->{$key};
    }

    # Method to add item to a shared array
    sub add_array_item {
        my ($self, $item) = @_;
        lock(@{$self});
        push @{$self}, $item;
    }

    # Method to get item from a shared array
    sub get_array_item {
        my ($self, $index) = @_;
        lock(@{$self});
        return $self->[$index];
    }

    # Method to set data in a shared scalar
    sub set_scalar_data {
        my ($self, $value) = @_;
        lock(${$self});
        ${$self} = $value;
    }

    # Method to get data from a shared scalar
    sub get_scalar_data {
        my ($self) = @_;
        lock(${$self});
        return ${$self};
    }

    ############################################################################

    # Create shared data structures
    my %shared_hash :shared;
    my @shared_array :shared;
    my $shared_scalar :shared;

    # Create shared objects
    my $shared_hash_object = \%shared_hash;
    my $shared_array_object = \@shared_array;
    my $shared_scalar_object = \$shared_scalar;

    ############################################################################

    # Extend the shared hash object with custom methods
    Extends($shared_hash_object,
        set_hash_data => \&set_hash_data,
        get_hash_data => \&get_hash_data,
    );

    # Extend the shared array object with custom methods
    Extends($shared_array_object,
        add_array_item => \&add_array_item,
        get_array_item => \&get_array_item,
    );

    # Extend the shared scalar object with custom methods
    Extends($shared_scalar_object,
        set_scalar_data => \&set_scalar_data,
        get_scalar_data => \&get_scalar_data,
    );

    ############################################################################

    # Create threads to manipulate shared objects concurrently

    # Thread for shared hash object
    my $hash_thread = threads->create(sub {
        $shared_hash_object->set_hash_data('key1', 'value1');
        print "Hash thread: key1 = " . $shared_hash_object->get_hash_data('key1') . "\n";
    });

    # Thread for shared array object
    my $array_thread = threads->create(sub {
        $shared_array_object->add_array_item('item1');
        print "Array thread: item at index 0 = " . $shared_array_object->get_array_item(0) . "\n";
    });

    # Thread for shared scalar object
    my $scalar_thread = threads->create(sub {
        $shared_scalar_object->set_scalar_data('shared_value');
        print "Scalar thread: value = " . $shared_scalar_object->get_scalar_data() . "\n";
    });

    ############################################################################

    # Wait for all threads to finish
    $hash_thread->join();
    $array_thread->join();
    $scalar_thread->join();

    1;

    ############################################################################

=head2 Updating existing methods on an object class

    ############################################################################

    package MyClass;

    sub new {
        my $class = shift;
        my $self = bless {}, $class;
        return $self;
    }

    sub original_method {
        return "Original method";
    }

    ############################################################################

    package main;

    use Extender;

    my $object = MyClass->new();

    # Define a method with the same name as an existing method
    Extends($object,
        original_method => sub { return "New method"; },
    );

    # Using the extended method
    print $object->original_method(), "\n";  # Outputs: New method

    1;

    ############################################################################

=head2 Creating Extender Class objects from any (even shared) reference typed variable

    ############################################################################

    package main;

    use Extender;

    ############################################################################

    my $object = Extend({},'Extender');

    # Define a method with the same name as an existing method
    $object->Extends(
        method => sub { return "method"; },
    );

    # Using the method
    print $object->method(), "\n";  # Outputs: method

    ############################################################################

    my $array = Extend([],'Extender');

    # Define a method with the same name as an existing method
    $array->Extends(
        method => sub { return "method"; },
    );

    # Using the method
    print $array->method(), "\n";  # Outputs: method

    ############################################################################

    my $scalar = Extend(\"",'Extender');

    # Define a method with the same name as an existing method
    $scalar->Extends(
        method => sub { return "method"; },
    );

    # Using the method
    print $scalar->method(), "\n";  # Outputs: method

    ############################################################################

    my $glob = Extend(\*GLOB,'Extender');

    # Define a method with the same name as an existing method
    $glob->Extends(
        method => sub { return "method"; },
    );

    # Using the method
    print $glob->method(), "\n";  # Outputs: method

    1;

    ############################################################################

=head2 Creating INIT and DESTRUCT Hooks

    ############################################################################

    package TestObject;

    sub new {
        my $self = bless {}, shift;
        return $self;
    }

    sub DESTROY {
        my $self = shift;
        # Implement destruction logic if needed
    }

    ############################################################################

    package main;

    use Extender;

    InitHook('TestObject', 'INIT', sub {
        print "Initializing object\n";
    });

    InitHook('TestObject', 'DESTRUCT', sub {
        print "Destructing object\n";
    });

    my $object = TestObject->new(); # Output: Initializing object
    undef $object; # Output: Destructing object

    ############################################################################

=head2 Creating an STDERR Logger with extended and decorative functionalities

    #!/usr/bin/perl

    use strict;
    use warnings;
    use BaseLogger;
    use Extender;

    ############################################################################

    class BaseLogger 1.0 {

        # Constructor
        method new {
            my $class = shift;
            return bless {}, $class;
        }

        # Basic logging method
        method log {
            my ($self, $message) = @_;
            print STDOUT $message."\n";
        }

        # Basic error method
        method err {
            my ($self, $message) = @_;
            print STDERR $message."\n";
        }

    };

    ############################################################################

    my $warn = sub { my ($self, $message) = @_; $self->err("[WARN] $message\n") };
    my $fatal = sub { my ($self, $message) = @_; $self->err("[FATAL] $message\n") };
    my $info = sub { my ($self, $message) = @_; $self->log("[INFO] $message\n") };
    my $deco = sub {
        my ($self, $original, $message) = @_;
        my $timestamp = localtime->strftime('%Y-%m-%d %H:%M:%S');
        $original->("[$timestamp] $message");
    };

    # Create an instance of BaseLogger & Extend and Decorate the logger object with Extender
    my $logger = Extend(
        BaseLogger->new(),
        'Extender'
    )
        ->Extends(
            'warn' => $warn,
            'fatal' =>  $fatal,
            'info' =>  $info,
        )
        ->Decorate('err', $deco)
        ->Decorate('log', $deco);

    # Use the class functionalities
    $logger->log("This is a log message.");
    $logger->err("This is an error message.");

    # Use the extended functionalities
    $logger->info("This is an informational message.");
    $logger->warn("This is a warning.");
    $logger->fatal("This is a fatal error.");

    1;

=head2 Extending Decorating and Aliasing class objects

    use strict;
    use warnings;
    use Extender;

    # Declare the class with a namespace and version ###########################
    class MyApp::Logger 1.0 {

        # Constructor method
        method new {
            my $class = shift;
            return bless {}, $class;
        }

        # Method with attributes
        method log : Private {
            my ($self, $message) = @_;
            print STDERR $message;
        }

        # Public method to log an info message
        method log_info {
            my ($self, $message) = @_;
            $self->log("[INFO] $message\n");
        }

        # Public method to log an error message
        method log_error {
            my ($self, $message) = @_;
            $self->log("[ERROR] $message\n");
        }

    }

    # Usage example
    package main;

    # Create a new Logger object ###############################################
    my $logger = Extend(
        MyApp::Logger->new(),
        'Extender'
    )
        ->Extends(
            'log_warn', sub {
                my ($self, $message) = @_;
                $self->log("[WARN] $message\n");
            }
        )
        ->Alias(
            'log_error', 'log_err'
        )
        ->Decorate(
            'log_info', 
            sub {
                my ($self, $original, @args) = @_;
                # Add extra behavior before and after
                my $result = $original->($self, @args);
                $self->log("[DECORATED] $args[0]\n");
                return $result;
            }
        );

    # Use the extended functionalities
    $logger->log_info("This is an informational message.");
    $logger->log_warn("This is a warning message.");
    $logger->log_err("This is an error message.");

    # Testing the decorated method
    $logger->log_info("This message is decorated.");

=cut

################################################################################

=head1 AUTHOR

OnEhIppY @ Domero Software <domerosoftware@gmail.com>

=head1 LICENSE

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic> and L<perlgpl>.

=head1 SEE ALSO

L<Exporter>, L<perlfunc>, L<perlref>, L<perlsub>

=cut
