1 |
## -------------------------------------------------------------------------------- |
## ------------------------------------------------------------------------ |
2 |
## $Id$ |
## $Id$ |
3 |
## -------------------------------------------------------------------------------- |
## ------------------------------------------------------------------------ |
4 |
## $Log$ |
## $Log$ |
5 |
|
## Revision 1.11 2003/01/20 16:43:18 joko |
6 |
|
## + better argument-property merging |
7 |
|
## + debugging-output !!! |
8 |
|
## + abstract-dummy 'sub createChildNode' |
9 |
|
## |
10 |
|
## Revision 1.10 2003/01/19 02:31:51 joko |
11 |
|
## + fix to 'sub AUTOLOAD' |
12 |
|
## |
13 |
|
## Revision 1.9 2002/12/19 16:30:23 joko |
14 |
|
## + added 'sub dropDb' and 'sub rebuildDb' as croakers for concrete implementations of methods in proper handlers |
15 |
|
## |
16 |
## Revision 1.8 2002/12/13 21:48:35 joko |
## Revision 1.8 2002/12/13 21:48:35 joko |
17 |
## + sub _abstract_function |
## + sub _abstract_function |
18 |
## |
## |
38 |
## |
## |
39 |
## Revision 1.1 2002/10/10 03:44:07 cvsjoko |
## Revision 1.1 2002/10/10 03:44:07 cvsjoko |
40 |
## + new |
## + new |
41 |
## -------------------------------------------------------------------------------- |
## ------------------------------------------------------------------------ |
42 |
|
|
43 |
|
|
44 |
package Data::Storage::Handler::Abstract; |
package Data::Storage::Handler::Abstract; |
48 |
|
|
49 |
use base qw( DesignPattern::Object ); |
use base qw( DesignPattern::Object ); |
50 |
|
|
51 |
|
|
52 |
use Data::Dumper; |
use Data::Dumper; |
53 |
use Tie::SecureHash; |
use Tie::SecureHash; |
54 |
#use Data::Storage::Handler; |
#use Data::Storage::Handler; |
55 |
|
use Data::Transform::Deep qw( merge ); |
56 |
|
|
57 |
|
|
58 |
# get logger instance |
# get logger instance |
59 |
my $logger = Log::Dispatch::Config->instance; |
my $logger = Log::Dispatch::Config->instance; |
76 |
bless $self, $class; |
bless $self, $class; |
77 |
=cut |
=cut |
78 |
|
|
79 |
|
#=pod |
80 |
# V2 - maybe more convenient/secure? utilizing Damian Conway's Tie::SecureHash... |
# V2 - maybe more convenient/secure? utilizing Damian Conway's Tie::SecureHash... |
81 |
my $self = Tie::SecureHash->new( |
my $self = Tie::SecureHash->new( |
82 |
$class, |
$class, |
100 |
#_protected => , |
#_protected => , |
101 |
#__private => , |
#__private => , |
102 |
); |
); |
103 |
|
#=cut |
104 |
|
|
105 |
# merge passed-in arguments to constructor as properties into already blessed secure object |
# merge passed-in arguments to constructor as properties into already blessed secure object |
106 |
|
|
107 |
# mungle arguments from array into hash - perl does the job ;) |
# mungle arguments from array into hash - perl does the job ;) |
108 |
my %args = @_; |
#my %args = @_; |
109 |
|
#my %args = (); |
110 |
|
|
111 |
|
#print Dumper(@_); |
112 |
|
|
113 |
# merge attributes one-by-one |
# merge attributes one-by-one |
114 |
# TODO: deep_copy? / merge_deep? |
# TODO: deep_copy? / merge_deep? |
115 |
foreach (keys %args) { |
while (my $elemName = shift @_) { |
116 |
#print "key: $_", "\n"; |
#print "elemName: $elemName", "\n"; |
117 |
$self->{$_} = $args{$_}; |
if (my $elemValue = shift @_) { |
118 |
|
#print Dumper($elemValue); |
119 |
|
#print "elemName=$elemName, elemValue=$elemValue", "\n"; |
120 |
|
$self->{$elemName} = $elemValue; |
121 |
|
} |
122 |
|
#$self->{$_} = $args{$_}; |
123 |
|
#$self->{$_} = $args{$_}; |
124 |
} |
} |
125 |
|
|
126 |
# V3 - rolling our own security (just for {COREHANDLE} - nothing else) - nope, Tie::SecureHash works wonderful |
# V3 - rolling our own security (just for {COREHANDLE} - nothing else) - nope, Tie::SecureHash works wonderful |
144 |
} |
} |
145 |
|
|
146 |
|
|
147 |
|
# TODO: use NEXT.pm inside this mechanism (to avoid repetitions...) |
148 |
sub AUTOLOAD { |
sub AUTOLOAD { |
149 |
|
|
150 |
# recursion problem to be avoided here!!! |
# recursion problem to be avoided here!!! |
175 |
# this is to prevent deep recursion's |
# this is to prevent deep recursion's |
176 |
return if lc $methodname eq 'exists'; |
return if lc $methodname eq 'exists'; |
177 |
|
|
178 |
#print "$methodname - 1", "\n"; |
print "$methodname - 1", "\n"; |
179 |
|
|
180 |
# TODO: enhance logging/debugging |
# TODO: enhance logging/debugging |
181 |
#if (!$self->exists('COREHANDLE')) { return; } |
#if (!$self->exists('COREHANDLE')) { return; } |
182 |
|
|
183 |
# handle locking (hack) |
# handle locking (hack) |
184 |
if ($self->exists('lock_info') && $self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) { |
if ($self->can('exists') && $self->exists('lock_info') && $self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) { |
185 |
$self->{lock_info}->{log_lock} = 1; |
$self->{lock_info}->{log_lock} = 1; |
186 |
} else { |
} else { |
187 |
$self->{lock_info}->{log_lock} = 0; |
$self->{lock_info}->{log_lock} = 0; |
188 |
} |
} |
189 |
$self->{lock_info}->{last_method} = $methodname; |
$self->{lock_info}->{last_method} = $methodname; |
190 |
|
|
191 |
#print "$methodname - 2", "\n"; |
print "$methodname - 2", "\n"; |
192 |
|
|
193 |
#print Dumper($self); |
#print Dumper($self); |
194 |
#exit; |
#exit; |
202 |
#if (!$self->exists('_COREHANDLE')) { |
#if (!$self->exists('_COREHANDLE')) { |
203 |
#if (!$self->{_COREHANDLE}) { |
#if (!$self->{_COREHANDLE}) { |
204 |
if (!$core) { |
if (!$core) { |
205 |
my $err_msg_core = __PACKAGE__ . "[$self->{metainfo}->{type}]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\""; |
|
206 |
|
#print Dumper($self); |
207 |
|
#exit; |
208 |
|
|
209 |
|
my $handlertype = $self->{metainfo}->{type}; |
210 |
|
$handlertype ||= ''; |
211 |
|
|
212 |
|
my $err_msg_core = __PACKAGE__ . "[$handlertype]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\""; |
213 |
print $err_msg_core, "\n"; |
print $err_msg_core, "\n"; |
214 |
if ($self->exists('lock_info') && !$self->{lock_info}->{log_lock}) { |
if ($self->exists('lock_info') && !$self->{lock_info}->{log_lock}) { |
215 |
$logger->error( $err_msg_core ); |
$logger->error( $err_msg_core ); |
255 |
|
|
256 |
#print "calling: $methodname", "\n"; |
#print "calling: $methodname", "\n"; |
257 |
|
|
258 |
# method calls doing it until here will get dispatched to the proper handler |
# method calls making it until here will get dispatched to the proper handler |
259 |
return $core->$methodname(@_); |
return $core->$methodname(@_); |
260 |
|
|
261 |
} elsif ($self->can($methodname)) { |
} elsif ($self->can($methodname)) { |
262 |
|
# try to call specified method inside our or inherited module(s) scope(s) |
263 |
return $self->$methodname(@_); |
return $self->$methodname(@_); |
264 |
} |
} |
265 |
|
|
296 |
my $self = shift; |
my $self = shift; |
297 |
my $nodename = shift; |
my $nodename = shift; |
298 |
#$nodename = 'TransactionRoutingTable'; |
#$nodename = 'TransactionRoutingTable'; |
299 |
$logger->debug( __PACKAGE__ . "->getChildNode( nodename $nodename )" ); |
$logger->debug( __PACKAGE__ . "->existsChildNode( nodename $nodename )" ); |
300 |
$self->getChildNodes() unless $self->{meta}->{childnodes}; |
$self->getChildNodes() unless $self->{meta}->{childnodes}; |
301 |
my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}}); # TODO: use "/i" only on win32-systems! |
my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}}); # TODO: use "/i" only on win32-systems! |
302 |
return $result; |
return $result; |
333 |
$self->_abstract_function('sendCommand'); |
$self->_abstract_function('sendCommand'); |
334 |
} |
} |
335 |
|
|
336 |
|
sub createChildNode { |
337 |
|
my $self = shift; |
338 |
|
$self->_abstract_function('createChildNode'); |
339 |
|
} |
340 |
|
|
341 |
sub existsChildNode_tmp { |
sub existsChildNode_tmp { |
342 |
my $self = shift; |
my $self = shift; |
343 |
$self->_abstract_function('existsChildNode'); |
$self->_abstract_function('existsChildNode'); |
407 |
return; |
return; |
408 |
} |
} |
409 |
|
|
410 |
|
sub dropDb { |
411 |
|
my $self = shift; |
412 |
|
$self->_abstract_function('dropDb'); |
413 |
|
return; |
414 |
|
} |
415 |
|
|
416 |
|
sub rebuildDb { |
417 |
|
my $self = shift; |
418 |
|
$self->_abstract_function('rebuildDb'); |
419 |
|
return; |
420 |
|
} |
421 |
|
|
422 |
1; |
1; |