From beb61b2e270836ccd11e00ce68ff884cfb7a530d Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Thu, 6 Jun 2013 15:03:25 +0200 Subject: [PATCH] SL::DBConnect: zu verwendende Datenbankinfos via SL::DB->_register_db erhalten --- SL/DBConnect.pm | 95 +++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 85 insertions(+), 10 deletions(-) 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 + +Connects to the database. If the configuration parameter +C is set then the call is made through +L. Otherwise L 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. + +=item C + +Returns an array of database connection settings suitable to a call to +L or L. The settings to use are retrieved by +calling L. + +This requires that a client has been set up with +L or that C<%::myconfig> contains legacy +connection settings. + +C<%options> are optional database options like C (fourth +parameter to L). They're merged with default settings by +filtering them through L/get_options>. + +=item C + +Returns a hash reference of database options (fourth parameter to +L) merged with certain default options. + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut -- 2.20.1