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

In reply to Re: AbstractClassFactory by hypochrismutreefuzz
in thread AbstractClassFactory by hypochrismutreefuzz

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.