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       } elsif ($error->can('rethrow')) {
 146         $error->rethrow;
 147       } else {
 148         croak $self->error;
 149       }
 150     } else {
 151       die $self->error;
 152     }
 153   };
 154
 155   return $return_array ? @result : $result;
 156 }
 157
 158 1;
 159 __END__
 160
 161 =pod
 162
 163 =encoding utf8
 164
 165 =head1 NAME
 166
 167 SL::DB - Database access class for all RDB objects
 168
 169 =head1 FUNCTIONS
 170
 171 =over 4
 172
 173 =item C<create $domain, $type>
 174
 175 Registers the database information with Rose, creates a cached
 176 connection and executes initial SQL statements. Those can include
 177 setting the time & date format to the user's preferences.
 178
 179 =item C<dbi_connect $dsn, $login, $password, $options>
 180
 181 Forwards the call to L<SL::DBConnect/connect> which connects to the
 182 database. This indirection allows L<SL::DBConnect/connect> to route
 183 the calls through L<DBIx::Log4Perl> if this is enabled in the
 184 configuration.
 185
 186 =item C<with_transaction $code_ref, @args>
 187
 188 Executes C<$code_ref> with parameters C<@args> within a transaction,
 189 starting one only if none is currently active. Example:
 190
 191   return $self->db->with_transaction(sub {
 192     # do stuff with $self
 193   });
 194
 195 This is a wrapper around L<Rose::DB/do_transaction> that does a few additional
 196 things, and should always be used in favour of the other:
 197
 198 =over 4
 199
 200 =item Composition of transactions
 201
 202 When C<with_transaction> is called without a running transaction, a new one is
 203 created. If it is called within a running transaction, it performs no
 204 additional handling. This means that C<with_transaction> can be safely used
 205 within another C<with_transaction>, whereas L<Rose::DB/do_transaction> can not.
 206
 207 =item Return values
 208
 209 C<with_transaction> adopts the behaviour of C<eval> in that it returns the
 210 result of the inner block, and C<undef> if an error occurred. This way you can
 211 use the same pattern you would normally use with C<eval> for
 212 C<with_transaction>:
 213
 214   SL::DB->client->with_transaction(sub {
 215      # do stuff
 216      # and return nominal true value
 217      1;
 218   }) or do {
 219     # transaction error handling
 220     my $error = SL::DB->client->error;
 221   }
 222
 223 or you can use it to safely calulate things.
 224
 225 =item Error handling
 226
 227 The original L<Rose::DB/do_transaction> gobbles up all exceptions and expects
 228 the caller to manually check the return value and error, and then to process
 229 all exceptions as strings. This is very fragile and generally a step backwards
 230 from proper exception handling.
 231
 232 C<with_transaction> only gobbles up exceptions that are used to signal an
 233 error in the transaction, and returns undef on those. All other exceptions
 234 bubble out of the transaction like normal, so that it is transparent to typos,
 235 runtime exceptions and other generally wanted things.
 236
 237 If you just use the snippet above, your code will catch everything related to
 238 the transaction aborting, but will not catch other errors that might have been
 239 thrown. The transaction will be rolled back in both cases.
 240
 241 If you want to play nice in case your transaction is embedded in another
 242 transaction, just rethrow the error:
 243
 244   $db->with_transaction(sub {
 245     # code deep in the engine
 246     1;
 247   }) or die $db->error;
 248
 249 =back
 250
 251 =back
 252
 253 =head1 BUGS
 254
 255 Nothing here yet.
 256
 257 =head1 AUTHOR
 258
 259 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 260
 261 =cut