Alle Datenbankverbindungen über DBIx::Log4perl laufen lassen, sofern dies in der...

diff --git a/SL/Auth.pm b/SL/Auth.pm
index cd16c8e0bc48c4541adb5290bcff3b732b48008e..0951883061d4ef55eac4e08edd7146ce74bdd375 100644 (file)
--- a/SL/Auth.pm
+++ b/SL/Auth.pm
@@ -13,6 +13,7 @@ use SL::Auth::DB;
 use SL::Auth::LDAP;
 
 use SL::User;
 use SL::Auth::LDAP;
 
 use SL::User;

+use SL::DBConnect;

 use SL::DBUpgrade2;
 use SL::DBUtils;
 
 use SL::DBUpgrade2;
 use SL::DBUtils;
 


@@ -38,7 +39,7 @@ sub new {
 sub get_user_dbh {
   my ($self, $login) = @_;
   my %user = $self->read_user($login);
 sub get_user_dbh {
   my ($self, $login) = @_;
   my %user = $self->read_user($login);

-  my $dbh  = DBI->connect(
+  my $dbh  = SL::DBConnect->connect(

     $user{dbconnect},
     $user{dbuser},
     $user{dbpasswd},
     $user{dbconnect},
     $user{dbuser},
     $user{dbpasswd},


@@ -166,7 +167,7 @@ sub dbconnect {
 
   $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
 
 
   $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
 

-  $self->{dbh} = DBI->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
+  $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });

 
   if (!$may_fail && !$self->{dbh}) {
     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
 
   if (!$may_fail && !$self->{dbh}) {
     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);


@@ -246,7 +247,7 @@ sub create_database {
   my $encoding   = $Common::charset_to_db_encoding{$charset};
   $encoding    ||= 'UNICODE';
 
   my $encoding   = $Common::charset_to_db_encoding{$charset};
   $encoding    ||= 'UNICODE';
 

-  my $dbh        = DBI->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => $charset =~ m/^utf-?8$/i });
+  my $dbh        = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => $charset =~ m/^utf-?8$/i });

 
   if (!$dbh) {
     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
 
   if (!$dbh) {
     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);

diff --git a/SL/DB.pm b/SL/DB.pm
index 67888ef5942f34174b5a7a45dc7986e40f4ed6a7..38441aabfd24aea67cb6cf27766e55ed057cf0ee 100644 (file)
--- a/SL/DB.pm
+++ b/SL/DB.pm
@@ -16,17 +16,7 @@ my (%_db_registered, %_initial_sql_executed);
 sub dbi_connect {
   shift;
 
 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 {
 }
 
 sub create {

diff --git a/SL/DBConnect.pm b/SL/DBConnect.pm
new file mode 100644 (file)
index 0000000..fbcf1d5
--- /dev/null
+++ b/SL/DBConnect.pm
@@ -0,0 +1,23 @@
+package SL::DBConnect;
+
+use strict;
+
+use DBI;
+
+sub 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(@_);
+}
+
+1;

diff --git a/SL/Form.pm b/SL/Form.pm
index 33b3d04bf064f7cefbe7142e2b8122c6f08e5659..bcb7cd58933ec0aed6716d928182739f4e3f420e 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -52,6 +52,7 @@ use SL::AM;
 use SL::Common;
 use SL::CVar;
 use SL::DB;
 use SL::Common;
 use SL::CVar;
 use SL::DB;

+use SL::DBConnect;

 use SL::DBUtils;
 use SL::DO;
 use SL::IC;
 use SL::DBUtils;
 use SL::DO;
 use SL::IC;


@@ -1582,7 +1583,7 @@ sub dbconnect {
   my ($self, $myconfig) = @_;
 
   # connect to database
   my ($self, $myconfig) = @_;
 
   # connect to database

-  my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options)
+  my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options)

     or $self->dberror;
 
   # set db options
     or $self->dberror;
 
   # set db options


@@ -1601,7 +1602,7 @@ sub dbconnect_noauto {
   my ($self, $myconfig) = @_;
 
   # connect to database
   my ($self, $myconfig) = @_;
 
   # connect to database

-  my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0))
+  my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0))

     or $self->dberror;
 
   # set db options
     or $self->dberror;
 
   # set db options

diff --git a/SL/User.pm b/SL/User.pm
index 520bf422959e316d965ab4c70b0913fe506bca1e..d6b870552c37f6aedcde7650a7177183f8ca2804 100644 (file)
--- a/SL/User.pm
+++ b/SL/User.pm
@@ -38,6 +38,7 @@ use IO::File;
 use Fcntl qw(:seek);
 
 #use SL::Auth;
 use Fcntl qw(:seek);
 
 #use SL::Auth;

+use SL::DBConnect;

 use SL::DBUpgrade2;
 use SL::DBUtils;
 use SL::Iconv;
 use SL::DBUpgrade2;
 use SL::DBUtils;
 use SL::Iconv;


@@ -104,9 +105,7 @@ sub login {
     my %myconfig = $main::auth->read_user($self->{login});
 
     # check if database is down
     my %myconfig = $main::auth->read_user($self->{login});
 
     # check if database is down

-    my $dbh =
-      DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
-                   $myconfig{dbpasswd})
+    my $dbh = SL::DBConnect->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd})

       or $self->error($DBI::errstr);
 
     # we got a connection, check the version
       or $self->error($DBI::errstr);
 
     # we got a connection, check the version


@@ -252,8 +251,7 @@ sub dbsources {
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
 
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
 

-  my $dbh =
-    DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+  my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})

     or $form->dberror;
 
   if ($form->{dbdriver} eq 'Pg') {
     or $form->dberror;
 
   if ($form->{dbdriver} eq 'Pg') {


@@ -270,8 +268,7 @@ sub dbsources {
         next if ($db =~ /^template/);
 
         &dbconnect_vars($form, $db);
         next if ($db =~ /^template/);
 
         &dbconnect_vars($form, $db);

-        my $dbh =
-          DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+        my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})

           or $form->dberror;
 
         $query =
           or $form->dberror;
 
         $query =


@@ -326,7 +323,7 @@ sub dbclusterencoding {
 
   dbconnect_vars($form, $form->{dbdefault});
 
 
   dbconnect_vars($form, $form->{dbdefault});
 

-  my $dbh                = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
+  my $dbh                = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();

   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
   my ($cluster_encoding) = $dbh->selectrow_array($query);
   $dbh->disconnect();
   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
   my ($cluster_encoding) = $dbh->selectrow_array($query);
   $dbh->disconnect();


@@ -344,7 +341,7 @@ sub dbcreate {
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
   my $dbh =
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
   my $dbh =

-    DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+    SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})

     or $form->dberror;
   $form->{db} =~ s/\"//g;
   my %dbcreate = (
     or $form->dberror;
   $form->{db} =~ s/\"//g;
   my %dbcreate = (


@@ -386,7 +383,7 @@ sub dbcreate {
 
   &dbconnect_vars($form, $form->{db});
 
 
   &dbconnect_vars($form, $form->{db});
 

-  $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+  $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})

     or $form->dberror;
 
   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
     or $form->dberror;
 
   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};


@@ -417,8 +414,7 @@ sub dbdelete {
 
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});
 
   $form->{sid} = $form->{dbdefault};
   &dbconnect_vars($form, $form->{dbdefault});

-  my $dbh =
-    DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+  my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})

     or $form->dberror;
   my $query = $dbdelete{$form->{dbdriver}};
   do_query($form, $dbh, $query);
     or $form->dberror;
   my $query = $dbdelete{$form->{dbdriver}};
   do_query($form, $dbh, $query);


@@ -464,7 +460,7 @@ sub dbneedsupdate {
     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
     dbconnect_vars($form, $form->{dbname});
 
     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
     dbconnect_vars($form, $form->{dbname});
 

-    my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
+    my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});

 
     next unless $dbh;
 
 
     next unless $dbh;
 


@@ -594,8 +590,7 @@ sub dbupdate {
     $db =~ s/^db//;
     &dbconnect_vars($form, $db);
 
     $db =~ s/^db//;
     &dbconnect_vars($form, $db);
 

-    my $dbh =
-      DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
+    my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})

       or $form->dberror;
 
     $dbh->do($form->{dboptions}) if ($form->{dboptions});
       or $form->dberror;
 
     $dbh->do($form->{dboptions}) if ($form->{dboptions});


@@ -659,7 +654,7 @@ sub dbupdate2 {
     $db =~ s/^db//;
     &dbconnect_vars($form, $db);
 
     $db =~ s/^db//;
     &dbconnect_vars($form, $db);
 

-    my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
+    my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;

 
     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 
 
     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 


@@ -700,7 +695,7 @@ sub save_member {
 
   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 
 
   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 

-  my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
+  my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});

   if ($dbh) {
     $self->create_employee_entry($form, $dbh, $self, 1);
     $dbh->disconnect();
   if ($dbh) {
     $self->create_employee_entry($form, $dbh, $self, 1);
     $dbh->disconnect();