DB Transaktionen - Fehler nach oben durchreichen
[kivitendo-erp.git] / 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