X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/89c9ff022d3f13e27ba6bda085df15707fcfb0eb..87eebe6:/SL/DB.pm

diff --git a/SL/DB.pm b/SL/DB.pm
index f90a9c637..90e08c582 100644
--- a/SL/DB.pm
+++ b/SL/DB.pm
@@ -4,11 +4,14 @@ use strict;
 
 use Carp;
 use Data::Dumper;
+use SL::DBConnect;
 use English qw(-no_match_vars);
 use Rose::DB;
+use Rose::DBx::Cache::Anywhere;
 
 use base qw(Rose::DB);
 
+__PACKAGE__->db_cache_class('Rose::DBx::Cache::Anywhere');
 __PACKAGE__->use_private_registry;
 
 my (%_db_registered, %_initial_sql_executed);
@@ -16,24 +19,14 @@ my (%_db_registered, %_initial_sql_executed);
 sub dbi_connect {
   shift;
 
-  return DBI->connect(@_) unless $::lx_office_conf{debug} && $::lx_office_conf{debug}->{dbix_log4perl};
-
-  require Log::Log4perl;
-  require DBIx::Log4perl;
-
-  my $filename =  $LXDebug::file_name;
-  my $config   =  $::lx_office_conf{debug}->{dbix_log4perl_config};
-  $config      =~ s/LXDEBUGFILE/${filename}/g;
-
-  Log::Log4perl->init(\$config);
-  return DBIx::Log4perl->connect(@_);
+  return SL::DBConnect->connect(@_);
 }
 
 sub create {
   my $domain = shift || SL::DB->default_domain;
   my $type   = shift || SL::DB->default_type;
 
-  my ($domain, $type) = _register_db($domain, $type);
+  ($domain, $type) = _register_db($domain, $type);
 
   my $db = __PACKAGE__->new_or_cached(domain => $domain, type => $type);
 
@@ -45,9 +38,7 @@ sub create {
 my %_dateformats = ( 'yy-mm-dd'   => 'ISO',
                      'yyyy-mm-dd' => 'ISO',
                      'mm/dd/yy'   => 'SQL, US',
-                     'mm-dd-yy'   => 'POSTGRES, US',
                      'dd/mm/yy'   => 'SQL, EUROPEAN',
-                     'dd-mm-yy'   => 'POSTGRES, EUROPEAN',
                      'dd.mm.yy'   => 'GERMAN'
                    );
 
@@ -65,7 +56,7 @@ sub _register_db {
   } elsif ($type eq 'LXOFFICE_AUTH') {
     %connect_settings = ( driver          => $::myconfig{dbdriver} || 'Pg',
                           database        => $::auth->{DB_config}->{db},
-                          host            => $::auth->{DB_config}->{host},
+                          host            => $::auth->{DB_config}->{host} || 'localhost',
                           port            => $::auth->{DB_config}->{port} || 5432,
                           username        => $::auth->{DB_config}->{user},
                           password        => $::auth->{DB_config}->{password},
@@ -74,12 +65,13 @@ sub _register_db {
   } else {
     my $european_dates = 0;
     if ($::myconfig{dateformat}) {
-      $european_dates = 1 if $_dateformats{ $::myconfig{dateformat} } =~ m/european/i;
+      $european_dates = 1 if $_dateformats{ $::myconfig{dateformat} }
+                          && $_dateformats{ $::myconfig{dateformat} } =~ m/european/i;
     }
 
     %connect_settings = ( driver          => $::myconfig{dbdriver} || 'Pg',
                           database        => $::myconfig{dbname},
-                          host            => $::myconfig{dbhost},
+                          host            => $::myconfig{dbhost} || 'localhost',
                           port            => $::myconfig{dbport} || 5432,
                           username        => $::myconfig{dbuser},
                           password        => $::myconfig{dbpasswd},
@@ -91,7 +83,7 @@ sub _register_db {
   my %flattened_settings = _flatten_settings(%connect_settings);
 
   $domain = 'LXOFFICE' if $type =~ m/^LXOFFICE/;
-  $type  .= join($SUBSCRIPT_SEPARATOR, map { ($_, $flattened_settings{$_}) } sort keys %flattened_settings);
+  $type  .= join($SUBSCRIPT_SEPARATOR, map { ($_, $flattened_settings{$_} || '') } sort keys %flattened_settings);
   my $idx = "${domain}::${type}";
 
   if (!$_db_registered{$idx}) {
@@ -134,4 +126,65 @@ sub _flatten_settings {
   return %flattened;
 }
 
+sub with_transaction {
+  my ($self, $code, @args) = @_;
+
+  return $self->in_transaction ? $code->(@args) : $self->do_transaction(sub { $code->(@args) });
+}
+
 1;
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB - Database access class for all RDB objects
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<create $domain, $type>
+
+Registers the database information with Rose, creates a cached
+connection and executes initial SQL statements. Those can include
+setting the time & date format to the user's preferences.
+
+=item C<dbi_connect $dsn, $login, $password, $options>
+
+Forwards the call to L<SL::DBConnect/connect> which connects to the
+database. This indirection allows L<SL::DBConnect/connect> to route
+the calls through L<DBIx::Log4Perl> if this is enabled in the
+configuration.
+
+=item C<with_transaction $code_ref, @args>
+
+Executes C<$code_ref> within a transaction, starting one if none is
+currently active. This is just a shortcut for the following code:
+
+  # Verbose code in caller (an RDBO instance):
+  my $worker = sub {
+    # do stuff with $self
+  };
+  return $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
+
+Now the version using C<with_transaction>:
+
+  return $self->db->with_transaction(sub {
+    # do stuff with $self
+  });
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut