Pflichtenheftversion nach Ă„nderung Basisdaten invalidieren
[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 _register_db {
38   my $domain = shift;
39   my $type   = shift;
40
41   require SL::DBConnect;
42   my %specific_connect_settings;
43   my %common_connect_settings = (
44     driver           => 'Pg',
45     european_dates   => ((SL::DBConnect->get_datestyle || '') =~ m/european/i) ? 1 : 0,
46     connect_options  => {
47       pg_enable_utf8 => 1,
48     },
49   );
50
51   if (($type eq 'KIVITENDO_AUTH') && $::auth && $::auth->{DB_config} && $::auth->session_tables_present) {
52     %specific_connect_settings = (
53       database        => $::auth->{DB_config}->{db},
54       host            => $::auth->{DB_config}->{host} || 'localhost',
55       port            => $::auth->{DB_config}->{port} || 5432,
56       username        => $::auth->{DB_config}->{user},
57       password        => $::auth->{DB_config}->{password},
58     );
59
60   } elsif ($::auth && $::auth->client) {
61     my $client        = $::auth->client;
62     %specific_connect_settings = (
63       database        => $client->{dbname},
64       host            => $client->{dbhost} || 'localhost',
65       port            => $client->{dbport} || 5432,
66       username        => $client->{dbuser},
67       password        => $client->{dbpasswd},
68     );
69
70   } elsif (%::myconfig && $::myconfig{dbname}) {
71     %specific_connect_settings = (
72       database        => $::myconfig{dbname},
73       host            => $::myconfig{dbhost} || 'localhost',
74       port            => $::myconfig{dbport} || 5432,
75       username        => $::myconfig{dbuser},
76       password        => $::myconfig{dbpasswd},
77     );
78
79   } else {
80     $type = 'KIVITENDO_EMPTY';
81   }
82
83   my %connect_settings   = (%common_connect_settings, %specific_connect_settings);
84   my %flattened_settings = _flatten_settings(%connect_settings);
85
86   $domain                = 'KIVITENDO' if $type =~ m/^KIVITENDO/;
87   $type                 .= join($SUBSCRIPT_SEPARATOR, map { ($_, $flattened_settings{$_} || '') } sort grep { $_ ne 'dbpasswd' } keys %flattened_settings);
88   my $idx                = "${domain}::${type}";
89
90   if (!$_db_registered{$idx}) {
91     $_db_registered{$idx} = 1;
92
93     __PACKAGE__->register_db(domain => $domain,
94                              type   => $type,
95                              %connect_settings,
96                             );
97   }
98
99   return ($domain, $type);
100 }
101
102 sub _flatten_settings {
103   my %settings  = @_;
104   my %flattened = ();
105
106   while (my ($key, $value) = each %settings) {
107     if ('HASH' eq ref $value) {
108       %flattened = ( %flattened, _flatten_settings(%{ $value }) );
109     } else {
110       $flattened{$key} = $value;
111     }
112   }
113
114   return %flattened;
115 }
116
117 sub with_transaction {
118   my ($self, $code, @args) = @_;
119
120   return $code->(@args) if $self->in_transaction;
121   if (wantarray) {
122     my @result;
123     return $self->do_transaction(sub { @result = $code->(@args) }) ? @result : ();
124
125   } else {
126     my $result;
127     return $self->do_transaction(sub { $result = $code->(@args) }) ? $result : undef;
128   }
129 }
130
131 1;
132 __END__
133
134 =pod
135
136 =encoding utf8
137
138 =head1 NAME
139
140 SL::DB - Database access class for all RDB objects
141
142 =head1 FUNCTIONS
143
144 =over 4
145
146 =item C<create $domain, $type>
147
148 Registers the database information with Rose, creates a cached
149 connection and executes initial SQL statements. Those can include
150 setting the time & date format to the user's preferences.
151
152 =item C<dbi_connect $dsn, $login, $password, $options>
153
154 Forwards the call to L<SL::DBConnect/connect> which connects to the
155 database. This indirection allows L<SL::DBConnect/connect> to route
156 the calls through L<DBIx::Log4Perl> if this is enabled in the
157 configuration.
158
159 =item C<with_transaction $code_ref, @args>
160
161 Executes C<$code_ref> with parameters C<@args> within a transaction,
162 starting one if none is currently active. Example:
163
164   return $self->db->with_transaction(sub {
165     # do stuff with $self
166   });
167
168 One big difference to L<Rose::DB/do_transaction> is the return code
169 handling. If a transaction is already active then C<with_transcation>
170 simply returns the result of calling C<$code_ref> as-is.
171
172 Otherwise the return value depends on the result of the underlying
173 transaction. If the transaction fails then C<undef> is returned in
174 scalar context and an empty list in list context. If the transaction
175 succeeds then the return value of C<$code_ref> is returned preserving
176 context.
177
178 So if you want to differentiate between "transaction failed" and
179 "succeeded" then your C<$code_ref> should never return C<undef>
180 itself.
181
182 =back
183
184 =head1 BUGS
185
186 Nothing here yet.
187
188 =head1 AUTHOR
189
190 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
191
192 =cut