Nice goodie, but I've three comments:

1. Why having two arrayrefs dealing with the same information, i.e. methods? This seems error-prone from a user (= programmer)'s point of view. Wouldn't a hashref with names as keys and coderefs as values be more transparent?
2. As a second remark: you can define objects, but it would be convenient to have the concept of classes since with this approach types seem rather ad hoc. Two objects of the same class need not have the same methods, which is sometimes convenient but... ehrm, unpleasant in general
3. I'm not very fond of the $obj->incant('action', @args) invocation, but granted, that's personal taste (or lack thereof ;-) The incant seems to diminish readability.

Like any piece of art the trick it knowing when to stop. You went one step too far here. Your code reference should not be blessed and the incant method is completely superfluous. I'd normally prefer to write that sort of thing as $obj -> ( 'method', @args ) since that's really what is happening anyway. The only thing you lose is the blessing's inheritance tree but you didn't mention that so I'm not sure if you even intended to use it. Personally I'm looking at your implementation as a way of getting to classless objects. All you really need here is the code reference - you just call it with the method/property name as a parameter to the object.

Also, some comments on style:

How about quiting the cargo cult line? For your concept it really doesn't fit here.

 for (keys %$props) {
     $props->{$_} = $colors{$_};
 }
[download]

Better done as a hash slice - your existing form is much less readable than it could be. Clearer: @{$props}{ keys %$props } = @colors{ keys %$props }

I am still trying to find a use for a closure that is used as an object reference. I guess that like any form of recursion its more effecient to "flatten" it out.

Thanks for the comments; but what is a "cargo cult line"?

You put the code $class = ref($class) || $class into your module. There's no good reason for you to do that. People here go on endlessly about this specific meme but in your particular case it is particularly extraneous. The only possible reason you would have for it in this example is for cargo cult reasons. See cargo cult programming. It should merely be left as my $class = shift without the "maybe clone this object but not really" meaning you're getting. Part of my original objection was that you didn't even need the blessing for what you were doing and this part I'm quibbling over muddies the waters even more.

The other thing you're missing is that there is a universe of uses for closures and that isn't about "trying to find a use". If you really want to give your mind a spin go read up on Capabilities and faceted objects over at E in a Walnut. You'll come out better for it (it's only 70 pages and if you feel like it most of the middle can be skipped).

---

Fun Fun Fun in the Fluffy Chair

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

Thanks for all the positive feedback especially diotalevi.

I have incorported all of your suggestions. The new object is calld CodeRefObj, and takes 2 hash references. The closure is returned and passed to the constructor of the Interface class, where it is blessed into that class. The coderef then maps the methods to their implementation.

package CodeRefObj;

use strict;
use warnings;

sub create {
    my $properties = shift;
    my $methods = shift;
    my $closure = sub {
        my $magick = shift;
            # first resolve any property sets or gets
        if (exists $properties->{$magick}) {
            $properties->{$magick} = shift if @_;
            return $properties->{$magick};
        }    # next resolve any method calls, making
            # sure to include a ref to the %properties hash
        elsif (exists $methods->{$magick}) {
            return &{ $methods->{$magick} }($properties, @_);
        }
        else {
            die "Magick $magick not defined";
        }
    };
    return $closure;
}

1;
[download]

I have used this to implement a sort of pointer to a implementation class idiom, sort of like C++; the class module would consist of subs that invoked the pointer to resolve the method/property calls.

Here is an example using ADO and Access database.

package AccessDB::Impl;

use strict;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects 2.7';
use Win32::OLE::Variant qw(:DEFAULT nothing);
use CodeRefObj;
use Hash::Util qw/lock_keys lock_hash lock_value unlock_value/;

my @prop_names = qw/mdb_file state conn/;
my %methods = (
    'open'=>\&open,
    'close'=>\&close,
    'execute'=>\&execute,
    'getConnString'=>\&getConnString,
    'free_resources'=>\&free_resources);

my $conn_string1 = "Provider=MSDataShape;Data Provider=Microsoft.Jet.O
+LEDB.4.0;User ID=Admin;Data Source=";
my $conn_string2 = ";Mode=Share Deny None;Jet OLEDB:System database=''
+;Jet OLEDB:Database Password=''";

sub init {
    my $file_name = shift;

    my (%properties);
    lock_keys(%properties, @prop_names);
    $properties{'state'} = 0;
    lock_value(%properties, 'state');
    $properties{'conn'} = Win32::OLE->new('ADODB.Connection');
    lock_value(%properties, 'conn');
    $properties{'mdb_file'} = $file_name || '';
    lock_hash(%methods);
    return CodeRefObj::create(\%properties, \%methods);
}

sub open {
    my $props = shift;
    $props->{'mdb_file'} = shift if @_;
    die "no mdb_file specified" unless $props->{'mdb_file'};

    my $connection = join('', $conn_string1, $props->{'mdb_file'}, $co
+nn_string2);
    $props->{'conn'}->Open($connection) unless $props->{'conn'}->{Stat
+e};
    die Win32::OLE->LastError() if Win32::OLE->LastError();
    unlock_value(%{$props}, 'state');
    $props->{'state'} = $props->{'conn'}->{State};
    lock_value(%{$props}, 'state');
}

sub close {
    my $props = shift;
    $props->{'conn'}->Close() if $props->{'conn'}->{State};
    unlock_value(%{$props}, 'state');
    $props->{'state'} = $props->{'conn'}->{State};
    lock_value(%{$props}, 'state');
}

sub execute {
    my $props = shift;
    my $sql = shift;
    $props->{'conn'}->Execute($sql);
    die "$sql" if Win32::OLE->LastError();
}

sub getConnString {
    my $props = shift;
    return join('', $conn_string1, $props->{'mdb_file'}, $conn_string2
+);
}

sub free_resources {
    my $props = shift;
    unlock_value(%{$props}, 'conn');
    $props->{'conn'}->Close() if $props->{'conn'}->{State};
    $props->{'conn'} = nothing;
}

1;
[download]

package AccessDB::Interface;

use strict;
use AccessDB::Impl;

# Constructor AccessDB::Interface->create([$file_name])
sub create {
    my $class = shift;
    my $code_ref_obj = AccessDB::Impl::init(@_);
    return bless ($code_ref_obj, $class);
}

# Properties
# mdb_file is read-write, 
# returns/sets full path of file
# $obj->mdb_file([$file_name])
sub mdb_file {
    my $code_ref_obj = shift;
    return $code_ref_obj->('mdb_file', @_);
}

# state is read-only and ignores any parameters
# returns either 0 for closed or 1 for open
# $obj->state()
sub state {
    my $code_ref_obj = shift;
    return $code_ref_obj->('state');
}

# conn is read only
# returns the connection object
# $obj->conn()
sub conn {
    my $code_ref_obj = shift;
    return $code_ref_obj->('conn');
}

# Methods
# $obj->open([$filename])
sub open {
    my $code_ref_obj = shift;
    $code_ref_obj->('open', @_);
}

# obj->execute($sql)
sub execute {
    my $code_ref_obj = shift;
    $code_ref_obj->('execute', @_);
}

# $obj->close()
sub close {
    my $code_ref_obj = shift;
    $code_ref_obj->('close');
}

# $obj->getConnString()
# returns the connection string
sub getConnString {
    my $code_ref_obj = shift;
    return $code_ref_obj->('getConnString');
}

# DESTROY gets called by system
# and then calls free_resources
sub DESTROY {
    my $code_ref_obj = shift;
    $code_ref_obj->('free_resources');
}

1;
[download]

And a short test file

#!/usr/local/bin/perl

use strict;
use warnings;
use AccessDB::Interface;

my $file = 'e:\Base\test.mdb';

my $adb = AccessDB::Interface->create($file);
$adb->open();
print "State is ", $adb->state(), "\n";
my $sql = <<"end_of_sql";
INSERT INTO tstTable (Entry, Name)
VALUES ('Blather', 'John Q Publik')
end_of_sql

$adb->execute($sql);
$adb->close();
[download]

I suppose you could add implementations by using an %IS_IMPLEMENTED_BY hash that has the package names. That part needs work. This has been tested under Win2K with ActiveState Perl 5.8