/[cvs]/nfo/perl/libs/Data/Storage/Handler/Abstract.pm
ViewVC logotype

Contents of /nfo/perl/libs/Data/Storage/Handler/Abstract.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Fri Nov 29 04:58:20 2002 UTC (21 years, 7 months ago) by joko
Branch: MAIN
Changes since 1.2: +78 -25 lines
+ Storage::Result now uses the same dispatching mechanism like Storage::Handler

1 #################################
2 #
3 # $Id: Abstract.pm,v 1.2 2002/10/17 00:08:07 joko Exp $
4 #
5 # $Log: Abstract.pm,v $
6 # Revision 1.2 2002/10/17 00:08:07 joko
7 # + bugfixes regarding "deep recursion" stuff
8 #
9 # Revision 1.1 2002/10/10 03:44:07 cvsjoko
10 # + new
11 #
12 #
13 #################################
14
15 package Data::Storage::Handler::Abstract;
16
17 use strict;
18 use warnings;
19
20 use Data::Dumper;
21
22 # get logger instance
23 my $logger = Log::Dispatch::Config->instance;
24
25 #our $lock_info;
26
27 sub new {
28 my $invocant = shift;
29 my $class = ref($invocant) || $invocant;
30
31 # logging info about the actual handler called
32 $logger->debug( "$invocant->new( @_ )" );
33 #$logger->debug( __PACKAGE__ . "->" . "new()" );
34
35 # arguments become properties
36 my $self = { @_ };
37 # create object from blessed hash-reference
38 bless $self, $class;
39
40 # handle meta data
41 #my $metainfo = $self->getMetaInfo($class);
42 my $metainfo = $self->getMetaInfo();
43 if (!$metainfo->{disconnectMethod}) { $metainfo->{disconnectMethod} = 'disconnect'; }
44 # type?
45 $invocant =~ s/Data::Storage::Handler:://;
46 $metainfo->{type} = $invocant;
47
48 # direct accessible (non-protected) properties ( was: my $self = { }; )
49 $self->{metainfo} = $metainfo;
50
51 return $self;
52 }
53
54
55 sub AUTOLOAD {
56
57 # recursion problem to be avoided here!!!
58
59 # - problem: we get recursion-hangs!!! => perl stops with ...
60 # "Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD" at [...]/libs/Data/Storage.pm line 38."
61
62 # - when: if we log to ourselves as a storage-implementation (e.g. via Log::Dispatch::Tangram)
63 # - why: debug-messages are on a very low level including every data-operation to "Data::Storage(::Handler::X)",
64 # so e.g. a "$storage->insert" would trigger another "$storage->insert" itself
65 # which leads to a infinite recursion loop (deep recursion)
66 # - solution: locks! (by Hack or (maybe) via Perl "local"s)
67
68 my $self = shift;
69
70 our $AUTOLOAD;
71 #return if $AUTOLOAD =~ m/::DESTROY$/;
72
73 # find out methodname
74 my $methodname = $AUTOLOAD;
75 $methodname =~ s/^.*:://;
76
77 # handle locking (hack)
78 if ($self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) {
79 $self->{lock_info}->{log_lock} = 1;
80 } else {
81 $self->{lock_info}->{log_lock} = 0;
82 }
83 $self->{lock_info}->{last_method} = $methodname;
84
85 # test for COREHANDLE
86 if (!$self->{COREHANDLE}) {
87 #print "no COREHANDLE", "\n";
88 if (!$self->{lock_info}->{log_lock}) {
89 $logger->error( __PACKAGE__ . "[$self->{metainfo}->{type}]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\"" );
90 }
91 return;
92 }
93
94 # try to dispatch method-call to Storage::Handler::*
95 #if ($self->can($methodname)) {
96 #$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->" . $methodname . "(@_)" );
97 #my $res = $self->$methodname(@_);
98 #if ($res) { return $res; }
99 #}
100
101 # try to dispatch method-call to COREHANDLE
102 if ($self->{COREHANDLE}->can($methodname) || $self->{COREHANDLE}->can("AUTOLOAD")) {
103 #$logger->debug( __PACKAGE__ . "->" . $methodname . " (AUTOLOAD)" );
104 #$lock_AUTOLOAD = 1 if ($methodname eq 'insert');
105 if (!$self->{lock_info}->{log_lock}) {
106 #print "method: $methodname", "\n";
107 $logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->" . $methodname . "(@_)" );
108 } else {
109 # AUTOLOAD - sub is locked to prevent deep recursions if (e.g.) db-inserts cause log-actions to same db itself
110 }
111 #$lock_AUTOLOAD = 0;
112 #$logger->log( level => 'debug', message => __PACKAGE__ . "->" . $methodname . " (AUTOLOAD)" );
113
114 # method calls doing it until here will get dispatched to the proper handler
115 return $self->{COREHANDLE}->$methodname(@_);
116 }
117
118 }
119
120 sub DESTROY {
121 my $self = shift;
122 if ($self->{COREHANDLE}) {
123 $logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" );
124
125 my $disconnectMethod = $self->{metainfo}->{disconnectMethod};
126
127 # call "disconnect" or alike on COREHANDLE
128 # was: $self->{COREHANDLE}->disconnect();
129 $disconnectMethod && ( $self->{COREHANDLE}->$disconnectMethod() );
130
131 undef $self->{COREHANDLE};
132 }
133 }
134
135
136 sub _abstract_function {
137 my $self = shift;
138 my $fName = shift;
139 my $class = ref($self);
140 $logger->error( __PACKAGE__ . ": function \"$fName\" is an abstract method, please implement it in \"$class\"");
141 #exit;
142 }
143
144 sub _typeCheck {
145 my $type = shift;
146 print "type: $type";
147 eval("use Data::Storage::$type;");
148 }
149
150
151 # ====================================================
152 # PUBLIC METHODS
153 # ====================================================
154
155 sub existsChildNode {
156 my $self = shift;
157 my $nodename = shift;
158 #$nodename = 'TransactionRoutingTable';
159 $logger->debug( __PACKAGE__ . "->getChildNode( nodename $nodename )" );
160 $self->getChildNodes() unless $self->{meta}->{childnodes};
161 my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}}); # TODO: use "/i" only on win32-systems!
162 return $result;
163 }
164
165 sub connect_tmp {
166
167 # my $self = shift;
168 # my $connectionString = shift;
169 # # todo: patch connectionString to $args
170 # _typeCheck($self->{args}{type});
171
172 }
173
174
175 # ====================================================
176 # CONCRETE METHOD DUMMIES (croaking via "$logger" by calling "_abstract_function")
177 # ====================================================
178
179 # TODO:
180 # - abstract "abstract methods" to list/hash to be used in AUTOLOAD
181 # e.g.: my @ABSTRACT_METHODS = (qw( connect sendCommand getChildNodes ));
182 # - build them via anonymous subs
183 # - introduce them via symbols
184
185 sub sendCommand {
186 my $self = shift;
187 $self->_abstract_function('sendCommand');
188 }
189
190 sub getChildNodes {
191 my $self = shift;
192 $self->_abstract_function('getChildNodes');
193 }
194
195 sub configureCOREHANDLE {
196 my $self = shift;
197 $self->_abstract_function('configureCOREHANDLE');
198 }
199
200 sub getMetaInfo {
201 my $self = shift;
202 $self->_abstract_function('getMetaInfo');
203 return;
204 }
205
206 sub getListUnfiltered {
207 my $self = shift;
208 $self->_abstract_function('getListUnfiltered');
209 return;
210 }
211
212 sub getListFiltered {
213 my $self = shift;
214 $self->_abstract_function('getListFiltered');
215 return;
216 }
217
218 sub sendQuery {
219 my $self = shift;
220 $self->_abstract_function('sendQuery');
221 return;
222 }
223
224 sub connect {
225 my $self = shift;
226 $self->_abstract_function('connect');
227 return;
228 }
229
230 sub testIntegrity {
231 my $self = shift;
232 $self->_abstract_function('testIntegrity');
233 return;
234 }
235
236 sub quoteSql {
237 my $self = shift;
238 $self->_abstract_function('quoteSql');
239 return;
240 }
241
242 1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed