libs/Data/Storage.pm

#################################
#
#  $Id: Storage.pm,v 1.2 2002/10/17 00:04:29 joko Exp $
#
#  $Log: Storage.pm,v $
#  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
#
#
#################################

# aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)
# aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:
#               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file

package Data::Storage;

use strict;
use warnings;

use Data::Storage::Locator;

# 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;
  
  #my $self = { STORAGEHANDLE => undef, @_ };
  my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
  $logger->debug( __PACKAGE__ . "[$self->{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 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
    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 );

  # filtering AUTOLOAD calls
  if ($self->_filter_AUTOLOAD($method)) {
    $self->_accessStorage();
    $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!
  $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 . "";
  
  # propagate args to handler
  # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)
  if ($type eq 'DBI') {
    use Data::Storage::Handler::DBI;
    #my @args = %{$self->{locator}->{dbi}};
    my @args = %{$self->{locator}};
    # create new storage handle
    $self->{STORAGEHANDLE} = $pkg->new( @args );
  }
  if ($type eq 'Tangram') {
    use Data::Storage::Handler::Tangram;
    #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );
    #my @args = %{$self->{locator}->{dbi}};
    my @args = %{$self->{locator}};
    # create new storage handle
    $self->{STORAGEHANDLE} = $pkg->new( @args );

    #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();
    #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();
  }
  
}

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 testDsn {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};
  my $result;
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    $dbh->disconnect();
    return 1;
  } else {
    $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
  }
}

sub createDb {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};

  $logger->debug( __PACKAGE__ .  "->createDb( dsn $dsn )" );

  $dsn =~ s/database=(.+?);//;
  my $database_name = $1;

  my $ok;
  
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    if ($database_name) {
      if ($dbh->do("CREATE DATABASE $database_name;")) {
        $ok = 1;
      }
    }
    $dbh->disconnect();
  }
  
  return $ok;
  
}

sub dropDb {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};

  $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );

  $dsn =~ s/database=(.+?);//;
  my $database_name = $1;

  my $ok;
  
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    if ($database_name) {
      if ($dbh->do("DROP DATABASE $database_name;")) {
        $ok = 1;
      }
    }
    $dbh->disconnect();
  }
  
  return $ok;
}

sub isConnected {
  my $self = shift;
  return 1 if $self->{STORAGEHANDLE};
}

1;
1	cvsjoko	1.1	#################################
2			#
3	joko	1.3	# $Id: Storage.pm,v 1.2 2002/10/17 00:04:29 joko Exp $
4	joko	1.2	#
5			# $Log: Storage.pm,v $
6	joko	1.3	# Revision 1.2 2002/10/17 00:04:29 joko
7			# + sub createDb
8			# + sub isConnected
9			# + bugfixes regarding "deep recursion" stuff
10			#
11	joko	1.2	# Revision 1.1 2002/10/10 03:43:12 cvsjoko
12			# + new
13	cvsjoko	1.1	#
14			#
15			#################################
16
17	joko	1.3	# aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)
18			# aim_V2: introduce a generic layered structure, refactor SUBLAYER-stuff, make (e.g.) this possible:
19			# - Perl Data::Storage[DBD::CSV] -> Perl LWP:: -> Internet HTTP/FTP/* -> Host Daemon -> csv-file
20
21	cvsjoko	1.1	package Data::Storage;
22
23			use strict;
24			use warnings;
25
26			use Data::Storage::Locator;
27
28			# get logger instance
29			my $logger = Log::Dispatch::Config->instance;
30
31			sub new {
32			my $invocant = shift;
33			my $class = ref($invocant) \|\| $invocant;
34			#my @args = normalizeArgs(@_);
35
36			my $arg_locator = shift;
37			my $arg_options = shift;
38
39			#my $self = { STORAGEHANDLE => undef, @_ };
40			my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
41			$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
42			return bless $self, $class;
43			}
44
45			sub AUTOLOAD {
46
47	joko	1.2	# since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
48			# some sophisticated handling and filtering is needed to avoid things like
49			# - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
50			# - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
51			# - Deep recursion on anonymous subroutine at [...]
52			# we also might filter log messages caused by logging itself in "advanced logging of AUTOLOAD calls"
53
54	cvsjoko	1.1	my $self = shift;
55			our $AUTOLOAD;
56
57			# ->DESTROY would - if not declared - trigger an AUTOLOAD also
58			return if $AUTOLOAD =~ m/::DESTROY$/;
59
60			my $method = $AUTOLOAD;
61			$method =~ s/^.*:://;
62
63	joko	1.2	# advanced logging of AUTOLOAD calls
64	joko	1.3	my $logstring = "";
65			$logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
66			#print "count: ", $#_, "\n";
67			#$logstring .= Dumper(@_) if ($#_ != -1);
68	joko	1.2	my $tabcount = int( (80 - length($logstring)) / 10 );
69			$logstring .= "\t" x $tabcount . "(AUTOLOAD)";
70			# TODO: only ok if logstring doesn't contain
71			# e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c)) (AUTOLOAD)"
72			# but that would be way too specific as long as we don't have an abstract handler for this ;)
73			$logger->debug( $logstring );
74	cvsjoko	1.1
75	joko	1.2	# filtering AUTOLOAD calls
76	cvsjoko	1.1	if ($self->_filter_AUTOLOAD($method)) {
77			$self->_accessStorage();
78			$self->{STORAGEHANDLE}->$method(@_);
79			}
80
81			}
82
83			sub _filter_AUTOLOAD {
84			my $self = shift;
85			my $method = shift;
86			if ($self->{options}->{protected}) {
87			if ($method eq 'disconnect') {
88			return;
89			}
90			}
91			return 1;
92			}
93
94
95			sub normalizeArgs {
96			my %args = @_;
97			if (!$args{dsn} && $args{meta}{dsn}) {
98			$args{dsn} = $args{meta}{dsn};
99			}
100			my @result = %args;
101			return @result;
102			}
103
104			sub _accessStorage {
105			my $self = shift;
106			# TODO: to some tracelevel!
107	joko	1.3	$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->_accessStorage()" );
108	cvsjoko	1.1	if (!$self->{STORAGEHANDLE}) {
109			$self->_createStorageHandle();
110			}
111			}
112
113			sub _createStorageHandle {
114			my $self = shift;
115
116			my $type = $self->{locator}->{type};
117			$logger->debug( __PACKAGE__ . "[$type]" . "->_createStorageHandle()" );
118
119			my $pkg = "Data::Storage::Handler::" . $type . "";
120
121			# propagate args to handler
122			# needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)
123			if ($type eq 'DBI') {
124	joko	1.2	use Data::Storage::Handler::DBI;
125	cvsjoko	1.1	#my @args = %{$self->{locator}->{dbi}};
126			my @args = %{$self->{locator}};
127	joko	1.3	# create new storage handle
128	cvsjoko	1.1	$self->{STORAGEHANDLE} = $pkg->new( @args );
129			}
130			if ($type eq 'Tangram') {
131	joko	1.2	use Data::Storage::Handler::Tangram;
132	cvsjoko	1.1	#$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );
133			#my @args = %{$self->{locator}->{dbi}};
134			my @args = %{$self->{locator}};
135	joko	1.3	# create new storage handle
136	cvsjoko	1.1	$self->{STORAGEHANDLE} = $pkg->new( @args );
137	joko	1.3
138	cvsjoko	1.1	#$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();
139			#$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();
140			}
141
142			}
143
144			sub addLogDispatchHandler {
145
146			my $self = shift;
147			my $name = shift;
148			my $package = shift;
149	joko	1.3	my $logger1 = shift;
150	cvsjoko	1.1	my $objectCreator = shift;
151
152			#$logger->add( Log::Dispatch::Tangram->new( name => $name,
153			$logger->add( $package->new( name => $name,
154			#min_level => 'debug',
155			min_level => 'info',
156			storage => $self,
157			objectCreator => $objectCreator,
158			fields => {
159			message => 'usermsg',
160			timestamp => 'stamp',
161			level => 'level',
162			name => 'code',
163			},
164			filter_patterns => [ '->insert\(SystemEvent=' ],
165			#filter_patterns => [ 'SystemEvent' ],
166
167			#format => '[%d] [%p] %m%n',
168			) );
169
170			}
171
172			sub removeLogDispatchHandler {
173
174			my $self = shift;
175			my $name = shift;
176	joko	1.3	#my $logger = shift;
177	cvsjoko	1.1
178			$logger->remove($name);
179
180			}
181
182			sub getDbName {
183			my $self = shift;
184			my $dsn = $self->{locator}->{dbi}->{dsn};
185			$dsn =~ m/database=(.+?);/;
186			my $database_name = $1;
187			return $database_name;
188			}
189
190			sub testDsn {
191			my $self = shift;
192			my $dsn = $self->{locator}->{dbi}->{dsn};
193			my $result;
194			if ( my $dbh = DBI->connect($dsn, '', '', {
195			PrintError => 0,
196			} ) ) {
197			$dbh->disconnect();
198			return 1;
199			} else {
200	joko	1.2	$logger->error( __PACKAGE__ . "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
201			}
202			}
203
204			sub createDb {
205			my $self = shift;
206			my $dsn = $self->{locator}->{dbi}->{dsn};
207	joko	1.3
208			$logger->debug( __PACKAGE__ . "->createDb( dsn $dsn )" );
209
210	joko	1.2	$dsn =~ s/database=(.+?);//;
211			my $database_name = $1;
212
213			my $ok;
214
215			if ( my $dbh = DBI->connect($dsn, '', '', {
216			PrintError => 0,
217			} ) ) {
218			if ($database_name) {
219			if ($dbh->do("CREATE DATABASE $database_name;")) {
220			$ok = 1;
221			}
222			}
223			$dbh->disconnect();
224	cvsjoko	1.1	}
225	joko	1.2
226			return $ok;
227
228	joko	1.3	}
229
230			sub dropDb {
231			my $self = shift;
232			my $dsn = $self->{locator}->{dbi}->{dsn};
233
234			$logger->debug( __PACKAGE__ . "->dropDb( dsn $dsn )" );
235
236			$dsn =~ s/database=(.+?);//;
237			my $database_name = $1;
238
239			my $ok;
240
241			if ( my $dbh = DBI->connect($dsn, '', '', {
242			PrintError => 0,
243			} ) ) {
244			if ($database_name) {
245			if ($dbh->do("DROP DATABASE $database_name;")) {
246			$ok = 1;
247			}
248			}
249			$dbh->disconnect();
250			}
251
252			return $ok;
253	joko	1.2	}
254
255			sub isConnected {
256			my $self = shift;
257			return 1 if $self->{STORAGEHANDLE};
258	cvsjoko	1.1	}
259
260			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26