From 54b6ab7173c2641f2f2dd9afa2d56d5b75874f65 Mon Sep 17 00:00:00 2001
From: Milan Sorm <sorm@milansorm.cz>
Date: Thu, 13 Jul 2017 09:15:33 +0200
Subject: [PATCH] new version, recursive group

---
 Changes               |   3 +
 README                |   2 +-
 bin/cdbman            |   4 +-
 bin/dbman             |   4 +-
 lib/DBIx/dbMan.pm     | 494 +++++++++++++++++++++---------------------
 lib/DBIx/dbMan/DBI.pm | 475 ++++++++++++++++++++--------------------
 6 files changed, 506 insertions(+), 476 deletions(-)

diff --git a/Changes b/Changes
index a8b1f28..9b581ed 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension dbMan
 
+0.42 <20170714>
+    - group can be used recursively
+
 0.41 <20170713>
 	- DBI support for config with [...] and {...} syntax variable
 	- extension CmdSetOracleSpecials - support for LongReadLen (thanks to Tom Cernik)
diff --git a/README b/README
index 0b450ac..3d53429 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-dbMan 0.41
+dbMan 0.42
 (c) Copyright 1999-2017 by Milan Sorm, sorm@is4u.cz
 
 If you plan to use this program you must respect LICENSE file.
diff --git a/bin/cdbman b/bin/cdbman
index 01d4a18..e86ecae 100755
--- a/bin/cdbman
+++ b/bin/cdbman
@@ -50,7 +50,7 @@ $dbman->start;
 
 =head1 VERSION
  
-0.41
+0.42
  
 =head1 LICENSE
 
@@ -72,7 +72,7 @@ Report bugs directly to sorm@is4u.cz.
  
 =head1 LAST MODIFIED
  
-Thu Jul 13 08:20:07 CEST 2017
+Thu Jul 13 09:14:55 CEST 2017
 
 =head1 SEE ALSO
  
diff --git a/bin/dbman b/bin/dbman
index c1e9c6b..b83b28e 100755
--- a/bin/dbman
+++ b/bin/dbman
@@ -47,7 +47,7 @@ $dbman->start;
 
 =head1 VERSION
  
-0.41
+0.42
  
 =head1 LICENSE
 
@@ -69,7 +69,7 @@ Report bugs directly to sorm@is4u.cz.
  
 =head1 LAST MODIFIED
  
-Thu Jul 13 08:20:16 CEST 2017
+Thu Jul 13 09:14:39 CEST 2017
 
 =head1 SEE ALSO
  
diff --git a/lib/DBIx/dbMan.pm b/lib/DBIx/dbMan.pm
index 37944bc..5d4c122 100644
--- a/lib/DBIx/dbMan.pm
+++ b/lib/DBIx/dbMan.pm
@@ -2,7 +2,7 @@ package DBIx::dbMan;
 
 =comment
 
-	dbMan 0.41
+	dbMan 0.42
 	(c) Copyright 1999-2017 by Milan Sorm, sorm@is4u.cz
 	All rights reserved.
 
@@ -15,302 +15,314 @@ package DBIx::dbMan;
 =cut
 
 use strict;
-use DBIx::dbMan::Config;	# configuration handling package
-use DBIx::dbMan::Lang;		# I18N package - EXPERIMENTAL
-use DBIx::dbMan::DBI;		# dbMan DBI interface package
-use DBIx::dbMan::MemPool;	# dbMan memory management system package
+use DBIx::dbMan::Config;     # configuration handling package
+use DBIx::dbMan::Lang;       # I18N package - EXPERIMENTAL
+use DBIx::dbMan::DBI;        # dbMan DBI interface package
+use DBIx::dbMan::MemPool;    # dbMan memory management system package
 use Data::Dumper;
 
-our $VERSION = '0.41';
+our $VERSION = '0.42';
 
 # constructor, arguments are hash of style -option => value, stored in internal attributes hash
 sub new {
-	my $class = shift;
-	my $obj = bless { @_ }, $class;
-	return $obj;
+    my $class = shift;
+    my $obj = bless { @_ }, $class;
+    return $obj;
 }
 
 # main loop of dbMan life-cycle, called from exe file
 sub start {
-	my $obj = shift;	# main dbMan core object
+    my $obj = shift;    # main dbMan core object
 
-	$obj->{-trace} = $ENV{DBMAN_TRACE} || 0; # standard extension tracing activity - DISABLED
+    $obj->{ -trace } = $ENV{ DBMAN_TRACE } || 0;    # standard extension tracing activity - DISABLED
 
-	# what interface exe file want ??? making package name from it
-	my $interface = $obj->{-interface};
-	$interface = 'DBIx/dbMan/Interface/'.$interface.'.pm';
+    # what interface exe file want ??? making package name from it
+    my $interface = $obj->{ -interface };
+    $interface = 'DBIx/dbMan/Interface/' . $interface . '.pm';
 
-	# we try to require interface package - found in @INC, syntax check,
-	# load it by require instead of use because we know only filename
-	eval { require $interface; };
-	if ($@) { 			# if something goes wrong
-		$interface =~ s/\//::/g;  $interface =~ s/\.pm$//;
+    # we try to require interface package - found in @INC, syntax check,
+    # load it by require instead of use because we know only filename
+    eval { require $interface; };
+    if ( $@ ) {    # if something goes wrong
+        $interface =~ s/\//::/g;
+        $interface =~ s/\.pm$//;
 
-		# bad information for user :-(
-		print STDERR "Can't locate interface module $interface\n";
-		return;		# see you later...
-	}
+        # bad information for user :-(
+        print STDERR "Can't locate interface module $interface\n";
+        return;    # see you later...
+    }
 
-	# making class name from interface package filename
-	$interface =~ s/\//::/g;  $interface =~ s/\.pm$//;
+    # making class name from interface package filename
+    $interface =~ s/\//::/g;
+    $interface =~ s/\.pm$//;
 
-	# creating memory management object - mempool
-	$obj->{mempool} = new DBIx::dbMan::MemPool;
+    # creating memory management object - mempool
+    $obj->{ mempool } = new DBIx::dbMan::MemPool;
 
-	# creating configuration object
-	$obj->{config} = new DBIx::dbMan::Config;
+    # creating configuration object
+    $obj->{ config } = new DBIx::dbMan::Config;
 
-	# creating I18N specifics object with configuration object as argument
-	$obj->{lang} = new DBIx::dbMan::Lang -config => $obj->{config};
+    # creating I18N specifics object with configuration object as argument
+    $obj->{ lang } = new DBIx::dbMan::Lang -config => $obj->{ config };
 
-	# creating loaded interface object, all objects as arguments
-	# included dbMan core object
-	$obj->{interface} = $interface->new(-config => $obj->{config},
-		-lang => $obj->{lang}, -mempool => $obj->{mempool}, -core => $obj);
+    # creating loaded interface object, all objects as arguments
+    # included dbMan core object
+    $obj->{ interface } = $interface->new(
+        -config => $obj->{ config },
+        -lang   => $obj->{ lang }, -mempool => $obj->{ mempool }, -core => $obj
+    );
 
-	# we have interface now, we can produce messages and errors by object
-	# method $obj->{interface}->print('what we can say to user...')
+    # we have interface now, we can produce messages and errors by object
+    # method $obj->{interface}->print('what we can say to user...')
 
-	# dbMan interface, please introduce us to our user (welcome message, splash etc.)
-	$obj->{interface}->hello();
+    # dbMan interface, please introduce us to our user (welcome message, splash etc.)
+    $obj->{ interface }->hello();
 
-	# creating dbMan DBI object - encapsulation of DBI with multiple connections
-	# support, configuration, interface and mempool as arguments
-	$obj->{dbi} = new DBIx::dbMan::DBI -config => $obj->{config},
-		-interface => $obj->{interface}, -mempool => $obj->{mempool};
+    # creating dbMan DBI object - encapsulation of DBI with multiple connections
+    # support, configuration, interface and mempool as arguments
+    $obj->{ dbi } = new DBIx::dbMan::DBI -config => $obj->{ config },
+        -interface => $obj->{ interface }, -mempool => $obj->{ mempool };
 
-	# looking for and loading all extensions
-	$obj->load_extensions;
+    # looking for and loading all extensions
+    $obj->load_extensions;
 
-	# we say to the interface that extensions are loaded and menu can be build
-	$obj->{interface}->rebuild_menu();
+    # we say to the interface that extensions are loaded and menu can be build
+    $obj->{ interface }->rebuild_menu();
 
-	# main loop derived by interface - get_action & handle_action calling cycle
-	# NOT CALLED if we are in $main::TEST mode (tested initialization from make test)
-	$obj->{interface}->loop() unless defined $main::TEST && $main::TEST;
+    # main loop derived by interface - get_action & handle_action calling cycle
+    # NOT CALLED if we are in $main::TEST mode (tested initialization from make test)
+    $obj->{ interface }->loop() unless defined $main::TEST && $main::TEST;
 
-	# unloading all loaded extensions
-	$obj->unload_extensions;
+    # unloading all loaded extensions
+    $obj->unload_extensions;
 
-	# close all opened DBI connections by dbMan DBI object
-	$obj->{dbi}->close_all();
+    # close all opened DBI connections by dbMan DBI object
+    $obj->{ dbi }->close_all();
 
-	# dbMan interface, please say good bye to our user...
-	$obj->{interface}->goodbye();
+    # dbMan interface, please say good bye to our user...
+    $obj->{ interface }->goodbye();
 
-	# test result OK if we are in $main::TEST mode (tested initialization from make test)
-	$main::TEST_RESULT = 1 if defined $main::TEST && $main::TEST;
+    # test result OK if we are in $main::TEST mode (tested initialization from make test)
+    $main::TEST_RESULT = 1 if defined $main::TEST && $main::TEST;
 
-	# program must correctly exit if we want 'test ok' for make test' tests
-	exit if $main::TEST_RESULT;
+    # program must correctly exit if we want 'test ok' for make test' tests
+    exit if $main::TEST_RESULT;
 }
 
 # looking for and loading extensions
 sub load_extensions {
-	my $obj = shift;		# main dbMan core object
-
-	$obj->{extensions} = [];	# currently loaded extensions = no extensions
-
-	# 1st phase : candidate searching algorithm
-	my %candidates = ();		# what are my candidates for extensions ?
-	for my $dir ($obj->extensions_directories) {	# all extensions directories
-		opendir D,$dir;				# search in directory
-		for (grep /\.pm$/,readdir D) { 		# for each found package
-			eval { require "$dir/$_"; };	# try to require
-			next if $@;			# not candidate if fail
-			s/\.pm$//;			# make class name from filename
-			my $candidate = "DBIx::dbMan::Extension::".$_;
-
-			# search for extension version limit (class method) - low and high
-			my ($low,$high) = ('',''); 
-			eval { ($low,$high) = $candidate->for_version(); };
-
-			# not candidate if our version isn't between low and high
-			# we must delete filename from include list
-			if (($low and $VERSION < $low) or ($high and $VERSION > $high)) 
-				{ delete $INC{"$dir/$_.pm"};  next; }
-
-			# fetching identification from extension (class method)
-			my $id = '';  eval { $id = $candidate->IDENTIFICATION(); };
-
-			# not candidate if identification not specified
-			unless ($id or $@) { delete $INC{"$dir/$_.pm"};  next; }
-
-			# parsing identification AUTHOR-MODULE-VERSION
-			my ($ident,$ver) = ($id =~ /^(.*)-(.*)$/);
-
-			# not candidate if AUTHOR-MODULE isn't overloaded
-			if ($ident eq '000001-000001') { delete $INC{"$dir/$_.pm"};  next; }
-
-			# deleting filename from include list
-			delete $INC{"$dir/$_.pm"};
-
-			# not candidate if exist this identification with same or higher version
-			next if exists $candidates{$ident} && $candidates{$ident}->{-ver} >= $ver;
-
-			# save candidate to candidates list
-			$candidates{$ident} = 
-				{ -file => "$dir/$_.pm", -candidate => $candidate, -ver => $ver }; 
-		};
-		
-		closedir D;			# close searched directory
-	}
-
-	# 2nd phase : candidate loading algorithm
-	my %extensions = ();			# all objects of extensions
-
-	$obj->{extension_iterator} = 0;		# randomize iterator
-	for my $candidate (keys %candidates) {	# for each candidate
-		my $ext = undef;		# undefined extension
-		eval {				# try require file and create object
-			require $candidates{$candidate}->{-file};
-
-			# object pass all five instances of base objects as argument
-			$ext = $candidates{$candidate}->{-candidate}->new(
-				-config => $obj->{config}, 
-				-interface => $obj->{interface},
-				-dbi => $obj->{dbi},
-				-core => $obj,
-				-mempool => $obj->{mempool});
-
-			die unless $ext->load_ok();
-		};
-		if (defined $ext and not $@) {	# successful loading ?
-			my $preference = 0;	# standard preference level
-			eval { $preference = $ext->preference(); }; # trying to fetch preference
-
-			# sorting criteria are: preference, random iterator
-			# saving sort criteria for later using
-			$ext->{'___sort_criteria___'} = $preference.'_'.$obj->{extension_iterator};
-
-			# save instance of object to hash indexed by preference
-			$extensions{$preference.'_'.$obj->{extension_iterator}} = $ext;
-
-			++$obj->{extension_iterator};	# increase random iterator
-		}
-	}
-
-	# 3rd phase : building candidates list sorted by preference (for action handling)
-	for (sort { 	# sorting criteria - first time by preference, second time loading order
-			my ($fa,$sa,$fb,$sb) = split /_/,$a.'_'.$b; 
-			($fa == $fb)?($sa <=> $sb):($fb <=> $fa);
-		} keys %extensions) {		# for all loaded extensions
-
-		# save extension into sorted list
-		push @{$obj->{extensions}},$extensions{$_};
-
-		# call init() for initializing extension (all extensions in correct order)
-		$extensions{$_}->init();
-	}
-
-	# all extensions are loaded and sorted by preference into $obj->{extensions} list
+    my $obj = shift;    # main dbMan core object
+
+    $obj->{ extensions } = [];    # currently loaded extensions = no extensions
+
+    # 1st phase : candidate searching algorithm
+    my %candidates = ();          # what are my candidates for extensions ?
+    for my $dir ( $obj->extensions_directories ) {    # all extensions directories
+        opendir D, $dir;                              # search in directory
+        for ( grep /\.pm$/, readdir D ) {             # for each found package
+            eval { require "$dir/$_"; };              # try to require
+            next if $@;                               # not candidate if fail
+            s/\.pm$//;                                # make class name from filename
+            my $candidate = "DBIx::dbMan::Extension::" . $_;
+
+            # search for extension version limit (class method) - low and high
+            my ( $low, $high ) = ( '', '' );
+            eval { ( $low, $high ) = $candidate->for_version(); };
+
+            # not candidate if our version isn't between low and high
+            # we must delete filename from include list
+            if ( ( $low and $VERSION < $low ) or ( $high and $VERSION > $high ) ) { delete $INC{ "$dir/$_.pm" }; next; }
+
+            # fetching identification from extension (class method)
+            my $id = '';
+            eval { $id = $candidate->IDENTIFICATION(); };
+
+            # not candidate if identification not specified
+            unless ( $id or $@ ) { delete $INC{ "$dir/$_.pm" }; next; }
+
+            # parsing identification AUTHOR-MODULE-VERSION
+            my ( $ident, $ver ) = ( $id =~ /^(.*)-(.*)$/ );
+
+            # not candidate if AUTHOR-MODULE isn't overloaded
+            if ( $ident eq '000001-000001' ) { delete $INC{ "$dir/$_.pm" }; next; }
+
+            # deleting filename from include list
+            delete $INC{ "$dir/$_.pm" };
+
+            # not candidate if exist this identification with same or higher version
+            next if exists $candidates{ $ident } && $candidates{ $ident }->{ -ver } >= $ver;
+
+            # save candidate to candidates list
+            $candidates{ $ident } = { -file => "$dir/$_.pm", -candidate => $candidate, -ver => $ver };
+        }
+
+        closedir D;    # close searched directory
+    }
+
+    # 2nd phase : candidate loading algorithm
+    my %extensions = ();    # all objects of extensions
+
+    $obj->{ extension_iterator } = 0;    # randomize iterator
+    for my $candidate ( keys %candidates ) {    # for each candidate
+        my $ext = undef;                        # undefined extension
+        eval {                                  # try require file and create object
+            require $candidates{ $candidate }->{ -file };
+
+            # object pass all five instances of base objects as argument
+            $ext = $candidates{ $candidate }->{ -candidate }->new(
+                -config    => $obj->{ config },
+                -interface => $obj->{ interface },
+                -dbi       => $obj->{ dbi },
+                -core      => $obj,
+                -mempool   => $obj->{ mempool }
+            );
+
+            die unless $ext->load_ok();
+        };
+        if ( defined $ext and not $@ ) {    # successful loading ?
+            my $preference = 0;             # standard preference level
+            eval { $preference = $ext->preference(); };    # trying to fetch preference
+
+            # sorting criteria are: preference, random iterator
+            # saving sort criteria for later using
+            $ext->{ '___sort_criteria___' } = $preference . '_' . $obj->{ extension_iterator };
+
+            # save instance of object to hash indexed by preference
+            $extensions{ $preference . '_' . $obj->{ extension_iterator } } = $ext;
+
+            ++$obj->{ extension_iterator };    # increase random iterator
+        }
+    }
+
+    # 3rd phase : building candidates list sorted by preference (for action handling)
+    for (
+        sort {                                 # sorting criteria - first time by preference, second time loading order
+            my ( $fa, $sa, $fb, $sb ) = split /_/, $a . '_' . $b;
+            ( $fa == $fb ) ? ( $sa <=> $sb ) : ( $fb <=> $fa );
+        } keys %extensions
+        ) {                                    # for all loaded extensions
+
+        # save extension into sorted list
+        push @{ $obj->{ extensions } }, $extensions{ $_ };
+
+        # call init() for initializing extension (all extensions in correct order)
+        $extensions{ $_ }->init();
+    }
+
+    # all extensions are loaded and sorted by preference into $obj->{extensions} list
 }
 
 # unloading all extensions
 sub unload_extensions {
-	my $obj = shift;		# main dbMan core object
+    my $obj = shift;    # main dbMan core object
 
-	for (@{$obj->{extensions}}) {	# for all extensions in standard order
-		$_->done();		# call done() for finalizing extension
-		undef $_; 		# destroy extension instance of object
-	}
+    for ( @{ $obj->{ extensions } } ) {    # for all extensions in standard order
+        $_->done();                        # call done() for finalizing extension
+        undef $_;                          # destroy extension instance of object
+    }
 }
 
 # produce list of all extensions directories
 sub extensions_directories {
-	my $obj = shift;		# main dbMan core object
+    my $obj = shift;                       # main dbMan core object
 
-	# grep criteria - only directories which contains DBIx/dbMan/Extension subfolder are wanted
-	# tested dirs are: @INC, extensions_dir configuration directive, current folder
-	# WARNING: i must call extensions_dir in list context if I want list of directories
-	return grep { -d $_ } map { my $t = $_;  $t =~ s/\/$//; "$t/DBIx/dbMan/Extension" } 
-		(@INC,($obj->{config}->extensions_dir?($obj->{config}->extensions_dir):()),'.');
+    # grep criteria - only directories which contains DBIx/dbMan/Extension subfolder are wanted
+    # tested dirs are: @INC, extensions_dir configuration directive, current folder
+    # WARNING: i must call extensions_dir in list context if I want list of directories
+    return grep { -d $_ } map { my $t = $_; $t =~ s/\/$//; "$t/DBIx/dbMan/Extension" } ( @INC, ( $obj->{ config }->extensions_dir ? ( $obj->{ config }->extensions_dir ) : () ), '.' );
 }
 
 # show tracing record via interface object
 sub trace {
-	my ($obj,$direction,$where,%action) = @_;	# main dbMan core object,
-	# direction string (passed to interface), extension object and action record
-
-	# change $where to readable form
-	$where =~ s/=.*$//;  $where =~ s/^DBIx::dbMan::Extension:://;  my $params = '';
-	for (sort keys %action) {	# for all actions
-		next if $_ eq 'action';	# action tag ignore
-		my $p = $action{$_};  $p = "'$p'" if $p !~ /^[-a-z0-9_.]+$/i;	# stringify
-		$params .= ", " if $params;  $params .= "$_: $p";	# concat
-	}
-
-	# change non-selected chars in $params to <hexa> style
-	$params = join '',		# joining transformed chars
-		map { ($_ >= 32 && $_ <= 254 && $_ != 127)?chr:sprintf "<%02x>",$_; }
-		unpack "C*",$params;		# disassemble $params into chars
-
-	# sending tracing report via interface object
-	$obj->{interface}->trace("$direction $where / $action{action} / $params\n");
+    my ( $obj, $direction, $where, %action ) = @_;    # main dbMan core object,
+                                                      # direction string (passed to interface), extension object and action record
+
+    # change $where to readable form
+    $where =~ s/=.*$//;
+    $where =~ s/^DBIx::dbMan::Extension:://;
+    my $params = '';
+    for ( sort keys %action ) {                       # for all actions
+        next if $_ eq 'action';                       # action tag ignore
+        my $p = $action{ $_ };
+        $p = "'$p'" if $p !~ /^[-a-z0-9_.]+$/i;       # stringify
+        $params .= ", " if $params;
+        $params .= "$_: $p";                          # concat
+    }
+
+    # change non-selected chars in $params to <hexa> style
+    $params = join '',                                # joining transformed chars
+        map { ( $_ >= 32 && $_ <= 254 && $_ != 127 ) ? chr : sprintf "<%02x>", $_; } unpack "C*", $params;    # disassemble $params into chars
+
+    # sending tracing report via interface object
+    $obj->{ interface }->trace( "$direction $where / $action{action} / $params\n" );
 }
 
 # main loop for handling one action
 sub handle_action {
-	my ($obj, %action) = @_;		# main dbMan core object, action to process
-
-	$action{processed} = undef;		# save signature of old action for deep recursion test
-	my $oldaction = \%action;
-	
-	for my $ext (@{$obj->{extensions}}) {	# going down through all extensions in preference order
-		$action{processed} = 1;
-		last if $action{action} eq 'NONE';	# stop on NONE actions
-
-		my $acts = undef;
-		eval { $acts = $ext->known_actions; };	# hack - which actions extension want ???
-		next if $@ || (defined $acts && ref $acts eq 'ARRAY' && 
-				! grep { $_ eq $action{action} } @$acts);   # use hacked knowledge
-
-		$obj->trace("<==",$ext,%action) if $obj->{-trace};	# trace if user want
-
-		$action{processed} = undef;		# standard behaviour - action not processed
-		eval { %action = $ext->handle_action(%action); };	# handling action
-		if ($@) { # error - exception
-			$obj->{interface}->print("Exception catched: $@\n");
-			$action{processed} = 1;
-			$action{action} = 'NONE';
-		}
-
-		$obj->trace("==>",$ext,%action) if $obj->{-trace};	# trace if user want
-
-		last unless $action{processed};		# action wasn't processed corectly 
-			# ... prefix probably set - return to get_event (and called once again we hope)
-	}
-
-	$obj->{-deep_detected} = 0;
-
-	# deep recursion detection
-	unless ($action{processed}) {
-		my $newaction = \%action;
-		if ($obj->compare_struct($oldaction,$newaction)) {
-			if ($obj->{-deep_detected} >= 100) {
-				$obj->trace("Deep recursion detected...\n",'- new:',%action);
-				$obj->trace("",'- old:',%$oldaction);
-				$action{processed} = 1;
-			} else {
-				++$obj->{-deep_detected};
-			}
-		}
-	}
-
-	# action processed correctly, good bye with modified action record
-	return %action;
+    my ( $obj, %action ) = @_;                                                                                # main dbMan core object, action to process
+
+    $action{ processed } = undef;                                                                             # save signature of old action for deep recursion test
+    my $oldaction = \%action;
+
+    for my $ext ( @{ $obj->{ extensions } } ) {                                                               # going down through all extensions in preference order
+        $action{ processed } = 1;
+        last if $action{ action } eq 'NONE';                                                                  # stop on NONE actions
+
+        my $acts = undef;
+        eval { $acts = $ext->known_actions; };                                                                # hack - which actions extension want ???
+        next
+            if $@
+            || ( defined $acts
+            && ref $acts eq 'ARRAY'
+            && ! grep { $_ eq $action{ action } } @$acts );                                                   # use hacked knowledge
+
+        $obj->trace( "<==", $ext, %action ) if $obj->{ -trace };                                              # trace if user want
+
+        $action{ processed } = undef;                                                                         # standard behaviour - action not processed
+        eval { %action = $ext->handle_action( %action ); };                                                   # handling action
+        if ( $@ ) {                                                                                           # error - exception
+            $obj->{ interface }->print( "Exception catched: $@\n" );
+            $action{ processed } = 1;
+            $action{ action }    = 'NONE';
+        }
+
+        $obj->trace( "==>", $ext, %action ) if $obj->{ -trace };                                              # trace if user want
+
+        last unless $action{ processed };                                                                     # action wasn't processed corectly
+                                                                                                              # ... prefix probably set - return to get_event (and called once again we hope)
+    }
+
+    $obj->{ -deep_detected } = 0;
+
+    # deep recursion detection
+    unless ( $action{ processed } ) {
+        my $newaction = \%action;
+        if ( $obj->compare_struct( $oldaction, $newaction ) ) {
+            if ( $obj->{ -deep_detected } >= 100 ) {
+                $obj->trace( "Deep recursion detected...\n", '- new:', %action );
+                $obj->trace( "",                             '- old:', %$oldaction );
+                $action{ processed } = 1;
+            }
+            else {
+                ++$obj->{ -deep_detected };
+            }
+        }
+    }
+
+    # action processed correctly, good bye with modified action record
+    return %action;
 }
 
 # return 1 if structs are identical
 sub compare_struct {
-	my $obj = shift;
-	my ($a,$b) = @_;
+    my $obj = shift;
+    my ( $a, $b ) = @_;
 
-	my $first = Data::Dumper->Dump([$a]);
-	my $second = Data::Dumper->Dump([$b]);
-	return $a eq $b;
+    my $first  = Data::Dumper->Dump( [ $a ] );
+    my $second = Data::Dumper->Dump( [ $b ] );
+    return $a eq $b;
 
-	return 0;
+    return 0;
 }
 
-1;	# all is O.K.
+1;    # all is O.K.
diff --git a/lib/DBIx/dbMan/DBI.pm b/lib/DBIx/dbMan/DBI.pm
index 1fa9aaf..1ed6db0 100644
--- a/lib/DBIx/dbMan/DBI.pm
+++ b/lib/DBIx/dbMan/DBI.pm
@@ -14,378 +14,393 @@ our $VERSION = '0.14';
 1;
 
 sub new {
-	my $class = shift;
-	my $obj = bless { @_ }, $class;
+    my $class = shift;
+    my $obj = bless { @_ }, $class;
 
-	$obj->clear_all_connections;
-	$obj->load_groups();
-	$obj->load_connections;
+    $obj->clear_all_connections;
+    $obj->load_groups();
+    $obj->load_connections;
 
-	return $obj;
+    return $obj;
 }
 
 sub connectiondir {
-	my $obj = shift;
+    my $obj = shift;
 
-	return $ENV{DBMAN_CONNECTIONDIR} if $ENV{DBMAN_CONNECTIONDIR};
+    return $ENV{ DBMAN_CONNECTIONDIR } if $ENV{ DBMAN_CONNECTIONDIR };
 
-	return $obj->{-config}->connection_dir if $obj->{-config}->connection_dir;
+    return $obj->{ -config }->connection_dir if $obj->{ -config }->connection_dir;
 
-	mkdir $ENV{HOME}.'/.dbman/connections' unless -d $ENV{HOME}.'/.dbman/connections';
+    mkdir $ENV{ HOME } . '/.dbman/connections' unless -d $ENV{ HOME } . '/.dbman/connections';
 
-	return $ENV{HOME}.'/.dbman/connections';
+    return $ENV{ HOME } . '/.dbman/connections';
 }
 
 sub groupdir {
-	my $obj = shift;
+    my $obj = shift;
 
-	return $ENV{DBMAN_GROUPDIR} if $ENV{DBMAN_GROUPDIR};
+    return $ENV{ DBMAN_GROUPDIR } if $ENV{ DBMAN_GROUPDIR };
 
-	mkdir $ENV{HOME}.'/.dbman/groups' unless -d $ENV{HOME}.'/.dbman/groups';
+    mkdir $ENV{ HOME } . '/.dbman/groups' unless -d $ENV{ HOME } . '/.dbman/groups';
 
-	return $ENV{HOME}.'/.dbman/groups';
+    return $ENV{ HOME } . '/.dbman/groups';
 }
 
 sub clear_all_connections {
-	my $obj = shift;
-	$obj->{connections} = {};
+    my $obj = shift;
+    $obj->{ connections } = {};
 }
 
 sub load_group {
-	my ($obj,$name) = @_;
+    my ( $obj, $name ) = @_;
 
-	my $gdir = $obj->groupdir();
-	return -1 unless -d $gdir;
-	$gdir =~ s/\/$//;
-	return -2 unless -f "$gdir/$name";
+    my $gdir = $obj->groupdir();
+    return -1 unless -d $gdir;
+    $gdir =~ s/\/$//;
+    return -2 unless -f "$gdir/$name";
 
-	return new DBIx::dbMan::Config -file => "$gdir/$name";
+    return new DBIx::dbMan::Config -file => "$gdir/$name";
 }
 
 sub load_groups {
-	my $obj = shift;
+    my $obj = shift;
 
-	my $sdir = $obj->groupdir;
-	my %groups = ();
+    my $sdir   = $obj->groupdir;
+    my %groups = ();
 
-	if (-d $sdir) {
-		opendir S,$sdir;
-		for my $group ( grep !/^\.\.?/, readdir S ) {
-			$groups{$group} = $obj->load_group($group);
-		}
-		closedir S;
-	}
+    if ( -d $sdir ) {
+        opendir S, $sdir;
+        for my $group ( grep ! /^\.\.?/, readdir S ) {
+            $groups{ $group } = $obj->load_group( $group );
+        }
+        closedir S;
+    }
 
-	$obj->{_groups} = \%groups;
+    $obj->{ _groups } = \%groups;
 }
 
 sub get_group {
-	my ($obj,$group) = @_;
+    my ( $obj, $group ) = @_;
 
-	return $obj->{_groups}->{$group};
+    return $obj->{ _groups }->{ $group };
 }
 
 sub load_connections {
-	my $obj = shift;
+    my $obj = shift;
 
-	my $cdir = $obj->connectiondir;
-	return -1 unless -d $cdir;
+    my $cdir = $obj->connectiondir;
+    return -1 unless -d $cdir;
 
-	opendir D,$cdir;
-	$obj->load_connection($_) for grep !/^\.\.?/,readdir D;
-	closedir D;
+    opendir D, $cdir;
+    $obj->load_connection( $_ ) for grep ! /^\.\.?/, readdir D;
+    closedir D;
 
-	my $current = '';
-	$current = $obj->{-config}->current_connection if $obj->{-config}->current_connection;
-	$obj->{-interface}->add_to_actionlist({ action => 'CONNECTION',
-		operation => 'use', what => $current });
+    my $current = '';
+    $current = $obj->{ -config }->current_connection if $obj->{ -config }->current_connection;
+    $obj->{ -interface }->add_to_actionlist(
+        {
+            action    => 'CONNECTION',
+            operation => 'use', what => $current
+        }
+    );
 }
 
 sub load_connection {
-	my ($obj,$name) = @_;
-
-	my $cdir = $obj->connectiondir;
-	return -1 unless -d $cdir;
-	$cdir =~ s/\/$//;
-	return -2 unless -f "$cdir/$name";
-
-	my $lcfg = new DBIx::dbMan::Config -file => "$cdir/$name";
-use Data::Dumper;
-print Dumper $lcfg;
-	while ($lcfg->group) {
-		for ( $lcfg->group() ) {
-			print STDERR "Error: Can't use group '$_' for connection '$name'\n" unless $lcfg->merge( $obj->get_group($_) );
-		}
-	}
-
-	my %connection;
-	$connection{$_} = $lcfg->$_ for $lcfg->all_tags;
-	$obj->{connections}->{$name} = \%connection;
-	
-	$obj->{-interface}->add_to_actionlist({ action => 'CONNECTION',
-		operation => 'open', what => $name }) if lc $lcfg->auto_login eq 'yes';
+    my ( $obj, $name ) = @_;
+
+    my $cdir = $obj->connectiondir;
+    return -1 unless -d $cdir;
+    $cdir =~ s/\/$//;
+    return -2 unless -f "$cdir/$name";
+
+    my $lcfg                = new DBIx::dbMan::Config -file => "$cdir/$name";
+    my %processed_groups    = ();
+    my $something_processed = 1;
+    while ( $something_processed ) {
+        $something_processed = 0;
+        for ( $lcfg->group() ) {
+            next if $processed_groups{ $_ };
+            ++$something_processed;
+            print STDERR "Error: Can't use group '$_' for connection '$name'\n" unless $lcfg->merge( $obj->get_group( $_ ) );
+            ++$processed_groups{ $_ };
+        }
+    }
+
+    my %connection;
+    $connection{ $_ } = $lcfg->$_ for $lcfg->all_tags;
+    $obj->{ connections }->{ $name } = \%connection;
+
+    $obj->{ -interface }->add_to_actionlist(
+        {
+            action    => 'CONNECTION',
+            operation => 'open', what => $name
+        }
+    ) if lc $lcfg->auto_login eq 'yes';
 }
 
 sub open {
-	my ($obj,$name) = @_;
+    my ( $obj, $name ) = @_;
 
-	return -3 unless exists $obj->{connections}->{$name};
-	return -4 if $obj->{connections}->{$name}->{-logged};
-	return -1 unless grep { $_ eq $obj->{connections}->{$name}->{driver} } $obj->driverlist;
+    return -3 unless exists $obj->{ connections }->{ $name };
+    return -4 if $obj->{ connections }->{ $name }->{ -logged };
+    return -1 unless grep { $_ eq $obj->{ connections }->{ $name }->{ driver } } $obj->driverlist;
 
-	my %vars = qw/PrintError 0 RaiseError 0 AutoCommit 1 LongTruncOk 1/;
-	if ( $obj->{connections}->{$name}->{config} ) {
-		for ( split /;\s*/, $obj->{connections}->{$name}->{config} ) {
-			if ( /^\s*(\S+?)\s*=\s*(\S+)\s*$/ ) {
-				my ( $var, $val ) = ( $1, $2 );
-				next if $var eq 'AutoCommit';		# everything unless transactions
-				$val = eval $val if $val =~ /^\[(.*)\]$/ || $val =~ /^\{(.*)\}$/;
-				$vars{ $var } = $val;
-			}
-		}
-	}
+    my %vars = qw/PrintError 0 RaiseError 0 AutoCommit 1 LongTruncOk 1/;
+    if ( $obj->{ connections }->{ $name }->{ config } ) {
+        for ( split /;\s*/, $obj->{ connections }->{ $name }->{ config } ) {
+            if ( /^\s*(\S+?)\s*=\s*(\S+)\s*$/ ) {
+                my ( $var, $val ) = ( $1, $2 );
+                next if $var eq 'AutoCommit';    # everything unless transactions
+                $val = eval $val if $val =~ /^\[(.*)\]$/ || $val =~ /^\{(.*)\}$/;
+                $vars{ $var } = $val;
+            }
+        }
+    }
 
-	my $dbi = DBI->connect('dbi:'.$obj->{connections}->{$name}->{driver}.
-		':'.$obj->{connections}->{$name}->{dsn},
-		$obj->{connections}->{$name}->{login},
-		$obj->{connections}->{$name}->{password},
-		\%vars );
+    my $dbi = DBI->connect(
+        'dbi:' . $obj->{ connections }->{ $name }->{ driver } . ':' . $obj->{ connections }->{ $name }->{ dsn },
+        $obj->{ connections }->{ $name }->{ login },
+        $obj->{ connections }->{ $name }->{ password },
+        \%vars
+    );
 
-	return -2 unless defined $dbi;
+    return -2 unless defined $dbi;
 
-	$obj->{connections}->{$name}->{-dbi} = $dbi;
-	$obj->{connections}->{$name}->{-mempool} = new DBIx::dbMan::MemPool;
-	$obj->{connections}->{$name}->{-logged} = 1;
-	$obj->{-interface}->add_to_actionlist({ action => 'AUTO_SQL', connection => $name });
+    $obj->{ connections }->{ $name }->{ -dbi }     = $dbi;
+    $obj->{ connections }->{ $name }->{ -mempool } = new DBIx::dbMan::MemPool;
+    $obj->{ connections }->{ $name }->{ -logged }  = 1;
+    $obj->{ -interface }->add_to_actionlist( { action => 'AUTO_SQL', connection => $name } );
 
-	return 0;
+    return 0;
 }
 
 sub driverlist {
-	my $obj = shift;
-	return DBI->available_drivers;
+    my $obj = shift;
+    return DBI->available_drivers;
 }
 
 sub close {
-	my ($obj,$name) = @_;
+    my ( $obj, $name ) = @_;
 
-	return -1 unless exists $obj->{connections}->{$name};
-	return -2 unless $obj->{connections}->{$name}->{-logged};
+    return -1 unless exists $obj->{ connections }->{ $name };
+    return -2 unless $obj->{ connections }->{ $name }->{ -logged };
 
-	$obj->set_current() if $obj->{current} eq $name;
-	$obj->discard_profile_data();
-	delete $obj->{connections}->{$name}->{-logged};
-	$obj->{connections}->{$name}->{-dbi}->disconnect();
-	undef $obj->{connections}->{$name}->{-dbi};
-	undef $obj->{connections}->{$name}->{-mempool};
+    $obj->set_current() if $obj->{ current } eq $name;
+    $obj->discard_profile_data();
+    delete $obj->{ connections }->{ $name }->{ -logged };
+    $obj->{ connections }->{ $name }->{ -dbi }->disconnect();
+    undef $obj->{ connections }->{ $name }->{ -dbi };
+    undef $obj->{ connections }->{ $name }->{ -mempool };
 
-	return 0;
+    return 0;
 }
 
 sub close_all {
-	my $obj = shift;
-	for my $name (keys %{$obj->{connections}}) {
-		if ($obj->{connections}->{$name}->{-logged}) {
-			$obj->close($name);
-                	$obj->{-interface}->print("Disconnected from $name.\n");
-			# we can't move this message to extension - close_all called when
-			# destroying DBI object (handle event collapsed :(, no OUTPUT event exist)
-		}
-	}
+    my $obj = shift;
+    for my $name ( keys %{ $obj->{ connections } } ) {
+        if ( $obj->{ connections }->{ $name }->{ -logged } ) {
+            $obj->close( $name );
+            $obj->{ -interface }->print( "Disconnected from $name.\n" );
+
+            # we can't move this message to extension - close_all called when
+            # destroying DBI object (handle event collapsed :(, no OUTPUT event exist)
+        }
+    }
 }
 
 sub DESTROY {
-	my $obj = shift;
-	$obj->close_all;
+    my $obj = shift;
+    $obj->close_all;
 }
 
 sub list {
-	my ($obj,$what) = @_;
-	my @returned = ();
+    my ( $obj, $what ) = @_;
+    my @returned = ();
 
-	for my $name (keys %{$obj->{connections}}) {
-		my %r = %{$obj->{connections}->{$name}};
-		next if ($what eq 'inactive' and $r{-logged}) || ($what eq 'active' and ! $r{-logged});
-		$r{name} = $name;
-		push @returned, \%r;
-	}
+    for my $name ( keys %{ $obj->{ connections } } ) {
+        my %r = %{ $obj->{ connections }->{ $name } };
+        next if ( $what eq 'inactive' and $r{ -logged } ) || ( $what eq 'active' and ! $r{ -logged } );
+        $r{ name } = $name;
+        push @returned, \%r;
+    }
 
-	return [ sort { $a->{name} cmp $b->{name} } @returned ];
+    return [ sort { $a->{ name } cmp $b->{ name } } @returned ];
 }
 
 sub autosql {
-	my $obj = shift;
+    my $obj = shift;
 
-	return -1 unless $obj->{current};
-	return -2 unless exists $obj->{connections}->{$obj->{current}};
-	return $obj->{connections}->{$obj->{current}}->{autosql};
+    return -1 unless $obj->{ current };
+    return -2 unless exists $obj->{ connections }->{ $obj->{ current } };
+    return $obj->{ connections }->{ $obj->{ current } }->{ autosql };
 }
 
 sub silent_autosql {
-	my $obj = shift;
+    my $obj = shift;
 
-	return -1 unless $obj->{current};
-	return -2 unless exists $obj->{connections}->{$obj->{current}};
-	return $obj->{connections}->{$obj->{current}}->{silent_autosql};
+    return -1 unless $obj->{ current };
+    return -2 unless exists $obj->{ connections }->{ $obj->{ current } };
+    return $obj->{ connections }->{ $obj->{ current } }->{ silent_autosql };
 }
 
 sub set_current {
-	my ($obj,$name) = @_;
+    my ( $obj, $name ) = @_;
 
-	return 9999 if $obj->{current} eq $name;
+    return 9999 if $obj->{ current } eq $name;
 
-	unless ($name) { delete $obj->{current};  return 1; }
+    unless ( $name ) { delete $obj->{ current }; return 1; }
 
-	return -1 unless exists $obj->{connections}->{$name};
-	return -2 unless $obj->{connections}->{$name}->{-logged};
+    return -1 unless exists $obj->{ connections }->{ $name };
+    return -2 unless $obj->{ connections }->{ $name }->{ -logged };
 
-	$obj->{current} = $name;
-	return 0;
+    $obj->{ current } = $name;
+    return 0;
 }
 
 sub current {
-	my $obj = shift;
-	return $obj->{current};
+    my $obj = shift;
+    return $obj->{ current };
 }
 
 sub drop_connection {
-	my ($obj,$name) = @_;
-	return -1 unless exists $obj->{connections}->{$name};
-	$obj->close($name) if $obj->{connections}->{$name}->{-logged};
-	delete $obj->{connections}->{$name};
-	return 0;
+    my ( $obj, $name ) = @_;
+    return -1 unless exists $obj->{ connections }->{ $name };
+    $obj->close( $name ) if $obj->{ connections }->{ $name }->{ -logged };
+    delete $obj->{ connections }->{ $name };
+    return 0;
 }
 
 sub create_connection {
-	my ($obj,$name,$p) = @_;
-	my %parms = %$p;
+    my ( $obj, $name, $p ) = @_;
+    my %parms = %$p;
 
-	return -1 if exists $obj->{connections}->{$name};
+    return -1 if exists $obj->{ connections }->{ $name };
 
-	$obj->{connections}->{$name} = \%parms;
-	return 100+$obj->open($name) if lc $parms{auto_login} eq 'yes';
-	return 0;
+    $obj->{ connections }->{ $name } = \%parms;
+    return 100 + $obj->open( $name ) if lc $parms{ auto_login } eq 'yes';
+    return 0;
 }
 
 sub save_connection {
-	my $obj = shift;
-	my $name = shift;
-	
-	return -1 unless exists $obj->{connections}->{$name};
-
-	my $cdir = $obj->connectiondir;
-	mkdir $cdir unless -d $cdir;
-	return -1 unless -d $cdir;
-	$cdir =~ s/\/$//;
-	CORE::open F,">$cdir/$name" or return -2;
-	for (qw/driver dsn login password auto_login config/) {
-		print F "$_ ".$obj->{connections}->{$name}->{$_}."\n"
-			if exists $obj->{connections}->{$name}->{$_}
-				and $obj->{connections}->{$name}->{$_} ne '';
-	}	
-	CORE::close F;
-	chmod 0600,"$cdir/$name";
-	return 0;
+    my $obj  = shift;
+    my $name = shift;
+
+    return -1 unless exists $obj->{ connections }->{ $name };
+
+    my $cdir = $obj->connectiondir;
+    mkdir $cdir unless -d $cdir;
+    return -1   unless -d $cdir;
+    $cdir =~ s/\/$//;
+    CORE::open F, ">$cdir/$name" or return -2;
+    for ( qw/driver dsn login password auto_login config/ ) {
+        print F "$_ " . $obj->{ connections }->{ $name }->{ $_ } . "\n"
+            if exists $obj->{ connections }->{ $name }->{ $_ }
+            and $obj->{ connections }->{ $name }->{ $_ } ne '';
+    }
+    CORE::close F;
+    chmod 0600, "$cdir/$name";
+    return 0;
 }
 
 sub destroy_connection {
-	my $obj = shift;
-	my $name = shift;
-	
-	my $cdir = $obj->connectiondir;
-	return -1 unless -d $cdir;
-	$cdir =~ s/\/$//;
-	return 1 unless -e "$cdir/$name";
-	unlink "$cdir/$name";
-	return -2 if -e "$cdir/$name";
-	return 0;
+    my $obj  = shift;
+    my $name = shift;
+
+    my $cdir = $obj->connectiondir;
+    return -1 unless -d $cdir;
+    $cdir =~ s/\/$//;
+    return 1 unless -e "$cdir/$name";
+    unlink "$cdir/$name";
+    return -2 if -e "$cdir/$name";
+    return 0;
 }
 
 sub is_permanent_connection {
-	my $obj = shift;
-	my $name = shift;
-	my $cdir = $obj->connectiondir;
-	return 0 unless -d $cdir;
-	$cdir =~ s/\/$//;
-	return -e "$cdir/$name";
+    my $obj  = shift;
+    my $name = shift;
+    my $cdir = $obj->connectiondir;
+    return 0 unless -d $cdir;
+    $cdir =~ s/\/$//;
+    return -e "$cdir/$name";
 }
 
 sub trans_begin {
-	my $obj = shift;
-	return -1 unless $obj->{current};
-	$obj->{connections}->{$obj->{current}}->{-dbi}->{AutoCommit} = 0;
+    my $obj = shift;
+    return -1 unless $obj->{ current };
+    $obj->{ connections }->{ $obj->{ current } }->{ -dbi }->{ AutoCommit } = 0;
 }
 
 sub longreadlen {
-	my $obj = shift;
-	my $long = shift;
-	$obj->{connections}->{$obj->{current}}->{-dbi}->{LongReadLen} = $long if $long;
-	return $obj->{connections}->{$obj->{current}}->{-dbi}->{LongReadLen};
+    my $obj  = shift;
+    my $long = shift;
+    $obj->{ connections }->{ $obj->{ current } }->{ -dbi }->{ LongReadLen } = $long if $long;
+    return $obj->{ connections }->{ $obj->{ current } }->{ -dbi }->{ LongReadLen };
 }
 
 sub trans_end {
-	my $obj = shift;
-	return -1 unless $obj->{current};
-	$obj->{connections}->{$obj->{current}}->{-dbi}->{AutoCommit} = 1;
+    my $obj = shift;
+    return -1 unless $obj->{ current };
+    $obj->{ connections }->{ $obj->{ current } }->{ -dbi }->{ AutoCommit } = 1;
 }
 
 sub in_transaction {
-	my $obj = shift;
-	return 0 unless $obj->{current};
-	return not $obj->{connections}->{$obj->{current}}->{-dbi}->{AutoCommit};
+    my $obj = shift;
+    return 0 unless $obj->{ current };
+    return not $obj->{ connections }->{ $obj->{ current } }->{ -dbi }->{ AutoCommit };
 }
 
 sub driver {
-	my $obj = shift;
-	return undef unless $obj->{current};
-	return $obj->{connections}->{$obj->{current}}->{driver};
+    my $obj = shift;
+    return undef unless $obj->{ current };
+    return $obj->{ connections }->{ $obj->{ current } }->{ driver };
 }
 
 sub login {
-	my $obj = shift;
-	return undef unless $obj->{current};
-	return $obj->{connections}->{$obj->{current}}->{login};
+    my $obj = shift;
+    return undef unless $obj->{ current };
+    return $obj->{ connections }->{ $obj->{ current } }->{ login };
 }
 
 sub prompt_color {
-	my $obj = shift;
-	return undef unless $obj->{current};
-	return $obj->{connections}->{$obj->{current}}->{prompt_color};
+    my $obj = shift;
+    return undef unless $obj->{ current };
+    return $obj->{ connections }->{ $obj->{ current } }->{ prompt_color };
 }
 
 sub AUTOLOAD {
-	my $obj = shift;
+    my $obj = shift;
 
-	$AUTOLOAD =~ s/^DBIx::dbMan::DBI:://g;
-	return undef unless $obj->{current};
-	return undef unless exists $obj->{connections}->{$obj->{current}};
-	return undef unless $obj->{connections}->{$obj->{current}}->{-logged};
-	return undef unless defined $obj->{connections}->{$obj->{current}}->{-dbi};
-	my $dbi = $obj->{connections}->{$obj->{current}}->{-dbi};
-	return $dbi->$AUTOLOAD(@_);
+    $AUTOLOAD =~ s/^DBIx::dbMan::DBI:://g;
+    return undef unless $obj->{ current };
+    return undef unless exists $obj->{ connections }->{ $obj->{ current } };
+    return undef unless $obj->{ connections }->{ $obj->{ current } }->{ -logged };
+    return undef unless defined $obj->{ connections }->{ $obj->{ current } }->{ -dbi };
+    my $dbi = $obj->{ connections }->{ $obj->{ current } }->{ -dbi };
+    return $dbi->$AUTOLOAD( @_ );
 }
 
 sub set {
-	my ($obj,$var,$val) = @_;
-	return unless $obj->{current};
+    my ( $obj, $var, $val ) = @_;
+    return unless $obj->{ current };
 
-	$obj->{connections}->{$obj->{current}}->{-dbi}->{$var} = $val;
+    $obj->{ connections }->{ $obj->{ current } }->{ -dbi }->{ $var } = $val;
 }
 
 sub get {
-	my ($obj,$var) = @_;
-	return undef unless $obj->{current};
-	return $obj->{connections}->{$obj->{current}}->{-dbi}->{$var};
+    my ( $obj, $var ) = @_;
+    return undef unless $obj->{ current };
+    return $obj->{ connections }->{ $obj->{ current } }->{ -dbi }->{ $var };
 }
 
 sub discard_profile_data {
-	my $obj = shift;
-	return unless $obj->{current};
-#	$obj->{connections}->{$obj->{current}}->{-dbi}->{Profile}->{Data} = undef;
+    my $obj = shift;
+    return unless $obj->{ current };
+
+    #	$obj->{connections}->{$obj->{current}}->{-dbi}->{Profile}->{Data} = undef;
 }
 
 sub mempool {
-	my $obj = shift;
-	return undef unless $obj->{current};
-	return $obj->{connections}->{$obj->{current}}->{-mempool};
+    my $obj = shift;
+    return undef unless $obj->{ current };
+    return $obj->{ connections }->{ $obj->{ current } }->{ -mempool };
 }