7 use SL::DBConnect::Cache;
9 my %dateformat_to_datestyle = (
11 'yyyy-mm-dd' => 'ISO',
12 'mm/dd/yy' => 'SQL, US',
13 'dd/mm/yy' => 'SQL, EUROPEAN',
14 'dd.mm.yy' => 'GERMAN'
18 my ($self, @args) = @_;
19 @args = $self->get_connect_args if !@args;
21 return DBI->connect(@args) unless $::lx_office_conf{debug} && $::lx_office_conf{debug}->{dbix_log4perl};
23 require Log::Log4perl;
24 require DBIx::Log4perl;
26 my $filename = $::lxdebug->file;
27 my $config = $::lx_office_conf{debug}->{dbix_log4perl_config};
28 $config =~ s/LXDEBUGFILE/${filename}/g;
30 Log::Log4perl->init(\$config);
31 return DBIx::Log4perl->connect(@args);
35 my ($self, @args) = @_;
37 if (my $cached_dbh = SL::DBConnect::Cache->get(@args)) {
41 my $dbh = $self->_connect(@args);
42 return undef if !$dbh;
44 my $initial_sql = $self->get_initial_sql;
45 $dbh->do($initial_sql) if $initial_sql;
47 SL::DBConnect::Cache->store($dbh, @args);
53 my ($self, $dateformat) = @_;
54 return $dateformat_to_datestyle{ $dateformat || $::myconfig{dateformat} // '' };
60 return undef if !%::myconfig || !$::myconfig{dateformat};
62 my $datestyle = $self->get_datestyle;
63 return $datestyle ? qq|SET DateStyle to '${datestyle}'| : '';
66 sub get_connect_args {
67 my ($self, @args) = @_;
68 my ($domain, $type) = SL::DB::_register_db(SL::DB->default_domain, 'KIVITENDO');
69 my $db_cfg = SL::DB->registry->entry(domain => $domain, type => $type) || { };
72 'dbi:Pg:dbname=' . $db_cfg->{database} . ';host=' . ($db_cfg->{host} || 'localhost') . ';port=' . ($db_cfg->{port} || 5432),
75 $self->get_options(%{ $db_cfg->{connect_options} || {} }, @args),
98 SL::DBConnect - Connect to database for configured client/user,
99 optionally routing through DBIx::Log4perl
103 # Connect to default database of current user/client, disabling auto
105 my @options_suitable_for_dbi_connect =
106 SL::DBConnect->get_connect_args(AutoCommit => 0);
107 my $dbh = SL::DBConnect->connect(@options_suitable_for_dbi_connect);
109 # Connect to a very specific database:
110 my $dbh = SL::DBConnect->connect('dbi:Pg:dbname=demo', 'user', 'password');
116 =item C<connect [@dbi_args]>
118 Connects to the database. If the configuration parameter
119 C<debug.dbix_log4perl> is set then the call is made through
120 L<DBIx::Log4per/connect>. Otherwise L<DBI/connect> is called directly.
122 In each case C<@dbi_args> is passed through as-is.
124 If C<@dbi_args> are not given they're generated by a call to
125 L</get_connect_args>.
127 =item C<get_connect_args [%options]>
129 Returns an array of database connection settings suitable to a call to
130 L<DBI/connect> or L</connect>. The settings to use are retrieved by
131 calling L<SL::DB/_register_db>.
133 This requires that a client has been set up with
134 L<SL::Auth/set_client> or that C<%::myconfig> contains legacy
137 C<%options> are optional database options like C<AutoCommit> (fourth
138 parameter to L<DBI/connect>). They're merged with default settings by
139 filtering them through L/get_options>.
141 =item C<get_datestyle [$dateformat]>
143 Returns the appropriate value for the C<SET DateStyle to...> SQL call
144 depending on C<$dateformat> (e.g. C<SQL, EUROPEAN> if C<$dateformat>
145 equals C<dd.mm.yy>). If C<$dateformat> is not given then it defaults
146 to C<$::myconfig{dateformat}>.
148 =item C<get_initial_sql>
150 Returns SQL commands that should be executed right after a connection
151 has been established. This is usually the call to configure the
152 C<DateStyle> format used by the database.
154 =item C<get_options [%options]>
156 Returns a hash reference of database options (fourth parameter to
157 L<DBI/connect>) merged with certain default options.
167 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>