libs/Data/Storage.pm

## ------------------------------------------------------------------------
##
##    $Id: Sync.pm,v 1.13 2003/01/19 01:23:03 joko Exp $
##
##    Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
##
##    See COPYRIGHT section in pod text below for usage and distribution rights.
##
## ------------------------------------------------------------------------
##
##  $Log: Storage.pm,v $
##  Revision 1.14  2002/12/19 16:27:59  joko
##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
##
##  Revision 1.13  2002/12/17 21:54:12  joko
##  + feature when using Tangram:
##    + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
##        + patched Tangram::Storage (jonen)
##        + enhanced Data::Storage::Schema::Tangram (joko)
##        + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
##    + how?
##        + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
##        + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
##        + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
##
##  Revision 1.12  2002/12/12 02:50:15  joko
##  + this now (unfortunately) needs DBI for some helper functions
##  + TODO: these have to be refactored to another scope! (soon!)
##
##  Revision 1.11  2002/12/11 06:53:19  joko
##  + updated pod
##
##  Revision 1.10  2002/12/07 03:37:23  joko
##  + updated pod
##
##  Revision 1.9  2002/12/01 22:15:45  joko
##  - sub createDb: moved to handler
##
##  Revision 1.8  2002/11/29 04:48:23  joko
##  + updated pod
##
##  Revision 1.7  2002/11/17 06:07:18  joko
##  + creating the handler is easier than proposed first - for now :-)
##  + sub testAvailability
##
##  Revision 1.6  2002/11/09 01:04:58  joko
##  + updated pod
##
##  Revision 1.5  2002/10/29 19:24:18  joko
##  - reduced logging
##  + added some pod
##
##  Revision 1.4  2002/10/27 18:35:07  joko
##  + added pod
##
##  Revision 1.3  2002/10/25 11:40:37  joko
##  + enhanced robustness
##  + more logging for debug-levels
##  + sub dropDb
##
##  Revision 1.2  2002/10/17 00:04:29  joko
##  + sub createDb
##  + sub isConnected
##  + bugfixes regarding "deep recursion" stuff
##
##  Revision 1.1  2002/10/10 03:43:12  cvsjoko
##  + new
## ------------------------------------------------------------------------


BEGIN {
  $Data::Storage::VERSION = 0.03;
}

package Data::Storage;

use strict;
use warnings;

use Data::Storage::Locator;
use Data::Dumper;

# TODO: wipe out!
use DBI;

# TODO: actually implement level (integrate with Log::Dispatch)
my $TRACELEVEL = 0;

# get logger instance
my $logger = Log::Dispatch::Config->instance;

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  #my @args = normalizeArgs(@_);

  my $arg_locator = shift;
  my $arg_options = shift;

  if (!$arg_locator) {
    $logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
    return;
  }

  #my $self = { STORAGEHANDLE => undef, @_ };
  my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
  #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
  $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
  return bless $self, $class;
}

sub AUTOLOAD {
  
  # since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
  # some sophisticated handling and filtering is needed to avoid things like
  #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
  #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
  #     - Deep recursion on anonymous subroutine at [...]
  # we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
  
  my $self = shift;
  our $AUTOLOAD;
  
  # ->DESTROY would - if not declared - trigger an AUTOLOAD also
  return if $AUTOLOAD =~ m/::DESTROY$/;

  my $method = $AUTOLOAD;
  $method =~ s/^.*:://;

  # advanced logging of AUTOLOAD calls ...
  # ... nice but do it only when TRACING (TODO) is enabled
    if ($TRACELEVEL) {
      my $logstring = "";
      $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
      #print "count: ", $#_, "\n";
      #$logstring .= Dumper(@_) if ($#_ != -1);
      my $tabcount = int( (80 - length($logstring)) / 10 );
      $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
      # TODO: only ok if logstring doesn't contain 
      #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
      # but that would be _way_ too specific as long as we don't have an abstract handler for this  ;)
      $logger->debug( $logstring );
      #print join('; ', @_);
    }
    
  # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
  if ($self->_filter_AUTOLOAD($method)) {
    #print "_accessStorage\n";
    $self->_accessStorage();
    return $self->{STORAGEHANDLE}->$method(@_);
  }
  
}

sub _filter_AUTOLOAD {
  my $self = shift;
  my $method = shift;
  if ($self->{options}->{protected}) {
    if ($method eq 'disconnect') {
      return;
    }
  }
  return 1;
}


sub normalizeArgs {
  my %args = @_;
  if (!$args{dsn} && $args{meta}{dsn}) {
    $args{dsn} = $args{meta}{dsn};
  }
  my @result = %args;
  return @result;
}

sub _accessStorage {
  my $self = shift;
  # TODO: to some tracelevel!
  if ($TRACELEVEL) {
    $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
  }
  if (!$self->{STORAGEHANDLE}) {
    $self->_createStorageHandle();
  }
}

sub _createStorageHandle {
  my $self = shift;
  my $type = $self->{locator}->{type};
  $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );

  my $pkg = "Data::Storage::Handler::" . $type . "";
  
  # try to load perl module at runtime
  my $evalstr = "use $pkg;";
  eval($evalstr);
  if ($@) {
    $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
    return;
  }
  
  # build up some additional arguments to pass on
  #my @args = %{$self->{locator}};
  my @args = ();

  # - create new storage handle object
  # - propagate arguments to handler
  # - pass locator by reference to be able to store status- or meta-information in it
  $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );

}

sub addLogDispatchHandler {

      my $self = shift;
      my $name = shift;
      my $package = shift;
      my $logger1 = shift;
      my $objectCreator = shift;
      
      #$logger->add( Log::Dispatch::Tangram->new( name => $name,
      $logger->add( $package->new( name => $name,
                                            #min_level => 'debug',
                                            min_level => 'info',
                                            storage => $self,
                                            objectCreator => $objectCreator,
                                            fields => {
                                              message => 'usermsg',
                                              timestamp => 'stamp',
                                              level => 'level',
                                              name => 'code',
                                            },
                                            filter_patterns => [ '->insert\(SystemEvent=' ],
                                            #filter_patterns => [ 'SystemEvent' ],
                                            
                                            #format  => '[%d] [%p] %m%n',
                                             ) );

}

sub removeLogDispatchHandler {
  my $self = shift;
  my $name = shift;
  #my $logger = shift;
  $logger->remove($name);
}

sub getDbName {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};
  $dsn =~ m/database=(.+?);/;
  my $database_name = $1;
  return $database_name;
}

sub testAvailability {
  my $self = shift;
  my $status = $self->testDsn();
  $self->{locator}->{status}->{available} = $status;
  return $status;
}

sub isConnected {
  my $self = shift;
  # TODO: REVIEW!
  return 1 if $self->{STORAGEHANDLE};
}

sub testDsn {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};
  my $result;
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    
    # TODO: REVIEW
    $dbh->disconnect();
    
    return 1;
  } else {
    $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
  }
}

1;
__END__
1	joko	1.15	## ------------------------------------------------------------------------
2			##
3			## $Id: Sync.pm,v 1.13 2003/01/19 01:23:03 joko Exp $
4			##
5			## Copyright (c) 2002 Andreas Motl <andreas.motl@ilo.de>
6			##
7			## See COPYRIGHT section in pod text below for usage and distribution rights.
8			##
9			## ------------------------------------------------------------------------
10			##
11			## $Log: Storage.pm,v $
12			## Revision 1.14 2002/12/19 16:27:59 joko
13			## - moved 'sub dropDb' to Data::Storage::Handler::DBI
14			##
15			## Revision 1.13 2002/12/17 21:54:12 joko
16			## + feature when using Tangram:
17			## + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
18			## + patched Tangram::Storage (jonen)
19			## + enhanced Data::Storage::Schema::Tangram (joko)
20			## + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
21			## + how?
22			## + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
23			## + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
24			## + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
25			##
26			## Revision 1.12 2002/12/12 02:50:15 joko
27			## + this now (unfortunately) needs DBI for some helper functions
28			## + TODO: these have to be refactored to another scope! (soon!)
29			##
30			## Revision 1.11 2002/12/11 06:53:19 joko
31			## + updated pod
32			##
33			## Revision 1.10 2002/12/07 03:37:23 joko
34			## + updated pod
35			##
36			## Revision 1.9 2002/12/01 22:15:45 joko
37			## - sub createDb: moved to handler
38			##
39			## Revision 1.8 2002/11/29 04:48:23 joko
40			## + updated pod
41			##
42			## Revision 1.7 2002/11/17 06:07:18 joko
43			## + creating the handler is easier than proposed first - for now :-)
44			## + sub testAvailability
45			##
46			## Revision 1.6 2002/11/09 01:04:58 joko
47			## + updated pod
48			##
49			## Revision 1.5 2002/10/29 19:24:18 joko
50			## - reduced logging
51			## + added some pod
52			##
53			## Revision 1.4 2002/10/27 18:35:07 joko
54			## + added pod
55			##
56			## Revision 1.3 2002/10/25 11:40:37 joko
57			## + enhanced robustness
58			## + more logging for debug-levels
59			## + sub dropDb
60			##
61			## Revision 1.2 2002/10/17 00:04:29 joko
62			## + sub createDb
63			## + sub isConnected
64			## + bugfixes regarding "deep recursion" stuff
65			##
66			## Revision 1.1 2002/10/10 03:43:12 cvsjoko
67			## + new
68			## ------------------------------------------------------------------------
69	cvsjoko	1.1
70	joko	1.3
71	joko	1.4	BEGIN {
72	joko	1.15	$Data::Storage::VERSION = 0.03;
73	joko	1.4	}
74
75	cvsjoko	1.1	package Data::Storage;
76
77			use strict;
78			use warnings;
79
80			use Data::Storage::Locator;
81	joko	1.7	use Data::Dumper;
82	cvsjoko	1.1
83	joko	1.12	# TODO: wipe out!
84			use DBI;
85
86	joko	1.6	# TODO: actually implement level (integrate with Log::Dispatch)
87	joko	1.5	my $TRACELEVEL = 0;
88
89	cvsjoko	1.1	# get logger instance
90			my $logger = Log::Dispatch::Config->instance;
91
92			sub new {
93			my $invocant = shift;
94			my $class = ref($invocant) \|\| $invocant;
95			#my @args = normalizeArgs(@_);
96	joko	1.7
97	cvsjoko	1.1	my $arg_locator = shift;
98			my $arg_options = shift;
99	joko	1.7
100	joko	1.15	if (!$arg_locator) {
101			$logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
102			return;
103			}
104
105	cvsjoko	1.1	#my $self = { STORAGEHANDLE => undef, @_ };
106			my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
107	joko	1.7	#$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
108			$logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
109	cvsjoko	1.1	return bless $self, $class;
110			}
111
112			sub AUTOLOAD {
113
114	joko	1.2	# since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
115			# some sophisticated handling and filtering is needed to avoid things like
116			# - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
117			# - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
118			# - Deep recursion on anonymous subroutine at [...]
119	joko	1.8	# we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
120	joko	1.2
121	cvsjoko	1.1	my $self = shift;
122			our $AUTOLOAD;
123
124			# ->DESTROY would - if not declared - trigger an AUTOLOAD also
125			return if $AUTOLOAD =~ m/::DESTROY$/;
126
127			my $method = $AUTOLOAD;
128			$method =~ s/^.*:://;
129
130	joko	1.5	# advanced logging of AUTOLOAD calls ...
131			# ... nice but do it only when TRACING (TODO) is enabled
132			if ($TRACELEVEL) {
133			my $logstring = "";
134			$logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
135			#print "count: ", $#_, "\n";
136			#$logstring .= Dumper(@_) if ($#_ != -1);
137			my $tabcount = int( (80 - length($logstring)) / 10 );
138			$logstring .= "\t" x $tabcount . "(AUTOLOAD)";
139			# TODO: only ok if logstring doesn't contain
140			# e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c)) (AUTOLOAD)"
141	joko	1.8	# but that would be _way_ too specific as long as we don't have an abstract handler for this ;)
142	joko	1.5	$logger->debug( $logstring );
143	joko	1.7	#print join('; ', @_);
144	joko	1.5	}
145
146	joko	1.8	# filtering AUTOLOAD calls and first-time-touch of the actual storage impl
147	cvsjoko	1.1	if ($self->_filter_AUTOLOAD($method)) {
148	joko	1.7	#print "_accessStorage\n";
149	cvsjoko	1.1	$self->_accessStorage();
150	joko	1.15	return $self->{STORAGEHANDLE}->$method(@_);
151	cvsjoko	1.1	}
152
153			}
154
155			sub _filter_AUTOLOAD {
156			my $self = shift;
157			my $method = shift;
158			if ($self->{options}->{protected}) {
159			if ($method eq 'disconnect') {
160			return;
161			}
162			}
163			return 1;
164			}
165
166
167			sub normalizeArgs {
168			my %args = @_;
169			if (!$args{dsn} && $args{meta}{dsn}) {
170			$args{dsn} = $args{meta}{dsn};
171			}
172			my @result = %args;
173			return @result;
174			}
175
176			sub _accessStorage {
177			my $self = shift;
178			# TODO: to some tracelevel!
179	joko	1.5	if ($TRACELEVEL) {
180			$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->_accessStorage()" );
181			}
182	cvsjoko	1.1	if (!$self->{STORAGEHANDLE}) {
183			$self->_createStorageHandle();
184			}
185			}
186
187			sub _createStorageHandle {
188			my $self = shift;
189			my $type = $self->{locator}->{type};
190			$logger->debug( __PACKAGE__ . "[$type]" . "->_createStorageHandle()" );
191
192			my $pkg = "Data::Storage::Handler::" . $type . "";
193
194	joko	1.7	# try to load perl module at runtime
195			my $evalstr = "use $pkg;";
196			eval($evalstr);
197			if ($@) {
198			$logger->error( __PACKAGE__ . "[$type]" . "->_createStorageHandle(): $@" );
199			return;
200	cvsjoko	1.1	}
201	joko	1.7
202			# build up some additional arguments to pass on
203			#my @args = %{$self->{locator}};
204			my @args = ();
205
206	joko	1.8	# - create new storage handle object
207			# - propagate arguments to handler
208			# - pass locator by reference to be able to store status- or meta-information in it
209	joko	1.7	$self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
210	joko	1.3
211	cvsjoko	1.1	}
212
213			sub addLogDispatchHandler {
214
215			my $self = shift;
216			my $name = shift;
217			my $package = shift;
218	joko	1.3	my $logger1 = shift;
219	cvsjoko	1.1	my $objectCreator = shift;
220
221			#$logger->add( Log::Dispatch::Tangram->new( name => $name,
222			$logger->add( $package->new( name => $name,
223			#min_level => 'debug',
224			min_level => 'info',
225			storage => $self,
226			objectCreator => $objectCreator,
227			fields => {
228			message => 'usermsg',
229			timestamp => 'stamp',
230			level => 'level',
231			name => 'code',
232			},
233			filter_patterns => [ '->insert\(SystemEvent=' ],
234			#filter_patterns => [ 'SystemEvent' ],
235
236			#format => '[%d] [%p] %m%n',
237			) );
238
239			}
240
241			sub removeLogDispatchHandler {
242	joko	1.8	my $self = shift;
243			my $name = shift;
244			#my $logger = shift;
245			$logger->remove($name);
246	cvsjoko	1.1	}
247
248			sub getDbName {
249			my $self = shift;
250			my $dsn = $self->{locator}->{dbi}->{dsn};
251			$dsn =~ m/database=(.+?);/;
252			my $database_name = $1;
253			return $database_name;
254			}
255
256	joko	1.12	sub testAvailability {
257			my $self = shift;
258			my $status = $self->testDsn();
259			$self->{locator}->{status}->{available} = $status;
260			return $status;
261			}
262
263			sub isConnected {
264			my $self = shift;
265			# TODO: REVIEW!
266			return 1 if $self->{STORAGEHANDLE};
267			}
268
269	cvsjoko	1.1	sub testDsn {
270			my $self = shift;
271			my $dsn = $self->{locator}->{dbi}->{dsn};
272			my $result;
273			if ( my $dbh = DBI->connect($dsn, '', '', {
274			PrintError => 0,
275			} ) ) {
276	joko	1.9
277			# TODO: REVIEW
278	cvsjoko	1.1	$dbh->disconnect();
279	joko	1.9
280	cvsjoko	1.1	return 1;
281			} else {
282	joko	1.7	$logger->warning( __PACKAGE__ . "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
283	joko	1.2	}
284	cvsjoko	1.1	}
285
286	joko	1.4	1;
287			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26