libs/Data/Storage.pm

#################################
#
#  $Id: Storage.pm,v 1.1 2002/10/10 03:43:12 cvsjoko Exp $
#
#  $Log: Storage.pm,v $
#  Revision 1.1  2002/10/10 03:43:12  cvsjoko
#  + new
#
#
#################################

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 = __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method . "(@_)";
    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->{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}};
    $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}};
    $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 $logger = 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};
  $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 isConnected {
  my $self = shift;
  return 1 if $self->{STORAGEHANDLE};
}

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