Pflichtenheft: Zugriff auf nicht vorhandenes »visible_item« verhindern
[kivitendo-erp.git] / SL / Helper / UserPreferences.pm
1 package SL::Helper::UserPreferences;
2
3 use strict;
4 use parent qw(Rose::Object);
5 use version;
6
7 use SL::DBUtils qw(selectall_hashref_query selectfirst_hashref_query do_query selectall_ids);
8
9 use Rose::Object::MakeMethods::Generic (
10  'scalar --get_set_init' => [ qw(login namespace upgrade_callbacks current_version auto_store_back) ],
11 );
12
13 sub store {
14   my ($self, $key, $value) = @_;
15
16   my $tuple = $self->get_tuple($key);
17
18   if ($tuple) {
19     $tuple->{value}  = $value;
20     $self->_update($tuple);
21   } else {
22     my $query = 'INSERT INTO user_preferences (login, namespace, version, key, value) VALUES (?, ?, ?, ?, ?)';
23     do_query($::form, $::form->get_standard_dbh, $query, $self->login, $self->namespace, $self->current_version, $key, $value);
24   }
25 }
26
27 sub get {
28   my ($self, $key) = @_;
29
30   my $tuple = $self->get_tuple($key);
31
32   $tuple ? $tuple->{value} : undef;
33 }
34
35 sub get_tuple {
36   my ($self, $key) = @_;
37
38   my $tuple = selectfirst_hashref_query($::form, $::form->get_standard_dbh, <<"", $self->login, $self->namespace, $key);
39     SELECT * FROM user_preferences WHERE login = ? AND namespace = ? AND key = ?
40
41   if ($tuple && $tuple->{version} < $self->current_version) {
42     $self->_upgrade($tuple);
43   }
44
45   if ($tuple && $tuple->{version} > $self->current_version) {
46     die "Future version $tuple->{version} for user preference @{ $self->namespace }/$key. Expected @{ $self->current_version } or less.";
47   }
48
49   return $tuple;
50 }
51
52 sub get_all {
53   my ($self) = @_;
54
55   my $data = selectall_hashref_query($::form, $::form->get_standard_dbh, <<"", $self->login, $self->namespace);
56     SELECT * FROM user_preferences WHERE login = ? AND namespace = ?
57
58   for my $tuple (@$data) {
59     if ($tuple->{version} < $self->current_version) {
60       $self->_upgrade($tuple);
61     }
62
63     if ($tuple->{version} > $self->current_version) {
64       die "Future version $tuple->{version} for user preference @{ $self->namespace }/$tuple->{key}. Expected @{ $self->current_version } or less.";
65     }
66   }
67
68   return $data;
69 }
70
71 sub get_keys {
72   my ($self) = @_;
73
74   my @keys = selectall_ids($::form, $::form->get_standard_dbh, <<"", 0, $self->login, $self->namespace);
75     SELECT key FROM user_preferences WHERE login = ? AND namespace = ?
76
77   return @keys;
78 }
79
80 sub delete {
81   my ($self, $key) = @_;
82
83   die 'delete without  key is not allowed, use delete_all instead' unless $key;
84
85   my @keys = do_query($::form, $::form->get_standard_dbh, <<"", $self->login, $self->namespace, $key);
86     DELETE FROM user_preferences WHERE login = ? AND namespace = ? AND key = ?
87
88 }
89
90 sub delete_all {
91   my ($self, $key) = @_;
92
93   my @keys = do_query($::form, $::form->get_standard_dbh, <<"", $self->login, $self->namespace);
94     DELETE FROM user_preferences WHERE login = ? AND namespace = ?
95
96 }
97
98 ### internal stuff
99
100 sub _upgrade {
101   my ($self, $tuple) = @_;
102
103   for my $to_version (sort { $a <=> $b } grep { $_ > $tuple->{version} } keys %{ $self->upgrade_callbacks }) {
104     $tuple->{value}   = $self->upgrade_callbacks->{$to_version}->($tuple->{value});
105     $tuple->{version} = $to_version;
106   }
107
108   if ($self->auto_store_back) {
109     $self->_update($tuple);
110   }
111 }
112
113 sub _update {
114   my ($self, $tuple) = @_;
115
116   my $query = 'UPDATE user_preferences SET version = ?, value = ? WHERE id = ?';
117   do_query($::form, $::form->get_standard_dbh, $query, $tuple->{version}, $tuple->{value}, $tuple->{id});
118 }
119
120 ### defaults stuff
121
122 sub init_login             { SL::DB::Manager::Employee->current->login    }
123 sub init_namespace         { ref $_[0]                                    }
124 sub init_upgrade_callbacks { +{}                                          }
125 sub init_current_version   { version->parse((ref $_[0])->VERSION)->numify }
126 sub init_auto_store_back   { 1                                            }
127
128 1;
129
130 __END__
131
132 =encoding utf-8
133
134 =head1 NAME
135
136 SL::Helper::UserPreferences - user based preferences store
137
138 =head1 SYNOPSIS
139
140   use SL::Helper::UserPreferences;
141   my $user_pref = SL::Helper::UserPreferences->new(
142     login             => $login,        # defaults to current user
143     namespace         => $namespace,    # defaults to current package
144     upgrade_callbacks => $upgrade_callbacks,
145     current_version   => $version,      # defaults to __PACKAGE__->VERSION->numify
146     auto_store_back   => 0,             # default 1
147   );
148
149   $user_pref->store($key, $value);
150   my $val    = $user_pref->get($key);
151   my $tuple  = $user_pref->get_tuple($key);
152   my $tuples = $user_pref->get_all;
153   my $keys   = $user_pref->get_keys;
154   $user_pref->delete($key);
155   $user_pref->delete_all;
156
157 =head1 DESCRIPTION
158
159 This module provides a generic storage for information that needs to be stored
160 between sessions per user and per client and between versions of the program.
161
162 The storage can be accessed as a generic key/value dictionary, but also
163 requires a namespace to avoid clashes and a version of the information.
164 Additionally you must provide means to upgrade or invalidate stored information
165 that is out of date, i.e. after a program upgrade.
166
167 =head1 FUNCTIONS
168
169 =over 4
170
171 =item C<new PARAMS>
172
173 Creates a new instance. Available C<PARAMS>:
174
175 =over 4
176
177 =item C<login>
178
179 The user for this storage. Defaults to current user login.
180
181 =item C<namespace>
182
183 A unique namespace. Defaults to the calling package.
184
185 =item C<upgrade_callbacks>
186
187 A hashref with version numbers as keys and subs as values. These subs are
188 expected to take a value and return an upgraded value for the version of their
189 key.
190
191 No default. Mandatory.
192
193 =item C<current_version>
194
195 The version object that is considered current for stored information. Defaults
196 to the version of the calling package. MUST be a number, and not a version
197 object, so that versions can be used as hash keys in the ugrade_callbacks.
198
199 =item C<auto_store_back>
200
201 An otional flag indicating whether values from the database that were upgraded to a
202 newer version should be stored back automatically. Defaults to
203 C<$::lx_office_conf{debug}{auto_store_back_upgraded_user_preferences}> which in
204 turn defaults to true.
205
206 =back
207
208 =item C<store KEY VALUE>
209
210 Stores a key-value tuple. If there exists already a value for this key, it will
211 be overwritten.
212
213 =item C<get KEY>
214
215 Retrieves a value.
216
217 Returns the value. If no such value exists returns undef instead.
218
219 This is for easy of use, and does no distinction between non-existing values
220 and valid undefined values. Use C<get_tuple> if you need this.
221
222 =item C<get_tuple KEY>
223
224 Retrieves a key-value tuple.
225
226 Returns a hashref with C<key> and C<value> entries. If no such value
227 exists returns undef instead.
228
229 =item C<get_all>
230
231 Retrieve all key-value tuples in this namespace and user.
232
233 Returns an arrayref of hashrefs.
234
235 =item C<get_keys>
236
237 Retrieve all keys for this namespace. Note: Unless you store vast amount of
238 data, it's most likely easier to just C<get_all>.
239
240 Returns an arrayref of keys.
241
242 =item C<delete KEY>
243
244 Deletes a tuple.
245
246 =item C<delete_all>
247
248 Delete all tuples for this namespace and user.
249
250 =back
251
252 =head1 VERSIONING
253
254 Every entry in the user prefs must have a version to be compatible in case of
255 code upgrades.
256
257 Code reading user prefs must check if the version is the expected one, and must
258 have upgrade code to upgrade out of date preferences to the current version.
259
260 Code SHOULD write the upgraded version back to the store at the earliest time
261 to keep preferences up to date. This should be able to be disabled to have
262 developer versions not overwrite preferences with unsupported versions.
263
264 Example:
265
266 Initial code dealing with prefs:
267
268   our $VERSION = v1;
269
270   $user_prefs->store("selected tab", $::form->{selected_tab});
271
272 And the someone edits the code and removes the tab "Webdav". To ensure
273 favorites with webdav selected are upgraded:
274
275   our $VERSION = v2;
276
277   my $upgrade_callbacks = {
278     2 => sub { $_[0] eq 'WebDav' ? 'MasterData' : $_[0]; },
279   };
280
281   my $val = $user_prefs->get("selected tab");
282
283 =head1 LACK OF TYPING
284
285 This controller will not attempt to preserve types. All data will be
286 stringified. If your code needs to preserve numbers, you MUST encode the data
287 to JSON or YAML before storing.
288
289 =head1 PLANNED BEST PRACTICE
290
291 To be able to decouple controllers and the schema upgrading required for this,
292 there should be exactly one module responsible for managing user preferences for
293 each namespace. You should find the corresponding preferences owners in the
294 class namespace C<SL::Helper::UserPreferences>.
295
296 For example the namespace C<PartsSearchFavorites> should only be managed by
297 C<SL::Helper::UserPreferences::PartsSearchFavorites>. This way, it's possible
298 to keep the upgrades in one place, and to migrate upgrades out of there into
299 database upgrades during major releases. They also don't clutter up
300 controllers.
301
302 It is planned to strip all modules located there of their upgrade for a release
303 and do automatic database upgrades.
304
305 To avoid version clashes when developing customer branches, please only use
306 stable version bumps in the unstable branch, and use dev versions in customer
307 branches.
308
309 =head1 BEHAVIOUR
310
311 =over 4
312
313 =item *
314
315 If a (namepace, key) tuple exists, a store will overwrite the last version
316
317 =item *
318
319 If the value retrieved from the database is newer than the code version, an
320 error must be thrown.
321
322 =item *
323
324 get will check the version against the current version and apply all upgrade
325 steps.
326
327 =item *
328
329 If the final step is not the current version, behaviour is undefined
330
331 =item *
332
333 get_all will always return scalar context.
334
335 =back
336
337 =head1 TODO AND SPECIAL CASES
338
339 * not defined whether it should be possible to retrieve the version of a tuple
340
341 * it's not specified how to return invalidation from upgrade, nor how to handle
342   that
343
344 * it's not specified whether admin is a user. for now it dies.
345
346 * We're missing user agnostic methods for database upgrades
347
348 =head1 BUGS
349
350 None yet :)
351
352 =head1 AUTHOR
353
354 Sven Schöling <s.schoeling@linet-services.de>
355
356 =cut