doc/ Trigram Erweiterung als Musskriterium für das Upgrade genannt
[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 use Scalar::Util qw(blessed);
11
12 use base qw(Rose::DB);
13
14 __PACKAGE__->db_cache_class('Rose::DBx::Cache::Anywhere');
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 'dbpasswd' } 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 occured. 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 execptions and expects
226 the caller to manually check return value and error, and then to process all
227 exceptions as strings. This is very fragile and generally a step backwards from
228 proper exception handling.
229
230 C<with_transaction> only gobbles up exception 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 typoes,
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 rollbacked 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