SL/DBConnect.pm

   1 package SL::DBConnect;
   2
   3 use strict;
   4
   5 use DBI;
   6 use SL::DB;
   7
   8 sub connect {
   9   my ($self, @args) = @_;
  10   @args = $self->get_connect_args if !@args;
  11
  12   return DBI->connect(@args) unless $::lx_office_conf{debug} && $::lx_office_conf{debug}->{dbix_log4perl};
  13
  14   require Log::Log4perl;
  15   require DBIx::Log4perl;
  16
  17   my $filename =  $::lxdebug->file;
  18   my $config   =  $::lx_office_conf{debug}->{dbix_log4perl_config};
  19   $config      =~ s/LXDEBUGFILE/${filename}/g;
  20
  21   Log::Log4perl->init(\$config);
  22   return DBIx::Log4perl->connect(@args);
  23 }
  24
  25 sub get_connect_args {
  26   my ($self, @args)   = @_;
  27   my ($domain, $type) = SL::DB::_register_db(SL::DB->default_domain, 'KIVITENDO');
  28   my $db_cfg          = SL::DB->registry->entry(domain => $domain, type => $type) || { };
  29
  30   return (
  31     'dbi:Pg:dbname=' . $db_cfg->{database} . ';host=' . ($db_cfg->{host} || 'localhost') . ';port=' . ($db_cfg->{port} || 5432),
  32     $db_cfg->{username},
  33     $db_cfg->{password},
  34     $self->get_options(%{ $db_cfg->{connect_options} || {} }, @args),
  35   );
  36 }
  37
  38 sub get_options {
  39   my $self    = shift;
  40   my $options = {
  41     pg_enable_utf8 => $::locale->is_utf8,
  42     @_
  43   };
  44
  45   return $options;
  46 }
  47
  48 1;
  49 __END__
  50
  51 =pod
  52
  53 =encoding utf8
  54
  55 =head1 NAME
  56
  57 SL::DBConnect - Connect to database for configured client/user,
  58 optionally routing through DBIx::Log4perl
  59
  60 =head1 SYNOPSIS
  61
  62   # Connect to default database of current user/client, disabling auto
  63   # commit mode:
  64   my @options_suitable_for_dbi_connect =
  65     SL::DBConnect->get_connect_args(AutoCommit => 0);
  66   my $dbh = SL::DBConnect->connect(@options_suitable_for_dbi_connect);
  67
  68   # Connect to a very specific database:
  69   my $dbh = SL::DBConnect->connect('dbi:Pg:dbname=demo', 'user', 'password');
  70
  71 =head1 FUNCTIONS
  72
  73 =over 4
  74
  75 =item C<connect [@dbi_args]>
  76
  77 Connects to the database. If the configuration parameter
  78 C<debug.dbix_log4perl> is set then the call is made through
  79 L<DBIx::Log4per/connect>. Otherwise L<DBI/connect> is called directly.
  80
  81 In each case C<@dbi_args> is passed through as-is.
  82
  83 If C<@dbi_args> are not given they're generated by a call to
  84 L</get_connect_args>.
  85
  86 =item C<get_connect_args [%options]>
  87
  88 Returns an array of database connection settings suitable to a call to
  89 L<DBI/connect> or L</connect>. The settings to use are retrieved by
  90 calling L<SL::DB/_register_db>.
  91
  92 This requires that a client has been set up with
  93 L<SL::Auth/set_client> or that C<%::myconfig> contains legacy
  94 connection settings.
  95
  96 C<%options> are optional database options like C<AutoCommit> (fourth
  97 parameter to L<DBI/connect>). They're merged with default settings by
  98 filtering them through L/get_options>.
  99
 100 =item C<get_options [%options]>
 101
 102 Returns a hash reference of database options (fourth parameter to
 103 L<DBI/connect>) merged with certain default options.
 104
 105 =back
 106
 107 =head1 BUGS
 108
 109 Nothing here yet.
 110
 111 =head1 AUTHOR
 112
 113 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 114
 115 =cut