Data/Storage/Container.pm

################################################
#
#  $Id: Container.pm,v 1.10 2003/06/06 03:26:24 joko Exp $
#
#  $Log: Container.pm,v $
#  Revision 1.10  2003/06/06 03:26:24  joko
#  + sub existsStorage
#
#  Revision 1.9  2003/03/27 15:31:08  joko
#  fixes to modules regarding new namespace(s) below Data::Mungle::*
#
#  Revision 1.8  2003/02/18 19:19:47  joko
#  + modified locator handling
#
#  Revision 1.7  2003/01/30 22:21:52  joko
#  + changed 'connect'-behaviour back to old state
#  + renamed log-output (now using 'initializing' instead of 'booting' - corresponding to 'initStorage')
#
#  Revision 1.6  2003/01/30 21:44:00  joko
#  + temporary fix: (FIXME) now connecting to storage on storagehandle-instantiation
#
#  Revision 1.5  2003/01/19 02:39:57  joko
#  + moved 'deep_copy' from module 'libp' to module 'Data.Transform.Deep'
#  + preserved order for hashes '$self->{config}' and '$self->{locator}' by using Tie::IxHash
#
#  Revision 1.4  2002/12/04 07:38:07  jonen
#  + deep copy
#
#  Revision 1.3  2002/12/01 22:18:28  joko
#  - no interactive implicit deploy
#  + only test integrity if storage available
#
#  Revision 1.2  2002/12/01 07:08:35  joko
#  + needs to "use Data::Storage;"
#
#  Revision 1.1  2002/11/29 04:54:54  joko
#  + initial check-in
#
#  Revision 1.1  2002/11/17 06:20:41  joko
#  + initial check in
#
#
################################################


package Data::Storage::Container;

use strict;
use warnings;

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


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -   main
use Tie::IxHash;
use Data::Dumper;

use Data::Storage;
use Data::Storage::Locator;
use Data::Mungle::Transform::Deep qw( deep_copy );
use Data::Mungle::Compare::Struct qw( isEmpty );

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;

  # get constructor arguments
  my @args = ();
  @_ && (@args = @_);
  $logger->debug( __PACKAGE__ . "->new( @args )" );

  my $self = { @_ };
  bless $self, $class;
  
  # preserve order of configuration variables
  #$self->{config} = {};
  tie %{$self->{config}}, 'Tie::IxHash';
  tie %{$self->{locator}}, 'Tie::IxHash';
  
  return $self;
}

sub addConfig {
  my $self = shift;
  my $name = shift;
  my $config = shift;
  $self->{config}->{$name} = $config;
}

sub addConfigByDsn {
  my $self = shift;
  my $name = shift;
  my $dsn = shift;
  
  # HACK: assume DBI as default type for now
  # TODO: guess type from dsn
  my $type = "DBI";
  
  $self->addConfig($name, { type => $type, dsn => $dsn });
}

sub addStorage {
  my $self = shift;
  my $name = shift;
  my $storage = shift;
  $self->{storage}->{$name} = $storage;
}

sub existsStorage {
  my $self = shift;
  my $name = shift;
  return exists $self->{storage}->{$name};
}

sub initLocator {
  my $self = shift;
  my $name = shift;
  my $db_config = $self->{config}->{$name};
  $db_config ||= {};

  $logger->debug( __PACKAGE__ . "->initLocator( name='$name' )" );

  my $cfg_locator = {};
  
  # set default settings, if any
  my $default = deep_copy($self->{config}->{_default});
  foreach (keys %$default) {
    $cfg_locator->{$_} = $default->{$_};
  }
  
  # merge in specific settings
  my $specific = deep_copy($db_config);
  foreach (keys %$specific) {
    $cfg_locator->{$_} = $specific->{$_};
  }
  
  # HACK: transfer dsn from main to dbi settings
  $cfg_locator->{dbi}->{dsn} = $cfg_locator->{dsn} if $cfg_locator->{dsn};

  # HACK: set classnames empty if none given from config
  $cfg_locator->{classnames} = [] if !$cfg_locator->{classnames};

  # HACK: set errorhandler if dbi settings are present
  $cfg_locator->{dbi}->{HandleError} = \&_dbErrorHandler if $cfg_locator->{dbi};

  # trace
    #print "locator:", "\n";
    #print Dumper($cfg_locator);

  # check locator metadata
  if (isEmpty($cfg_locator)) {
    $logger->warning( __PACKAGE__ . "->initLocator( name='$name' ): Metadata was empty. Please check configuration." );
    return;
  }

  # name it
  $cfg_locator->{name} = $name;

  # create new locator object
  $self->{locator}->{$name} = Data::Storage::Locator->new( $cfg_locator );

}

sub initLocators {
  my $self = shift;
  foreach (keys %{$self->{config}}) {
    #print $_, "\n";
    $self->initLocator($_, $self->{config}->{$_}) if !/^_/;
  }
  #print "locs: ", Dumper($self->{locator});
}

sub getLocator {
  my $self = shift;
  my $name = shift;
  return $self->{locator}->{$name};
}

sub initStorage {
  my $self = shift;
  my $name = shift;

  return if $self->existsStorage($name);

  my $locator = $self->getLocator($name);
  $logger->info( __PACKAGE__ . " is initializing storage declared by locator \"$name\"" );

  my $storage = Data::Storage->new($locator);
  
  # TODO: do below (after 'testAvailability' and 'testIntegrity') again!!!
  #$storage->connect();

  $self->addStorage($name, $storage);

  my $log_prefix = __PACKAGE__ . "->initStorage: ";
  $log_prefix .= "dsn=\"$self->{locator}->{$name}->{dsn}\"" if $self->{locator}->{$name}->{dsn};

  # should we test availability of the storage before using it?
  if ($locator->{test_availability}) {
    $locator->{status}->{availability} = $storage->testAvailability();
    if ( !$storage->testAvailability() ) {
      $logger->error( "$log_prefix: testAvailability failed" );
      return;
    }
  }
          
  # should we test integrity of the storage before using it?
  if ($locator->{status}->{availability} && $locator->{test_integrity}) {
    #return unless $storage->testIntegrity();
    $locator->{status}->{integrity} = $storage->testIntegrity();
    # actions if integrity fails
    if (!$locator->{status}->{integrity}) {
      $logger->error( "$log_prefix: testIntegrity failed" );
      return;
    }
  }

  # try to connect...
  # TODO:
  # don't connect right here, do an implicit connect on (later) usage
  # maybe set ->{meta}->{connectmethod} = "connect" here
  #return unless $storage->connect();
  $storage->connect() if $locator->{status}->{integrity};

  # should we check emptyness?
  if ($locator->{status}->{availability} && $locator->{test_emptyness}) {
    #print "test empty", "\n";
    if ( !@{$storage->getChildNodes()} ) {
      $locator->{status}->{empty} = 1;
      $logger->warning( "$log_prefix: Storage is empty.");
      return;
    }
  }

  # expand logging?
  if ( $locator->{status}->{integrity} && $locator->{logger} ) {
    # expand logging (to Tangram-Database)
    # TODO:
    # - move configuration data from this code to db_config somehow
    # - do complete handling of this stuff in Data::Storage::* also
    # - just leave a simple on/off-trigger here and/or 
    # - make it optionally configurable via e.g. get/set-methods
    #    to satisfy "manual"-mode instead of "config"-mode
    # - (re-)add hierarchical logging (each event may have a parent)
    no strict;
    my $creator = sub { return new SystemEvent; };
    use strict;
    $storage->addLogDispatchHandler("Tangram11", "Log::Dispatch::Tangram", $logger, $creator);
    #$storage_left->addLogDispatchHandler("Tangram11", "Log::Dispatch::Tangram", $logger);
  }

  #$self->{storage}->{$name} = $storage;
  #print "add storage: $name", "\n";
  #$self->addStorage($name, $storage);

  return 1;
  
}

sub initStorages {
  my $self = shift;
  foreach (keys %{$self->{locator}}) {
    #print $_, "\n";
    $self->initStorage($_);
  }
}

sub _dbErrorHandler {
  my $message_db = shift;
  # get logger instance
  #my $logger = Log::Dispatch::Config->instance;
  #$logger->log(level => 'error', message => "Tangram DBI-Error: $message");
  my $message_log = "DBI-Error: $message_db";
  print STDERR $message_log, "\n";
  #$logger->error( $message_log );
  #$logger->log_to( name => 'file', level => 'error', message => $message_log);
  $logger->log_to( name => 'file', level => 'warning', message => $message_log);
  return 1;
}

1;
__END__
1	joko	1.1	################################################
2			#
3	joko	1.11	# $Id: Container.pm,v 1.10 2003/06/06 03:26:24 joko Exp $
4	joko	1.1	#
5			# $Log: Container.pm,v $
6	joko	1.11	# Revision 1.10 2003/06/06 03:26:24 joko
7			# + sub existsStorage
8			#
9	joko	1.10	# Revision 1.9 2003/03/27 15:31:08 joko
10			# fixes to modules regarding new namespace(s) below Data::Mungle::*
11			#
12	joko	1.9	# Revision 1.8 2003/02/18 19:19:47 joko
13			# + modified locator handling
14			#
15	joko	1.8	# Revision 1.7 2003/01/30 22:21:52 joko
16			# + changed 'connect'-behaviour back to old state
17			# + renamed log-output (now using 'initializing' instead of 'booting' - corresponding to 'initStorage')
18			#
19	joko	1.7	# Revision 1.6 2003/01/30 21:44:00 joko
20			# + temporary fix: (FIXME) now connecting to storage on storagehandle-instantiation
21			#
22	joko	1.6	# Revision 1.5 2003/01/19 02:39:57 joko
23	joko	1.9	# + moved 'deep_copy' from module 'libp' to module 'Data.Transform.Deep'
24	joko	1.6	# + preserved order for hashes '$self->{config}' and '$self->{locator}' by using Tie::IxHash
25			#
26	joko	1.5	# Revision 1.4 2002/12/04 07:38:07 jonen
27			# + deep copy
28			#
29	jonen	1.4	# Revision 1.3 2002/12/01 22:18:28 joko
30			# - no interactive implicit deploy
31			# + only test integrity if storage available
32			#
33	joko	1.3	# Revision 1.2 2002/12/01 07:08:35 joko
34			# + needs to "use Data::Storage;"
35			#
36	joko	1.2	# Revision 1.1 2002/11/29 04:54:54 joko
37			# + initial check-in
38			#
39	joko	1.1	# Revision 1.1 2002/11/17 06:20:41 joko
40			# + initial check in
41			#
42			#
43			################################################
44
45
46			package Data::Storage::Container;
47
48			use strict;
49			use warnings;
50
51			# get logger instance
52			my $logger = Log::Dispatch::Config->instance;
53
54	joko	1.5
55			# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - main
56			use Tie::IxHash;
57	joko	1.1	use Data::Dumper;
58	joko	1.5
59	joko	1.8	use Data::Storage;
60			use Data::Storage::Locator;
61	joko	1.9	use Data::Mungle::Transform::Deep qw( deep_copy );
62			use Data::Mungle::Compare::Struct qw( isEmpty );
63	joko	1.1
64			sub new {
65			my $invocant = shift;
66			my $class = ref($invocant) \|\| $invocant;
67
68			# get constructor arguments
69			my @args = ();
70			@_ && (@args = @_);
71			$logger->debug( __PACKAGE__ . "->new( @args )" );
72
73			my $self = { @_ };
74	joko	1.5	bless $self, $class;
75
76			# preserve order of configuration variables
77			#$self->{config} = {};
78			tie %{$self->{config}}, 'Tie::IxHash';
79			tie %{$self->{locator}}, 'Tie::IxHash';
80
81			return $self;
82	joko	1.1	}
83
84			sub addConfig {
85			my $self = shift;
86			my $name = shift;
87			my $config = shift;
88			$self->{config}->{$name} = $config;
89			}
90
91			sub addConfigByDsn {
92			my $self = shift;
93			my $name = shift;
94			my $dsn = shift;
95
96			# HACK: assume DBI as default type for now
97			# TODO: guess type from dsn
98			my $type = "DBI";
99
100			$self->addConfig($name, { type => $type, dsn => $dsn });
101			}
102
103			sub addStorage {
104			my $self = shift;
105			my $name = shift;
106			my $storage = shift;
107			$self->{storage}->{$name} = $storage;
108			}
109
110	joko	1.10	sub existsStorage {
111			my $self = shift;
112			my $name = shift;
113			return exists $self->{storage}->{$name};
114			}
115
116	joko	1.1	sub initLocator {
117			my $self = shift;
118			my $name = shift;
119			my $db_config = $self->{config}->{$name};
120	joko	1.8	$db_config \|\|= {};
121	joko	1.1
122	joko	1.8	$logger->debug( __PACKAGE__ . "->initLocator( name='$name' )" );
123	joko	1.1
124			my $cfg_locator = {};
125
126			# set default settings, if any
127			my $default = deep_copy($self->{config}->{_default});
128			foreach (keys %$default) {
129			$cfg_locator->{$_} = $default->{$_};
130			}
131
132			# merge in specific settings
133	jonen	1.4	my $specific = deep_copy($db_config);
134			foreach (keys %$specific) {
135			$cfg_locator->{$_} = $specific->{$_};
136	joko	1.1	}
137
138			# HACK: transfer dsn from main to dbi settings
139			$cfg_locator->{dbi}->{dsn} = $cfg_locator->{dsn} if $cfg_locator->{dsn};
140
141			# HACK: set classnames empty if none given from config
142			$cfg_locator->{classnames} = [] if !$cfg_locator->{classnames};
143
144			# HACK: set errorhandler if dbi settings are present
145			$cfg_locator->{dbi}->{HandleError} = \&_dbErrorHandler if $cfg_locator->{dbi};
146	joko	1.8
147			# trace
148			#print "locator:", "\n";
149			#print Dumper($cfg_locator);
150
151			# check locator metadata
152			if (isEmpty($cfg_locator)) {
153			$logger->warning( __PACKAGE__ . "->initLocator( name='$name' ): Metadata was empty. Please check configuration." );
154			return;
155			}
156
157			# name it
158			$cfg_locator->{name} = $name;
159	joko	1.1
160			# create new locator object
161			$self->{locator}->{$name} = Data::Storage::Locator->new( $cfg_locator );
162
163			}
164
165			sub initLocators {
166			my $self = shift;
167			foreach (keys %{$self->{config}}) {
168	joko	1.5	#print $_, "\n";
169	joko	1.1	$self->initLocator($_, $self->{config}->{$_}) if !/^_/;
170			}
171			#print "locs: ", Dumper($self->{locator});
172			}
173
174			sub getLocator {
175			my $self = shift;
176			my $name = shift;
177			return $self->{locator}->{$name};
178			}
179
180			sub initStorage {
181			my $self = shift;
182			my $name = shift;
183
184	joko	1.10	return if $self->existsStorage($name);
185
186	joko	1.1	my $locator = $self->getLocator($name);
187	joko	1.7	$logger->info( __PACKAGE__ . " is initializing storage declared by locator \"$name\"" );
188	joko	1.1
189			my $storage = Data::Storage->new($locator);
190	joko	1.6
191			# TODO: do below (after 'testAvailability' and 'testIntegrity') again!!!
192	joko	1.7	#$storage->connect();
193	joko	1.1
194	joko	1.11	$self->addStorage($name, $storage);
195
196	joko	1.1	my $log_prefix = __PACKAGE__ . "->initStorage: ";
197			$log_prefix .= "dsn=\"$self->{locator}->{$name}->{dsn}\"" if $self->{locator}->{$name}->{dsn};
198
199			# should we test availability of the storage before using it?
200			if ($locator->{test_availability}) {
201	joko	1.3	$locator->{status}->{availability} = $storage->testAvailability();
202	joko	1.1	if ( !$storage->testAvailability() ) {
203	joko	1.3	$logger->error( "$log_prefix: testAvailability failed" );
204	joko	1.11	return;
205	joko	1.1	}
206			}
207
208			# should we test integrity of the storage before using it?
209	joko	1.3	if ($locator->{status}->{availability} && $locator->{test_integrity}) {
210	joko	1.1	#return unless $storage->testIntegrity();
211			$locator->{status}->{integrity} = $storage->testIntegrity();
212			# actions if integrity fails
213			if (!$locator->{status}->{integrity}) {
214	joko	1.3	$logger->error( "$log_prefix: testIntegrity failed" );
215	joko	1.11	return;
216	joko	1.1	}
217			}
218
219			# try to connect...
220			# TODO:
221			# don't connect right here, do an implicit connect on (later) usage
222			# maybe set ->{meta}->{connectmethod} = "connect" here
223			#return unless $storage->connect();
224	joko	1.7	$storage->connect() if $locator->{status}->{integrity};
225	joko	1.1
226			# should we check emptyness?
227	joko	1.3	if ($locator->{status}->{availability} && $locator->{test_emptyness}) {
228			#print "test empty", "\n";
229	joko	1.1	if ( !@{$storage->getChildNodes()} ) {
230			$locator->{status}->{empty} = 1;
231	joko	1.3	$logger->warning( "$log_prefix: Storage is empty.");
232	joko	1.11	return;
233	joko	1.1	}
234			}
235
236			# expand logging?
237	joko	1.3	if ( $locator->{status}->{integrity} && $locator->{logger} ) {
238	joko	1.1	# expand logging (to Tangram-Database)
239			# TODO:
240			# - move configuration data from this code to db_config somehow
241			# - do complete handling of this stuff in Data::Storage::* also
242			# - just leave a simple on/off-trigger here and/or
243			# - make it optionally configurable via e.g. get/set-methods
244			# to satisfy "manual"-mode instead of "config"-mode
245			# - (re-)add hierarchical logging (each event may have a parent)
246			no strict;
247			my $creator = sub { return new SystemEvent; };
248			use strict;
249			$storage->addLogDispatchHandler("Tangram11", "Log::Dispatch::Tangram", $logger, $creator);
250			#$storage_left->addLogDispatchHandler("Tangram11", "Log::Dispatch::Tangram", $logger);
251			}
252
253			#$self->{storage}->{$name} = $storage;
254	joko	1.3	#print "add storage: $name", "\n";
255	joko	1.11	#$self->addStorage($name, $storage);
256	joko	1.1
257			return 1;
258
259			}
260
261			sub initStorages {
262			my $self = shift;
263			foreach (keys %{$self->{locator}}) {
264	joko	1.5	#print $_, "\n";
265	joko	1.1	$self->initStorage($_);
266			}
267			}
268
269			sub _dbErrorHandler {
270			my $message_db = shift;
271			# get logger instance
272			#my $logger = Log::Dispatch::Config->instance;
273			#$logger->log(level => 'error', message => "Tangram DBI-Error: $message");
274			my $message_log = "DBI-Error: $message_db";
275			print STDERR $message_log, "\n";
276			#$logger->error( $message_log );
277			#$logger->log_to( name => 'file', level => 'error', message => $message_log);
278			$logger->log_to( name => 'file', level => 'warning', message => $message_log);
279			return 1;
280			}
281
282			1;
283	joko	1.10	__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26