package DBIx::dbMan;

use strict;
use vars qw/$VERSION/;
use DBIx::dbMan::Config;
use DBIx::dbMan::Lang;
use DBIx::dbMan::DBI;
use DBIx::dbMan::MemPool;

$VERSION = '0.21';

sub new {
	my $class = shift;
	my $obj = bless { @_ }, $class;
	return $obj;
}

sub start {
	my $obj = shift;

	$obj->{-trace} = 0;
	my $interface = $obj->{-interface};
	$interface = 'DBIx/dbMan/Interface/'.$interface.'.pm';
	eval { require $interface; };
	if ($@) { 
		$interface =~ s/\//::/g;
		$interface =~ s/\.pm$//;
		print STDERR "Can't locate interface module $interface\n";
		return;
	}
	$interface =~ s/\//::/g;
	$interface =~ s/\.pm$//;

	$obj->{mempool} = new DBIx::dbMan::MemPool;

	$obj->{config} = new DBIx::dbMan::Config;

	$obj->{lang} = new DBIx::dbMan::Lang -config => $obj->{config};

	$obj->{interface} = $interface->new(-config => $obj->{config},
			-lang => $obj->{lang}, -mempool => $obj->{mempool},
			-core => $obj);
	$obj->{interface}->hello();

	$obj->{dbi} = new DBIx::dbMan::DBI -config => $obj->{config},
			-interface => $obj->{interface},
			-mempool => $obj->{mempool};

	$obj->load_extensions;

	$obj->{interface}->loop() unless defined $main::TEST and $main::TEST;

	$obj->unload_extensions;

	$obj->{dbi}->close_all();

	$obj->{interface}->goodbye();

	$main::TEST_RESULT = 1 if defined $main::TEST and $main::TEST;
}

sub load_extensions {
	my $obj = shift;

	$obj->{extensions} = [];

	my %candidates = ();
	for my $dir ($obj->extensions_directories) {
		opendir D,$dir;
		for (grep /\.pm$/,readdir D) { 
			eval { require "$dir/$_"; };
			next if $@;
			s/\.pm$//;
			my $candidate = "DBIx::dbMan::Extension::".$_;
			my ($low,$high) = ('','');
			eval { ($low,$high) = $candidate->for_version(); };
			next if $low and $VERSION < $low;
			next if $high and $VERSION > $high;
			my $id = '';
			eval { $id = $candidate->IDENTIFICATION(); };
			next unless $id or $@;
			my ($ident,$ver) = ($id =~ /^(.*)-(.*)$/);
			next if $ident eq '000001-000001';	# not ID
			delete $INC{"$dir/$_.pm"};
			if (exists $candidates{$ident}) {
				next if $candidates{$ident}->{-ver} > $ver;
			}
			$candidates{$ident} = 
				{ -file => "$dir/$_.pm", -candidate => $candidate, -ver => $ver }; 
		};
		closedir D;
	}

	my %extensions = ();
	$obj->{extension_iterator} = 0;
	for my $candidate (keys %candidates) {
		my $ext = undef;
		eval {
			require $candidates{$candidate}->{-file};
			$ext = $candidates{$candidate}->{-candidate}->new(
				-config => $obj->{config}, 
				-interface => $obj->{interface},
				-dbi => $obj->{dbi},
				-core => $obj,
				-mempool => $obj->{mempool});
		};
		if (defined $ext and not $@) {
			my $preference = 0;
			eval { $preference = $ext->preference(); };
			$ext->{'___sort_criteria___'} = $preference.'_'.$obj->{extension_iterator};
			$extensions{$preference.'_'.$obj->{extension_iterator}} = $ext;
			++$obj->{extension_iterator};
		}
	}

	for (sort { 
			my ($fa,$sa,$fb,$sb) = split /_/,($a.'_'.$b); 
			if ($fa == $fb) { $sa <=> $sb; } else { $fb <=> $fa };
		} keys %extensions) {
		push @{$obj->{extensions}},$extensions{$_};
		$extensions{$_}->init();
	}
}

sub unload_extensions {
	my $obj = shift;

	for (@{$obj->{extensions}}) { $_->done();  undef $_; }
}

sub extensions_directories {
	my $obj = shift;
	my %alldirs = map { ($_ => 1) } (@INC,($obj->{config}->extensions_dir?
			($obj->{config}->extensions_dir):()),'.');
	my @dirs = ();
	for (map { my $tmp = $_; $tmp =~ s/\/$//; "$tmp/DBIx/dbMan/Extension"; }
			keys %alldirs) {
		push @dirs,$_ if -d $_;
	}
	return @dirs;
}

sub handle_action {
	my ($obj, %action) = @_;
		
	for my $ext (@{$obj->{extensions}}) {
		last if $action{action} eq 'NONE';
		my $acts = $ext->known_actions;
		if (defined $acts and ref $acts eq 'ARRAY') {
			my $found = 0;
			for (@$acts) {
				if ($_ eq $action{action}) {
					++$found;
					last;
				}
			}
			next unless $found;
		}
		if ($obj->{-trace}) {
			my $where = $ext;  $where =~ s/=.*$//;  $where =~ s/^DBIx::dbMan::Extension:://;
			my $params = '';
			for (sort keys %action) {
				next if $_ eq 'action';
				my $p = $action{$_};
				$p = "'$p'" unless $p =~ /^[-a-z0-9_.]$/i;
				$params .= ', '.$_.': '.$p;
			}
			$params =~ s/^, //;
			print "==> $where / $action{action} / $params\n";
		}
		%action = $ext->handle_action(%action);
		if ($obj->{-trace}) {
			my $where = $ext;  $where =~ s/=.*$//;  $where =~ s/^DBIx::dbMan::Extension:://;
			my $params = '';
			for (sort keys %action) {
				next if $_ eq 'action';
				my $p = $action{$_};
				$p = "'$p'" unless $p =~ /^[-a-z0-9_.]+$/i;
				$params .= ', '.$_.': '.$p;
			}
			$params =~ s/^, //;
			print "<== $where / $action{action} / $params\n";

		}
		return %action unless $action{processed};
		$action{processed} = undef;
	}

	$action{processed} = 1;
	return %action;
}

1;
