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