SL/DB.pm

   1 package SL::DB;
   2
   3 use strict;
   4
   5 use Carp;
   6 use Data::Dumper;
   7 use English qw(-no_match_vars);
   8 use Rose::DB;
   9 use Rose::DBx::Cache::Anywhere;
  10
  11 use base qw(Rose::DB);
  12
  13 __PACKAGE__->db_cache_class('Rose::DBx::Cache::Anywhere');
  14 __PACKAGE__->use_private_registry;
  15
  16 my (%_db_registered);
  17
  18 sub dbi_connect {
  19   shift;
  20
  21   # runtime require to break circular include
  22   require SL::DBConnect;
  23   return SL::DBConnect->connect(@_);
  24 }
  25
  26 sub create {
  27   my $domain = shift || SL::DB->default_domain;
  28   my $type   = shift || SL::DB->default_type;
  29
  30   ($domain, $type) = _register_db($domain, $type);
  31
  32   my $db = __PACKAGE__->new_or_cached(domain => $domain, type => $type);
  33
  34   return $db;
  35 }
  36
  37 sub _register_db {
  38   my $domain = shift;
  39   my $type   = shift;
  40
  41   require SL::DBConnect;
  42   my %specific_connect_settings;
  43   my %common_connect_settings = (
  44     driver           => 'Pg',
  45     european_dates   => ((SL::DBConnect->get_datestyle || '') =~ m/european/i) ? 1 : 0,
  46     connect_options  => {
  47       pg_enable_utf8 => 1,
  48     },
  49   );
  50
  51   if (($type eq 'KIVITENDO_AUTH') && $::auth && $::auth->{DB_config} && $::auth->session_tables_present) {
  52     %specific_connect_settings = (
  53       database        => $::auth->{DB_config}->{db},
  54       host            => $::auth->{DB_config}->{host} || 'localhost',
  55       port            => $::auth->{DB_config}->{port} || 5432,
  56       username        => $::auth->{DB_config}->{user},
  57       password        => $::auth->{DB_config}->{password},
  58     );
  59
  60   } elsif ($::auth && $::auth->client) {
  61     my $client        = $::auth->client;
  62     %specific_connect_settings = (
  63       database        => $client->{dbname},
  64       host            => $client->{dbhost} || 'localhost',
  65       port            => $client->{dbport} || 5432,
  66       username        => $client->{dbuser},
  67       password        => $client->{dbpasswd},
  68     );
  69
  70   } elsif (%::myconfig && $::myconfig{dbname}) {
  71     %specific_connect_settings = (
  72       database        => $::myconfig{dbname},
  73       host            => $::myconfig{dbhost} || 'localhost',
  74       port            => $::myconfig{dbport} || 5432,
  75       username        => $::myconfig{dbuser},
  76       password        => $::myconfig{dbpasswd},
  77     );
  78
  79   } else {
  80     $type = 'KIVITENDO_EMPTY';
  81   }
  82
  83   my %connect_settings   = (%common_connect_settings, %specific_connect_settings);
  84   my %flattened_settings = _flatten_settings(%connect_settings);
  85
  86   $domain                = 'KIVITENDO' if $type =~ m/^KIVITENDO/;
  87   $type                 .= join($SUBSCRIPT_SEPARATOR, map { ($_, $flattened_settings{$_} || '') } sort grep { $_ ne 'dbpasswd' } keys %flattened_settings);
  88   my $idx                = "${domain}::${type}";
  89
  90   if (!$_db_registered{$idx}) {
  91     $_db_registered{$idx} = 1;
  92
  93     __PACKAGE__->register_db(domain => $domain,
  94                              type   => $type,
  95                              %connect_settings,
  96                             );
  97   }
  98
  99   return ($domain, $type);
 100 }
 101
 102 sub _flatten_settings {
 103   my %settings  = @_;
 104   my %flattened = ();
 105
 106   while (my ($key, $value) = each %settings) {
 107     if ('HASH' eq ref $value) {
 108       %flattened = ( %flattened, _flatten_settings(%{ $value }) );
 109     } else {
 110       $flattened{$key} = $value;
 111     }
 112   }
 113
 114   return %flattened;
 115 }
 116
 117 sub with_transaction {
 118   my ($self, $code, @args) = @_;
 119
 120   return $code->(@args) if $self->in_transaction;
 121   if (wantarray) {
 122     my @result;
 123     return $self->do_transaction(sub { @result = $code->(@args) }) ? @result : ();
 124
 125   } else {
 126     my $result;
 127     return $self->do_transaction(sub { $result = $code->(@args) }) ? $result : undef;
 128   }
 129 }
 130
 131 1;
 132 __END__
 133
 134 =pod
 135
 136 =encoding utf8
 137
 138 =head1 NAME
 139
 140 SL::DB - Database access class for all RDB objects
 141
 142 =head1 FUNCTIONS
 143
 144 =over 4
 145
 146 =item C<create $domain, $type>
 147
 148 Registers the database information with Rose, creates a cached
 149 connection and executes initial SQL statements. Those can include
 150 setting the time & date format to the user's preferences.
 151
 152 =item C<dbi_connect $dsn, $login, $password, $options>
 153
 154 Forwards the call to L<SL::DBConnect/connect> which connects to the
 155 database. This indirection allows L<SL::DBConnect/connect> to route
 156 the calls through L<DBIx::Log4Perl> if this is enabled in the
 157 configuration.
 158
 159 =item C<with_transaction $code_ref, @args>
 160
 161 Executes C<$code_ref> with parameters C<@args> within a transaction,
 162 starting one if none is currently active. Example:
 163
 164   return $self->db->with_transaction(sub {
 165     # do stuff with $self
 166   });
 167
 168 One big difference to L<Rose::DB/do_transaction> is the return code
 169 handling. If a transaction is already active then C<with_transaction>
 170 simply returns the result of calling C<$code_ref> as-is.
 171
 172 Otherwise the return value depends on the result of the underlying
 173 transaction. If the transaction fails then C<undef> is returned in
 174 scalar context and an empty list in list context. If the transaction
 175 succeeds then the return value of C<$code_ref> is returned preserving
 176 context.
 177
 178 So if you want to differentiate between "transaction failed" and
 179 "succeeded" then your C<$code_ref> should never return C<undef>
 180 itself.
 181
 182 =back
 183
 184 =head1 BUGS
 185
 186 Nothing here yet.
 187
 188 =head1 AUTHOR
 189
 190 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 191
 192 =cut