SL/DBConnect.pm

   1 package SL::DBConnect;
   2
   3 use strict;
   4
   5 use DBI;
   6 use SL::DB;
   7
   8 my %dateformat_to_datestyle = (
   9   'yy-mm-dd'   => 'ISO',
  10   'yyyy-mm-dd' => 'ISO',
  11   'mm/dd/yy'   => 'SQL, US',
  12   'dd/mm/yy'   => 'SQL, EUROPEAN',
  13   'dd.mm.yy'   => 'GERMAN'
  14 );
  15
  16 sub _connect {
  17   my ($self, @args) = @_;
  18   @args = $self->get_connect_args if !@args;
  19
  20   return DBI->connect(@args) unless $::lx_office_conf{debug} && $::lx_office_conf{debug}->{dbix_log4perl};
  21
  22   require Log::Log4perl;
  23   require DBIx::Log4perl;
  24
  25   my $filename =  $::lxdebug->file;
  26   my $config   =  $::lx_office_conf{debug}->{dbix_log4perl_config};
  27   $config      =~ s/LXDEBUGFILE/${filename}/g;
  28
  29   Log::Log4perl->init(\$config);
  30   return DBIx::Log4perl->connect(@args);
  31 }
  32
  33 sub connect {
  34   my ($self, @args) = @_;
  35
  36   my $dbh = $self->_connect(@args);
  37   return undef if !$dbh;
  38
  39   my $initial_sql = $self->get_initial_sql;
  40   $dbh->do($initial_sql) if $initial_sql;
  41
  42   return $dbh;
  43 }
  44
  45 sub get_datestyle {
  46   my ($self, $dateformat) = @_;
  47   return $dateformat_to_datestyle{ $dateformat || $::myconfig{dateformat} // '' };
  48 }
  49
  50 sub get_initial_sql {
  51   my ($self) = @_;
  52
  53   return undef if !%::myconfig || !$::myconfig{dateformat};
  54
  55   my $datestyle = $self->get_datestyle;
  56   return $datestyle ? qq|SET DateStyle to '${datestyle}'| : '';
  57 }
  58
  59 sub get_connect_args {
  60   my ($self, @args)   = @_;
  61   my ($domain, $type) = SL::DB::_register_db(SL::DB->default_domain, 'KIVITENDO');
  62   my $db_cfg          = SL::DB->registry->entry(domain => $domain, type => $type) || { };
  63
  64   return (
  65     'dbi:Pg:dbname=' . $db_cfg->{database} . ';host=' . ($db_cfg->{host} || 'localhost') . ';port=' . ($db_cfg->{port} || 5432),
  66     $db_cfg->{username},
  67     $db_cfg->{password},
  68     $self->get_options(%{ $db_cfg->{connect_options} || {} }, @args),
  69   );
  70 }
  71
  72 sub get_options {
  73   my $self    = shift;
  74   my $options = {
  75     pg_enable_utf8 => 1,
  76     @_
  77   };
  78
  79   return $options;
  80 }
  81
  82 1;
  83 __END__
  84
  85 =pod
  86
  87 =encoding utf8
  88
  89 =head1 NAME
  90
  91 SL::DBConnect - Connect to database for configured client/user,
  92 optionally routing through DBIx::Log4perl
  93
  94 =head1 SYNOPSIS
  95
  96   # Connect to default database of current user/client, disabling auto
  97   # commit mode:
  98   my @options_suitable_for_dbi_connect =
  99     SL::DBConnect->get_connect_args(AutoCommit => 0);
 100   my $dbh = SL::DBConnect->connect(@options_suitable_for_dbi_connect);
 101
 102   # Connect to a very specific database:
 103   my $dbh = SL::DBConnect->connect('dbi:Pg:dbname=demo', 'user', 'password');
 104
 105 =head1 FUNCTIONS
 106
 107 =over 4
 108
 109 =item C<connect [@dbi_args]>
 110
 111 Connects to the database. If the configuration parameter
 112 C<debug.dbix_log4perl> is set then the call is made through
 113 L<DBIx::Log4per/connect>. Otherwise L<DBI/connect> is called directly.
 114
 115 In each case C<@dbi_args> is passed through as-is.
 116
 117 If C<@dbi_args> are not given they're generated by a call to
 118 L</get_connect_args>.
 119
 120 =item C<get_connect_args [%options]>
 121
 122 Returns an array of database connection settings suitable to a call to
 123 L<DBI/connect> or L</connect>. The settings to use are retrieved by
 124 calling L<SL::DB/_register_db>.
 125
 126 This requires that a client has been set up with
 127 L<SL::Auth/set_client> or that C<%::myconfig> contains legacy
 128 connection settings.
 129
 130 C<%options> are optional database options like C<AutoCommit> (fourth
 131 parameter to L<DBI/connect>). They're merged with default settings by
 132 filtering them through L/get_options>.
 133
 134 =item C<get_datestyle [$dateformat]>
 135
 136 Returns the appropriate value for the C<SET DateStyle to...> SQL call
 137 depending on C<$dateformat> (e.g. C<SQL, EUROPEAN> if C<$dateformat>
 138 equals C<dd.mm.yy>). If C<$dateformat> is not given then it defaults
 139 to C<$::myconfig{dateformat}>.
 140
 141 =item C<get_initial_sql>
 142
 143 Returns SQL commands that should be executed right after a connection
 144 has been established. This is usually the call to configure the
 145 C<DateStyle> format used by the database.
 146
 147 =item C<get_options [%options]>
 148
 149 Returns a hash reference of database options (fourth parameter to
 150 L<DBI/connect>) merged with certain default options.
 151
 152 =back
 153
 154 =head1 BUGS
 155
 156 Nothing here yet.
 157
 158 =head1 AUTHOR
 159
 160 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 161
 162 =cut