Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Re: AbstractClassFactory

by hypochrismutreefuzz (Scribe)
on Jan 15, 2003 at 23:07 UTC ( [id://227271]=note: print w/replies, xml ) Need Help??


in reply to AbstractClassFactory

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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://227271]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (4)
As of 2024-04-25 08:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found