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;

##</code><code>##

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.OLEDB.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'}, $conn_string2);
	$props->{'conn'}->Open($connection) unless $props->{'conn'}->{State};
	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;

##</code><code>##

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;

##</code><code>##

#!/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();