Can I associate a CODE reference with a HASH reference that contains it in Perl?

Question

I want to create a hash reference with code references mapped to scalars (strings) as its members.

So far I have a map reference that looks something like this:

my $object;
$object = {
    'code1' => sub {
        print $_[0];
    },
    'code2' => sub {
        return 'Hello, World!';
    },
    'code3' => sub {
        $object->{code1}->($object->{code2}->());
    }
};
$object->{code3}->();

I would like to be able to "bless" the 'code3' reference in $object with $object, so I can do something like:

my $object;
$object = {
    'code1' => sub {
        print $_[0];
    },
    'code2' => sub {
        return 'Hello, World!';
    },
    'code3' => sub {
        $self = shift;
        $self->{code1}->($self->{code2}->());
    }
};
$object->{code3}->();

However, bless only works with packages, rather than hash tables.

Is there a way to do this in Perl 5 version 22?

Note: now that I think of it, it's better to pass $object to the method explicitly, as it solves JavaScript's "this" problem. I am just too used to Java's "this" which makes sense in Java where everything is a class and therefore all methods have a "this", but in scripting, it really helps to know if the "this" is actually passed, or is it just called as a function(and you end up accidentally polluting global scope or triggering strict warning) passing $self explicitly makes it clear that you are not calling it as a function, but as a method.

Answer 1

You are doing sub calls (not method calls), so you simply forgot to pass $self as a parameter.

my $object = {
    code1 => sub {
        print $_[0];
    },
    code2 => sub {
        return 'Hello, World!';
    },
    code3 => sub {
        my $self = shift;
        $self->{code1}->( $self, $self->{code2}->($self) );
    }
}; 
$object->{code3}->($object);

---

But I think you're trying to create JavaScript-like objects. You can start with the following:

package PrototypeObject;

sub new {
   my $class = shift;
   my $self = bless({}, $class);
   %$self = @_;
   return $self;
}

sub AUTOLOAD {
   my $self = shift;
   ( my $method = our $AUTOLOAD ) =~ s/^.*:://s;
   return $self->{$method}->($self, @_);
}

1;

use PrototypeObject qw( );

my $object = PrototypeObject->new(
    code1 => sub {
        print $_[1];
    },
    code2 => sub {
        return 'Hello, World!';
    },
    code3 => sub {
        my $self = shift;
        $self->code1( $self->code2() );
    }
); 

$object->code3();

Note that this will slow down your method calls as it must call AUTOLOAD before calling your method. This could be addressed by overloading the method call operator.

Check on CPAN. Someone might already have a more complete implementation.

Answer 2

This is not the exact syntax you want, but Perl 5 supports many ways of making method calls, including method calls via strings. So you could say:

#!/usr/bin/perl

{ package Foo;

use strict;
use warnings;

sub new { bless {}, shift }

sub code1 { my $self = shift; print "$_[0]\n" };
sub code2 { "Hello, World!" }
sub code3 {
    my $self = shift;
    my $method1 = "code1";
    my $method2 = "code2";
    $self->$method1($self->$method2);
}

}

use strict;
use warnings;

my $o = Foo->new;

print "normal call\n";
$o->code3;

print "via string\n";
my $method = "code3";
$o->$method;

Also, remember that a package's symbol table is a hash: %Foo::, so you can always go spelunking in there yourself:

#!/usr/bin/perl

{ package Foo;

use strict;
use warnings;

sub new { bless {}, shift }

sub code1 { my $self = shift; print "$_[0]\n" };
sub code2 { "Hello, World!" }
sub code3 {
    my $self = shift;
    my $method1 = "code1";
    my $method2 = "code2";
    $self->$method1($self->$method2);
}

}

use strict;
use warnings;

print $Foo::{code2}->(), "\n";

However, I would suggest having a really code reason for these techniques as it can make maintenance a nightmare (eg imaging trying to find all of the code calling Foo::approved, you can't just grep for "->approved" because the actual call is ->$state()).

I just read the comments and noticed you said

my concern with packages is that I can't seem to create packages at runtime, but I can create hash tables at runtime

Perl 5 does allow you to create packages at runtime. In fact, depending on how you define runtime, you can do anything at runtime with string eval as it reenters compile time when it is called. But there is also a pure-runtime method of manipulating the symbol tables with typeglobs:

#!/usr/bin/perl

{ package Foo;

use strict;
use warnings;

sub new { bless {}, shift }

}

use strict;
use warnings;

my $o = Foo->new;

# here we add functions at runtime to the package Foo
{
no warnings "once";
*Foo::code1 = sub { my $self = shift; print "$_[0]\n" };
*Foo::code2 = sub { "Hello, World!" };
*Foo::code3 = sub {
    my $self = shift;
    my $method1 = "code1";
    my $method2 = "code2";
    $self->$method1($self->$method2);
};
}

$o->code3;

Because Perl 5 is object oriented (and not object based like JavaScript) these methods are attached to all Foo objects. If you want individual objects have their own symbol tables, then I am there are certainly ways to do that. Off the top of my head, AUTOLOAD comes to mind:

#!/usr/bin/perl

{ package Foo;

use strict;
use Carp;
use warnings;

sub new {
    bless {
        symtab => {}
    }, shift
}

sub AUTOLOAD {
    my $self = shift;
    our $AUTOLOAD;
    my $method = $AUTOLOAD =~ s/.*:://r;

    my (undef, $file, $line) = caller();

    die "$method does not exist at $file line $line"
        unless exists $self->{symtab}{$method};

    $self->{symtab}{$method}->($self, @_);
}

sub DESTROY {} # prevent DESTROY method from being hijacked by AUTOLOAD

}

use v5.22;
use warnings;

my $o1 = Foo->new;
my $o2 = Foo->new;

$o1->{symtab}{inc} = sub { my $self = shift; $self->{i}++; };

$o1->inc;
$o1->inc;
$o1->inc;

say "inc called on o1 $o1->{i} times";

$o2->inc; #dies because we haven't defined inc for $o2 yet

Perl 5 is very flexible and will let you do just about anything you want (after all the motto is TIMTOWTDI), but you should always keep in mind the future programmer tasked with maintaining your code who may want to hunt you down and wear your skin for doing some of these tricks.

This question has a definite XY problem feel. It seems like you are trying to solve a problem in Perl 5 the same way you would have solved it in JavaScript. While Perl 5 will let you do that (as I have demonstrated), there may be a more idiomatic way of achieving the same effect. Can you describe what you are trying to do (not how you want to do it) in a different question and we can suggest the ways in which we would solve your problem.