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 SL::DB::Helper::Cache;
  10 use Scalar::Util qw(blessed);
  11
  12 use base qw(Rose::DB);
  13
  14 __PACKAGE__->db_cache_class('SL::DB::Helper::Cache');
  15 __PACKAGE__->use_private_registry;
  16
  17 my (%_db_registered);
  18
  19 sub dbi_connect {
  20   shift;
  21
  22   # runtime require to break circular include
  23   require SL::DBConnect;
  24   return SL::DBConnect->connect(@_);
  25 }
  26
  27 sub create {
  28   my $domain = shift || SL::DB->default_domain;
  29   my $type   = shift || SL::DB->default_type;
  30
  31   ($domain, $type) = _register_db($domain, $type);
  32
  33   my $db = __PACKAGE__->new_or_cached(domain => $domain, type => $type);
  34
  35   return $db;
  36 }
  37
  38 sub client {
  39   create(undef, 'KIVITENDO');
  40 }
  41
  42 sub auth {
  43   create(undef, 'KIVITENDO_AUTH');
  44 }
  45
  46 sub _register_db {
  47   my $domain = shift;
  48   my $type   = shift;
  49
  50   require SL::DBConnect;
  51   my %specific_connect_settings;
  52   my %common_connect_settings = (
  53     driver           => 'Pg',
  54     european_dates   => ((SL::DBConnect->get_datestyle || '') =~ m/european/i) ? 1 : 0,
  55     connect_options  => {
  56       pg_enable_utf8 => 1,
  57     },
  58   );
  59
  60   if (($type eq 'KIVITENDO_AUTH') && $::auth && $::auth->{DB_config} && $::auth->session_tables_present) {
  61     %specific_connect_settings = (
  62       database        => $::auth->{DB_config}->{db},
  63       host            => $::auth->{DB_config}->{host} || 'localhost',
  64       port            => $::auth->{DB_config}->{port} || 5432,
  65       username        => $::auth->{DB_config}->{user},
  66       password        => $::auth->{DB_config}->{password},
  67     );
  68
  69   } elsif ($::auth && $::auth->client) {
  70     my $client        = $::auth->client;
  71     %specific_connect_settings = (
  72       database        => $client->{dbname},
  73       host            => $client->{dbhost} || 'localhost',
  74       port            => $client->{dbport} || 5432,
  75       username        => $client->{dbuser},
  76       password        => $client->{dbpasswd},
  77     );
  78
  79   } elsif (%::myconfig && $::myconfig{dbname}) {
  80     %specific_connect_settings = (
  81       database        => $::myconfig{dbname},
  82       host            => $::myconfig{dbhost} || 'localhost',
  83       port            => $::myconfig{dbport} || 5432,
  84       username        => $::myconfig{dbuser},
  85       password        => $::myconfig{dbpasswd},
  86     );
  87
  88   } else {
  89     $type = 'KIVITENDO_EMPTY';
  90   }
  91
  92   my %connect_settings   = (%common_connect_settings, %specific_connect_settings);
  93   my %flattened_settings = _flatten_settings(%connect_settings);
  94
  95   $domain                = 'KIVITENDO' if $type =~ m/^KIVITENDO/;
  96   $type                 .= join($SUBSCRIPT_SEPARATOR, map { ($_, $flattened_settings{$_} || '') } sort grep { $_ ne 'password' } keys %flattened_settings);
  97   my $idx                = "${domain}::${type}";
  98
  99   if (!$_db_registered{$idx}) {
 100     $_db_registered{$idx} = 1;
 101
 102     __PACKAGE__->register_db(domain => $domain,
 103                              type   => $type,
 104                              %connect_settings,
 105                             );
 106   }
 107
 108   return ($domain, $type);
 109 }
 110
 111 sub _flatten_settings {
 112   my %settings  = @_;
 113   my %flattened = ();
 114
 115   while (my ($key, $value) = each %settings) {
 116     if ('HASH' eq ref $value) {
 117       %flattened = ( %flattened, _flatten_settings(%{ $value }) );
 118     } else {
 119       $flattened{$key} = $value;
 120     }
 121   }
 122
 123   return %flattened;
 124 }
 125
 126 sub with_transaction {
 127   my ($self, $code, @args) = @_;
 128
 129   return $code->(@args) if $self->in_transaction;
 130
 131   my (@result, $result);
 132   my $rv = 1;
 133
 134   local $@;
 135   my $return_array = wantarray;
 136   eval {
 137     $return_array
 138       ? $self->do_transaction(sub { @result = $code->(@args) })
 139       : $self->do_transaction(sub { $result = $code->(@args) });
 140   } or do {
 141     my $error = $self->error;
 142     if (blessed $error) {
 143       if ($error->isa('SL::X::DBError')) {
 144         # gobble the exception
 145       } else {
 146         $error->rethrow;
 147       }
 148     } else {
 149       die $self->error;
 150     }
 151   };
 152
 153   return $return_array ? @result : $result;
 154 }
 155
 156 1;
 157 __END__
 158
 159 =pod
 160
 161 =encoding utf8
 162
 163 =head1 NAME
 164
 165 SL::DB - Database access class for all RDB objects
 166
 167 =head1 FUNCTIONS
 168
 169 =over 4
 170
 171 =item C<create $domain, $type>
 172
 173 Registers the database information with Rose, creates a cached
 174 connection and executes initial SQL statements. Those can include
 175 setting the time & date format to the user's preferences.
 176
 177 =item C<dbi_connect $dsn, $login, $password, $options>
 178
 179 Forwards the call to L<SL::DBConnect/connect> which connects to the
 180 database. This indirection allows L<SL::DBConnect/connect> to route
 181 the calls through L<DBIx::Log4Perl> if this is enabled in the
 182 configuration.
 183
 184 =item C<with_transaction $code_ref, @args>
 185
 186 Executes C<$code_ref> with parameters C<@args> within a transaction,
 187 starting one only if none is currently active. Example:
 188
 189   return $self->db->with_transaction(sub {
 190     # do stuff with $self
 191   });
 192
 193 This is a wrapper around L<Rose::DB/do_transaction> that does a few additional
 194 things, and should always be used in favour of the other:
 195
 196 =over 4
 197
 198 =item Composition of transactions
 199
 200 When C<with_transaction> is called without a running transaction, a new one is
 201 created. If it is called within a running transaction, it performs no
 202 additional handling. This means that C<with_transaction> can be safely used
 203 within another C<with_transaction>, whereas L<Rose::DB/do_transaction> can not.
 204
 205 =item Return values
 206
 207 C<with_transaction> adopts the behaviour of C<eval> in that it returns the
 208 result of the inner block, and C<undef> if an error occurred. This way you can
 209 use the same pattern you would normally use with C<eval> for
 210 C<with_transaction>:
 211
 212   SL::DB->client->with_transaction(sub {
 213      # do stuff
 214      # and return nominal true value
 215      1;
 216   }) or do {
 217     # transaction error handling
 218     my $error = SL::DB->client->error;
 219   }
 220
 221 or you can use it to safely calulate things.
 222
 223 =item Error handling
 224
 225 The original L<Rose::DB/do_transaction> gobbles up all exceptions and expects
 226 the caller to manually check the return value and error, and then to process
 227 all exceptions as strings. This is very fragile and generally a step backwards
 228 from proper exception handling.
 229
 230 C<with_transaction> only gobbles up exceptions that are used to signal an
 231 error in the transaction, and returns undef on those. All other exceptions
 232 bubble out of the transaction like normal, so that it is transparent to typos,
 233 runtime exceptions and other generally wanted things.
 234
 235 If you just use the snippet above, your code will catch everything related to
 236 the transaction aborting, but will not catch other errors that might have been
 237 thrown. The transaction will be rolled back in both cases.
 238
 239 If you want to play nice in case your transaction is embedded in another
 240 transaction, just rethrow the error:
 241
 242   $db->with_transaction(sub {
 243     # code deep in the engine
 244     1;
 245   }) or die $db->error;
 246
 247 =back
 248
 249 =back
 250
 251 =head1 BUGS
 252
 253 Nothing here yet.
 254
 255 =head1 AUTHOR
 256
 257 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 258
 259 =cut