X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/549dfe12908fd59ca163abf4ddbd61bde3ae406d..beb61b2e270836ccd11e00ce68ff884cfb7a530d:/SL/DBConnect.pm

diff --git a/SL/DBConnect.pm b/SL/DBConnect.pm
index 3ad5dfdf7..e67d8d095 100644
--- a/SL/DBConnect.pm
+++ b/SL/DBConnect.pm
@@ -3,18 +3,13 @@ package SL::DBConnect;
 use strict;
 
 use DBI;
+use SL::DB;
 
 sub connect {
-  shift;
+  my ($self, @args) = @_;
+  @args = $self->get_connect_args if !@args;
 
-  # print STDERR "Starting full caller dump:\n";
-  # my $level = 0;
-  # while (my ($dummy, $filename, $line, $subroutine) = caller $level) {
-  #   print STDERR "  ${subroutine} from ${filename}:${line}\n";
-  #   $level++;
-  # }
-
-  return DBI->connect(@_) unless $::lx_office_conf{debug} && $::lx_office_conf{debug}->{dbix_log4perl};
+  return DBI->connect(@args) unless $::lx_office_conf{debug} && $::lx_office_conf{debug}->{dbix_log4perl};
 
   require Log::Log4perl;
   require DBIx::Log4perl;
@@ -24,7 +19,20 @@ sub connect {
   $config      =~ s/LXDEBUGFILE/${filename}/g;
 
   Log::Log4perl->init(\$config);
-  return DBIx::Log4perl->connect(@_);
+  return DBIx::Log4perl->connect(@args);
+}
+
+sub get_connect_args {
+  my ($self, @args)   = @_;
+  my ($domain, $type) = SL::DB::_register_db(SL::DB->default_domain, 'KIVITENDO');
+  my $db_cfg          = SL::DB->registry->entry(domain => $domain, type => $type) || { };
+
+  return (
+    'dbi:' . $db_cfg->{dbi_driver} . ':dbname=' . $db_cfg->{database} . ';host=' . ($db_cfg->{host} || 'localhost') . ';port=' . ($db_cfg->{port} || 5432),
+    $db_cfg->{username},
+    $db_cfg->{password},
+    $self->get_options(%{ $db_cfg->{connect_options} || {} }, @args),
+  );
 }
 
 sub get_options {
@@ -38,3 +46,70 @@ sub get_options {
 }
 
 1;
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DBConnect - Connect to database for configured client/user,
+optionally routing through DBIx::Log4perl
+
+=head1 SYNOPSIS
+
+  # Connect to default database of current user/client, disabling auto
+  # commit mode:
+  my @options_suitable_for_dbi_connect =
+    SL::DBConnect->get_connect_args(AutoCommit => 0);
+  my $dbh = SL::DBConnect->connect(@options_suitable_for_dbi_connect);
+
+  # Connect to a very specific database:
+  my $dbh = SL::DBConnect->connect('dbi:Pg:dbname=demo', 'user', 'password');
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<connect [@dbi_args]>
+
+Connects to the database. If the configuration parameter
+C<debug.dbix_log4perl> is set then the call is made through
+L<DBIx::Log4per/connect>. Otherwise L<DBI/connect> is called directly.
+
+In each case C<@dbi_args> is passed through as-is.
+
+If C<@dbi_args> are not given they're generated by a call to
+L</get_connect_args>.
+
+=item C<get_connect_args [%options]>
+
+Returns an array of database connection settings suitable to a call to
+L<DBI/connect> or L</connect>. The settings to use are retrieved by
+calling L<SL::DB/_register_db>.
+
+This requires that a client has been set up with
+L<SL::Auth/set_client> or that C<%::myconfig> contains legacy
+connection settings.
+
+C<%options> are optional database options like C<AutoCommit> (fourth
+parameter to L<DBI/connect>). They're merged with default settings by
+filtering them through L/get_options>.
+
+=item C<get_options [%options]>
+
+Returns a hash reference of database options (fourth parameter to
+L<DBI/connect>) merged with certain default options.
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut