NAME

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

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();

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

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.

EXPORTED FUNCTIONS

Extend($object, $module, @methods)

Extends an object with methods from a specified module.

Arguments:

$object - The object reference to which methods will be added.
$module - The name of the module from which methods will be imported.
@methods - Optional list of method names to import. If none are provided, all exported functions from $module will be imported.

Description:

This function extends the specified $object by importing methods from the module $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.

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'

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

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');

Extends($object, %extend)

Extends an object with custom methods.

Arguments:

$object - The object reference to which methods will be added.
%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.

Description:

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

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'

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

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 { ... });

Alias($object, $existing_method, $new_name)

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

Arguments:

$object - The object reference in which the alias will be created.
$existing_method - The name of the existing method to alias.
$new_name - The new name for the alias.

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.

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

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

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

AddMethod($object, $method_name, $code_ref)

Adds a new method to the object.

Arguments:

$object - The object reference to which the method will be added.
$method_name - Name of the method to add. Must be a valid Perl subroutine name (word characters only).
$code_ref - Reference to the subroutine (code reference) that defines the method.

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.

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

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

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

Decorate($object, $method_name, $decorator)

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

Arguments:

$object - The object reference whose method is to be decorated.
$method_name - The name of the method to decorate.
$decorator - A coderef representing the decorator function.

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.

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";

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

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

ApplyRole($object, $role_class)

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

Arguments:

$object - The object reference to which the role will be applied.
$role_class - The name of the role class to be applied.

Description:

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

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

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

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

InitHook($object, $hook_name, $hook_code)

Adds initialization or destruction hooks to an object.

Arguments:

$object - The object reference to which the hook will be added.
$hook_name - The type of hook to add. Valid values are 'INIT' for initialization and 'DESTRUCT' for destruction.
$hook_code - A code reference to the hook function to be executed.

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.

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

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

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" });

Unload($object, @methods)

Removes specified methods from the object's namespace.

Arguments:

$object - The object reference from which methods will be removed.
@methods - List of method names to be removed from the object.

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.

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";
}

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

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

USAGE

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);

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

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

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

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;

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

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

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

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;

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

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;

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

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;

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

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

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

Creating an STDERR Logger with decorative functionalities

use strict;
use warnings;
use Time::Piece;

############################################################################
# BaseLogger.pm
package BaseLogger;
use strict;
use warnings;

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

sub log {
    my ($self, $message) = @_;
    print STDERR $message;
}

1;

############################################################################
# LoggerDecorators.pm
package LoggerDecorators;

use strict;
use warnings;
use Time::Piece;

# Timestamp decorator
sub add_timestamp {
    my ($logger) = @_;
    return sub {
        my ($self, $message) = @_;
        my $timestamp = localtime->strftime('%Y-%m-%d %H:%M:%S');
        $logger->($self, "[$timestamp] $message");
    };
}

# Log level decorator
sub add_log_level {
    my ($logger, $level) = @_;
    return sub {
        my ($self, $message) = @_;
        $logger->($self, "[$level] $message");
    };
}

1;

############################################################################
# Example.pl

package main;
use strict;
use warnings;
use BaseLogger;
use LoggerDecorators;

# Create an instance of BaseLogger
my $logger = BaseLogger->new();

# Create a decorated logger
my $decorated_logger = sub {
    my ($self, $message) = @_;
    $logger->log($message);
};

# Apply decorators to extend logging functionality
$decorated_logger = add_timestamp($decorated_logger);
$decorated_logger = add_log_level($decorated_logger, 'INFO');

# Helper function to capture STDERR output
sub capture_stderr {
    my ($code) = @_;
    my $output;
    {
        open my $stderr_backup, '>&', STDERR or die "Cannot backup STDERR: $!";
        open STDERR, '>', \$output or die "Cannot redirect STDERR: $!";
        
        $code->();
        
        open STDERR, '>&', $stderr_backup or die "Cannot restore STDERR: $!";
        close $stderr_backup;
    }
    return $output;
}

# Capture logging output
my $stderr_output = capture_stderr(sub {
    $decorated_logger->("This is a test message\n");
});

# Output captured log
print "Captured STDERR output:\n";
print $stderr_output;

1;

AUTHOR

OnEhIppY @ Domero Software <domerosoftware@gmail.com>

LICENSE

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

	Global
`s`	Focus search bar
`?`	Bring up this help dialog

	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)

	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse

	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)

NAME

SYNOPSIS

DESCRIPTION

EXPORTED FUNCTIONS

Extend($object, $module, @methods)

Arguments:

Description:

Example:

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

Extends($object, %extend)

Arguments:

Description:

Example:

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

Alias($object, $existing_method, $new_name)

Arguments:

Description:

Example:

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

AddMethod($object, $method_name, $code_ref)

Arguments:

Description:

Example:

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

Decorate($object, $method_name, $decorator)

Arguments:

Description:

Example:

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

ApplyRole($object, $role_class)

Arguments:

Description:

Example

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

InitHook($object, $hook_name, $hook_code)

Arguments:

Description:

Example:

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

Unload($object, @methods)

Arguments:

Description:

Example:

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

USAGE

Extend an Object with Methods from a Module

Extend an Object with Custom Methods

Adding Methods to Raw Reference Variables

Adding methods using anonymous subroutines and existing functions

Using Shared Object for Shared Variable functionality

Updating existing methods on an object class

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

Creating INIT and DESTRUCT Hooks

Creating an STDERR Logger with decorative functionalities

AUTHOR

LICENSE

SEE ALSO

Module Install Instructions