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