NAME
Extender - Dynamically enhance Perl objects with additional methods from other modules or custom subroutines
SYNOPSIS
my $object = MyClass->new();
Extend($object, 'Some::Class');
$object->method_from_some_class();
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:
my $object = Extend({}, 'Hash::Util', 'keys', 'values');
|
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:
my $object = Extends(
{},
custom_method => sub { return "Custom method" },
dynamic_method => \"sub { return '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:
my $object = Extends({}, original_method => sub {
return "Original method";
});
Alias($object, 'original_method', 'new_alias');
print $object->new_alias(), "\n";
|
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:
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";
});
my $result = $object->custom_method2('foo', 'bar');
print "$result\n";
|
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:
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($object, 'increment', \&timing_decorator);
$object->increment();
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:
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
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" }
my $object = {};
ApplyRole($object, 'MyRole');
$object->foo();
$object->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:
sub new {
my $self = bless {}, shift;
return $self;
}
sub DESTROY {
my $self = shift;
}
InitHook('MyClass', 'INIT', sub {
print "Initializing object\n";
});
InitHook('MyClass', 'DESTRUCT', sub {
print "Destructing object\n";
});
my $object = MyClass->new();
undef $object;
|
Supported Object Types: Can only be used on class names. For example:
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:
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:
my $object = Extends({}, example_method => sub {
return "Example method";
});
Unload($object, 'example_method');
eval {
$object->example_method();
};
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
my $object = Extend(MyClass->new(), 'Some::Class');
$object->method1(1, 2, 3, 4);
|
Extend an Object with Custom Methods
my $object = Extends(
MyClass->new(),
greet => sub { my ($self, $name) = @_; print "Hello, $name!\n"; },
custom_method => \&some_function,
);
$object->greet('Alice');
$object->custom_method('Hello');
|
Adding Methods to Raw Reference Variables
our @EXPORT = qw(set get);
sub set {
my ($self, $key, $value) = @_;
$self->{$key} = $value;
}
sub get {
my ($self, $key) = @_;
return $self->{$key};
}
1;
our @EXPORT = qw(add get);
sub add {
my ($self, $item) = @_;
push @$self, $item;
}
sub get {
my ($self, $index) = @_;
return $self->[$index];
}
1;
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;
my $hash_object = {};
my $array_object = [];
my $scalar_object = \"";
Extend($hash_object, 'HashMethods', 'set', 'get');
Extend($array_object, 'ArrayMethods', 'add', 'get');
Extend($scalar_object, 'ScalarMethods', 'set', 'get', 'substr', 'length');
$hash_object->set('key', 'value');
print $hash_object->get('key'), "\n";
$array_object->add('item1');
$array_object->add('item2');
print $array_object->get(0), "\n";
$scalar_object->set('John');
print $scalar_object->get(), "\n";
print $scalar_object->length(), "\n";
print $scalar_object->substr(1, 2), "\n";
$scalar_object->substr(1, 2, "ane");
print $scalar_object->get(), "\n";
1;
|
Adding methods using anonymous subroutines and existing functions
sub new {
my $class = shift;
return bless {}, $class;
}
my $object = MyClass->new();
Extends($object,
greet => sub { my ($self, $name) = @_; print "Hello, $name!\n"; },
custom_method => \&some_function,
);
$object->greet('Alice');
$object->custom_method('Hello');
|
Using Shared Object for Shared Variable functionality
sub set_hash_data {
my ($self, $key, $value) = @_;
lock(%{$self});
$self->{$key} = $value;
}
sub get_hash_data {
my ($self, $key) = @_;
lock(%{$self});
return $self->{$key};
}
sub add_array_item {
my ($self, $item) = @_;
lock(@{$self});
push @{$self}, $item;
}
sub get_array_item {
my ($self, $index) = @_;
lock(@{$self});
return $self->[$index];
}
sub set_scalar_data {
my ($self, $value) = @_;
lock(${$self});
${$self} = $value;
}
sub get_scalar_data {
my ($self) = @_;
lock(${$self});
return ${$self};
}
my %shared_hash :shared;
my @shared_array :shared;
my $shared_scalar :shared;
my $shared_hash_object = \%shared_hash;
my $shared_array_object = \@shared_array;
my $shared_scalar_object = \$shared_scalar;
Extends($shared_hash_object,
set_hash_data => \&set_hash_data,
get_hash_data => \&get_hash_data,
);
Extends($shared_array_object,
add_array_item => \&add_array_item,
get_array_item => \&get_array_item,
);
Extends($shared_scalar_object,
set_scalar_data => \&set_scalar_data,
get_scalar_data => \&get_scalar_data,
);
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";
});
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";
});
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";
});
$hash_thread->join();
$array_thread->join();
$scalar_thread->join();
1;
|
Updating existing methods on an object class
sub new {
my $class = shift;
my $self = bless {}, $class;
return $self;
}
sub original_method {
return "Original method";
}
my $object = MyClass->new();
Extends($object,
original_method => sub { return "New method"; },
);
print $object->original_method(), "\n";
1;
|
Creating Extender Class objects from any (even shared) reference typed variable
my $object = Extend({},'Extender');
$object->Extends(
method => sub { return "method"; },
);
print $object->method(), "\n";
my $array = Extend([],'Extender');
$array->Extends(
method => sub { return "method"; },
);
print $array->method(), "\n";
my $scalar = Extend(\"",'Extender');
$scalar->Extends(
method => sub { return "method"; },
);
print $scalar->method(), "\n";
my $glob = Extend(\*GLOB,'Extender');
$glob->Extends(
method => sub { return "method"; },
);
print $glob->method(), "\n";
1;
|
Creating INIT and DESTRUCT Hooks
sub new {
my $self = bless {}, shift;
return $self;
}
sub DESTROY {
my $self = shift;
}
InitHook('TestObject', 'INIT', sub {
print "Initializing object\n";
});
InitHook('TestObject', 'DESTRUCT', sub {
print "Destructing object\n";
});
my $object = TestObject->new();
undef $object;
|
Creating an STDERR Logger with extended and decorative functionalities
#!/usr/bin/perl
class BaseLogger 1.0 {
method new {
my $class = shift;
return bless {}, $class;
}
method log {
my ($self, $message) = @_;
print STDOUT $message."\n";
}
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");
};
my $logger = Extend(
BaseLogger->new(),
'Extender'
)
->Extends(
'warn' => $warn,
'fatal' => $fatal,
'info' => $info,
)
->Decorate('err', $deco)
->Decorate('log', $deco);
$logger->log("This is a log message.");
$logger->err("This is an error message.");
$logger->info("This is an informational message.");
$logger->warn("This is a warning.");
$logger->fatal("This is a fatal error.");
1;
|
Extending Decorating and Aliasing class objects
class MyApp::Logger 1.0 {
method new {
my $class = shift;
return bless {}, $class;
}
method log : Private {
my ($self, $message) = @_;
print STDERR $message;
}
method log_info {
my ($self, $message) = @_;
$self->log("[INFO] $message\n");
}
method log_error {
my ($self, $message) = @_;
$self->log("[ERROR] $message\n");
}
}
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) = @_;
my $result = $original->($self, @args);
$self->log("[DECORATED] $args[0]\n");
return $result;
}
);
$logger->log_info("This is an informational message.");
$logger->log_warn("This is a warning message.");
$logger->log_err("This is an error message.");
$logger->log_info("This message is decorated.");
|
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.
SEE ALSO
Exporter, perlfunc, perlref, perlsub