#!/usr/bin/perl
################################################################################

### Scenario 1: Extending an Object with Module Methods

    package MyMethods;

    use strict;
    use warnings;
    use Exporter 'import';
    our @EXPORT = qw(increment_value display_value);

    sub increment_value {
        my ($self, $key) = @_;
        $self->{$key}++ if exists $self->{$key};
    }

    sub display_value {
        my ($self, $key) = @_;
        print "$key: ", $self->{$key} // 'undefined', "\n";
    }

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

    package MyObject;

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

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

    package main;

    use strict;
    use warnings;
    use Extender;

    my $object = MyObject->new();

    # Extend the object with methods from MyMethods
    Extend($object, 'MyMethods');

    # Using extended methods
    $object->increment_value('count');
    $object->display_value('count');  # Outputs: count: 1

    $object->increment_value('count');
    $object->display_value('count');  # Outputs: count: 2

    1;

### Scenario 2: Adding Custom Methods to an Object

    package MyDataStructure;

    sub new {
        my $class = shift;
        my $self = bless { data => [] }, $class;
        return $self;
    }

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

    package main;

    use Extender;

    my $object = MyDataStructure->new();
    Extends($object,
        add_data => sub { my ($self, $item) = @_; push @{$self->{data}}, $item; },
        get_data => sub { my $self = shift; return @{$self->{data}}; },
    );

    # Using custom methods
    $object->add_data('Item 1');
    $object->add_data('Item 2');
    my @data = $object->get_data();
    print "Data: @data\n";  # Outputs: Data: Item 1 Item 2

    1;

### Scenario 3: Extending Multiple Objects with Different Modules

    package MyMethods;

    use strict;
    use warnings;
    use Exporter 'import';
    our @EXPORT = qw(increment_value display_value);

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

    sub display_value {
        my ($self) = @_;
        print "Value: $$self\n";
    }

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

    package MyClass1;

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

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

    package MyClass2;

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

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

    package main;

    use strict;
    use warnings;
    use Extender;
    use MyMethods;

    my $object1 = MyClass1->new();
    my $object2 = MyClass2->new();

    # Extend $object1 with MyMethods
    Extends($object1,
        increment_value => \&MyMethods::increment_value,
        display_value   => \&MyMethods::display_value,
    );

    # Extend $object2 with MyMethods
    Extends($object2,
        increment_value => \&MyMethods::increment_value,
        display_value   => \&MyMethods::display_value,
    );

    # Using extended methods
    $object1->increment_value(10);
    $object1->display_value();  # Outputs: Value: 10

    $object2->increment_value(20);
    $object2->display_value();  # Outputs: Value: 20

    1;

### Scenario 4: Adding Methods to Raw References (Hash, Array, Scalar)

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

    # PACKAGES

    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;

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

    # MAIN 

    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;

### Scenario 5: Using Reference to Scalar with Code Ref

    package main;

    use Extender;

    my $object = {};
    my $code_ref = sub { my ($self, $arg) = @_; return "Hello, $arg!"; };

    # Extenda $object with a method using reference to scalar with code ref
    Extends($object, 'greet' => \$code_ref);

    # Using extended method
    print $object->greet('Alice'), "\n";  # Outputs: Hello, Alice!

    1;

### Scenario 6: Used on shared variables

    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;

# Alias - The Alias function creates an alias for an existing method on an object.

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

    # Create an alias for 'original_method' as 'alias_method'
    Alias($object, 'alias_method', 'original_method');

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

    1;

# Unload - The Unload function removes a method from an object.

    package MyClass;

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

    sub method1 {
        return "Method 1";
    }

    sub method2 {
        return "Method 2";
    }

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

    package main;

    use Extender;

    my $object = MyClass->new();

    # Before Unload
    print $object->method1(), "\n";  # Outputs: Method 1
    print $object->method2(), "\n";  # Outputs: Method 2

    # Unload 'method1'
    Unload($object, 'method1');

    # After Unload
    # 'method1' should not be available
    eval {
        $object->method1();
    };
    warn "Error: $@" if $@;  # Outputs: Error: Can't locate object method "method1" via package

    # 'method2' should still be available
    print $object->method2(), "\n";  # Outputs: Method 2

    1;

# AddMethod - The AddMethod function dynamically adds a new method to an object.

    package MyClass;

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

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

    package main;

    use Extender;

    my $object = MyClass->new();

    # Add a new method 'new_method'
    AddMethod($object, 'new_method', sub { return "New method"; });

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

    1;

# Decorate - The Decorate function wraps an existing method on an object with additional behavior.

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

    # Decorate 'original_method'
    Decorate($object, 'original_method', sub {
        my ($self, $original, @args) = @_;
        return "Before: " . $original->($self, @args) . " After";
    });

    # Using the decorated method
    print $object->original_method(), "\n";  # Outputs: Before: Original method After

    1;

# ApplyRole - The ApplyRole function applies methods from a role package to an object.

    package TestRole;

    sub apply {
        my ($class, $object) = @_;
        no strict 'refs';
        *{$object . "::new_method"} = sub { return "New method"; };
    }

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

    package MyClass;

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

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

    package main;

    use Extender;

    my $object = MyClass->new();

    # Apply 'TestRole' to $object
    ApplyRole($object, 'TestRole');

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

    1;

# InitHook - The InitHook function attaches initialization and destruction hooks to an object.

    package TestObject;

    sub new { return bless {}, shift }

    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

    1;

# Creating Extender Class objects from any (even shared) reference typed variable except for CODE refrerences

    package main;

    use Extender;

    my $object = Extend({},'Extender');
    $object->Extends( method => sub { return "method"; } );
    print $object->method(), "\n";  # Outputs: method

    my $array = Extend([],'Extender');
    $array->Extends( method => sub { return "method"; } );
    print $array->method(), "\n";  # Outputs: method

    my $scalar = Extend(\"",'Extender');
    $scalar->Extends( method => sub { return "method"; } );
    print $scalar->method(), "\n";  # Outputs: method

    my $glob = Extend(\*GLOB,'Extender');
    $glob->Extends( method => sub { return "method"; } );
    print $glob->method(), "\n";  # Outputs: method

    1;
