kivitendo/SL/Helper/UserPreferences.pm @ b45625dd
| 8d24868f | Sven Schöling | package SL::Helper::UserPreferences;
|
|
use strict;
|
|||
use parent qw(Rose::Object);
|
|||
use version;
|
|||
use SL::DBUtils qw(selectall_hashref_query selectfirst_hashref_query do_query selectall_ids);
|
|||
use Rose::Object::MakeMethods::Generic (
|
|||
'scalar --get_set_init' => [ qw(login namespace upgrade_callbacks current_version auto_store_back) ],
|
|||
);
|
|||
sub store {
|
|||
my ($self, $key, $value) = @_;
|
|||
my $tuple = $self->get_tuple($key);
|
|||
if ($tuple) {
|
|||
$tuple->{value} = $value;
|
|||
$self->_update($tuple);
|
|||
} else {
|
|||
my $query = 'INSERT INTO user_preferences (login, namespace, version, key, value) VALUES (?, ?, ?, ?, ?)';
|
|||
do_query($::form, $::form->get_standard_dbh, $query, $self->login, $self->namespace, $self->current_version, $key, $value);
|
|||
}
|
|||
}
|
|||
sub get {
|
|||
my ($self, $key) = @_;
|
|||
my $tuple = $self->get_tuple($key);
|
|||
$tuple ? $tuple->{value} : undef;
|
|||
}
|
|||
sub get_tuple {
|
|||
my ($self, $key) = @_;
|
|||
my $tuple = selectfirst_hashref_query($::form, $::form->get_standard_dbh, <<"", $self->login, $self->namespace, $key);
|
|||
SELECT * FROM user_preferences WHERE login = ? AND namespace = ? AND key = ?
|
|||
if ($tuple && $tuple->{version} < $self->current_version) {
|
|||
$self->_upgrade($tuple);
|
|||
}
|
|||
if ($tuple && $tuple->{version} > $self->current_version) {
|
|||
die "Future version $tuple->{version} for user preference @{ $self->namespace }/$key. Expected @{ $self->current_version } or less.";
|
|||
}
|
|||
return $tuple;
|
|||
}
|
|||
sub get_all {
|
|||
my ($self) = @_;
|
|||
my $data = selectall_hashref_query($::form, $::form->get_standard_dbh, <<"", $self->login, $self->namespace);
|
|||
SELECT * FROM user_preferences WHERE login = ? AND namespace = ?
|
|||
for my $tuple (@$data) {
|
|||
if ($tuple->{version} < $self->current_version) {
|
|||
$self->_upgrade($tuple);
|
|||
}
|
|||
if ($tuple->{version} > $self->current_version) {
|
|||
die "Future version $tuple->{version} for user preference @{ $self->namespace }/$tuple->{key}. Expected @{ $self->current_version } or less.";
|
|||
}
|
|||
}
|
|||
return $data;
|
|||
}
|
|||
sub get_keys {
|
|||
my ($self) = @_;
|
|||
my @keys = selectall_ids($::form, $::form->get_standard_dbh, <<"", 0, $self->login, $self->namespace);
|
|||
SELECT key FROM user_preferences WHERE login = ? AND namespace = ?
|
|||
return @keys;
|
|||
}
|
|||
sub delete {
|
|||
my ($self, $key) = @_;
|
|||
die 'delete without key is not allowed, use delete_all instead' unless $key;
|
|||
my @keys = do_query($::form, $::form->get_standard_dbh, <<"", $self->login, $self->namespace, $key);
|
|||
DELETE FROM user_preferences WHERE login = ? AND namespace = ? AND key = ?
|
|||
}
|
|||
sub delete_all {
|
|||
my ($self, $key) = @_;
|
|||
my @keys = do_query($::form, $::form->get_standard_dbh, <<"", $self->login, $self->namespace);
|
|||
DELETE FROM user_preferences WHERE login = ? AND namespace = ?
|
|||
}
|
|||
### internal stuff
|
|||
sub _upgrade {
|
|||
my ($self, $tuple) = @_;
|
|||
for my $to_version (sort { $a <=> $b } grep { $_ > $tuple->{version} } keys %{ $self->upgrade_callbacks }) {
|
|||
$tuple->{value} = $self->upgrade_callbacks->{$to_version}->($tuple->{value});
|
|||
$tuple->{version} = $to_version;
|
|||
}
|
|||
if ($self->auto_store_back) {
|
|||
$self->_update($tuple);
|
|||
}
|
|||
}
|
|||
sub _update {
|
|||
my ($self, $tuple) = @_;
|
|||
my $query = 'UPDATE user_preferences SET version = ?, value = ? WHERE id = ?';
|
|||
do_query($::form, $::form->get_standard_dbh, $query, $tuple->{version}, $tuple->{value}, $tuple->{id});
|
|||
}
|
|||
### defaults stuff
|
|||
sub init_login { SL::DB::Manager::Employee->current->login }
|
|||
sub init_namespace { ref $_[0] }
|
|||
sub init_upgrade_callbacks { +{} }
|
|||
sub init_current_version { version->parse((ref $_[0])->VERSION)->numify }
|
|||
sub init_auto_store_back { 1 }
|
|||
1;
|
|||
__END__
|
|||
=encoding utf-8
|
|||
=head1 NAME
|
|||
SL::Helper::UserPreferences - user based preferences store
|
|||
=head1 SYNOPSIS
|
|||
use SL::Helper::UserPreferences;
|
|||
my $user_pref = SL::Helper::UserPreferences->new(
|
|||
login => $login, # defaults to current user
|
|||
namespace => $namespace, # defaults to current package
|
|||
upgrade_callbacks => $upgrade_callbacks,
|
|||
current_version => $version, # defaults to __PACKAGE__->VERSION->numify
|
|||
auto_store_back => 0, # default 1
|
|||
);
|
|||
$user_pref->store($key, $value);
|
|||
my $val = $user_pref->get($key);
|
|||
my $tuple = $user_pref->get_tuple($key);
|
|||
my $tuples = $user_pref->get_all;
|
|||
my $keys = $user_pref->get_keys;
|
|||
$user_pref->delete($key);
|
|||
$user_pref->delete_all;
|
|||
=head1 DESCRIPTION
|
|||
This module provides a generic storage for information that needs to be stored
|
|||
between sessions per user and per client and between versions of the program.
|
|||
The storage can be accessed as a generic key/value dictionary, but also
|
|||
requires a namespace to avoid clashes and a version of the information.
|
|||
Additionally you must provide means to upgrade or invalidate stored information
|
|||
that is out of date, i.e. after a program upgrade.
|
|||
=head1 FUNCTIONS
|
|||
=over 4
|
|||
=item C<new PARAMS>
|
|||
Creates a new instance. Available C<PARAMS>:
|
|||
=over 4
|
|||
=item C<login>
|
|||
The user for this storage. Defaults to current user login.
|
|||
=item C<namespace>
|
|||
A unique namespace. Defaults to the calling package.
|
|||
=item C<upgrade_callbacks>
|
|||
A hashref with version numbers as keys and subs as values. These subs are
|
|||
expected to take a value and return an upgraded value for the version of their
|
|||
key.
|
|||
No default. Mandatory.
|
|||
=item C<current_version>
|
|||
The version object that is considered current for stored information. Defaults
|
|||
to the version of the calling package. MUST be a number, and not a version
|
|||
object, so that versions can be used as hash keys in the ugrade_callbacks.
|
|||
=item C<auto_store_back>
|
|||
An otional flag indicating whether values from the database that were upgraded to a
|
|||
newer version should be stored back automatically. Defaults to
|
|||
C<$::lx_office_conf{debug}{auto_store_back_upgraded_user_preferences}> which in
|
|||
turn defaults to true.
|
|||
=back
|
|||
=item C<store KEY VALUE>
|
|||
Stores a key-value tuple. If there exists already a value for this key, it will
|
|||
be overwritten.
|
|||
=item C<get KEY>
|
|||
Retrieves a value.
|
|||
Returns the value. If no such value exists returns undef instead.
|
|||
This is for easy of use, and does no distinction between non-existing values
|
|||
and valid undefined values. Use C<get_tuple> if you need this.
|
|||
=item C<get_tuple KEY>
|
|||
Retrieves a key-value tuple.
|
|||
Returns a hashref with C<key> and C<value> entries. If no such value
|
|||
exists returns undef instead.
|
|||
=item C<get_all>
|
|||
Retrieve all key-value tuples in this namespace and user.
|
|||
Returns an arrayref of hashrefs.
|
|||
=item C<get_keys>
|
|||
Retrieve all keys for this namespace. Note: Unless you store vast amount of
|
|||
data, it's most likely easier to just C<get_all>.
|
|||
Returns an arrayref of keys.
|
|||
=item C<delete KEY>
|
|||
Deletes a tuple.
|
|||
=item C<delete_all>
|
|||
Delete all tuples for this namespace and user.
|
|||
=back
|
|||
=head1 VERSIONING
|
|||
Every entry in the user prefs must have a version to be compatible in case of
|
|||
code upgrades.
|
|||
Code reading user prefs must check if the version is the expected one, and must
|
|||
have upgrade code to upgrade out of date preferences to the current version.
|
|||
Code SHOULD write the upgraded version back to the store at the earliest time
|
|||
to keep preferences up to date. This should be able to be disabled to have
|
|||
developer versions not overwrite preferences with unsupported versions.
|
|||
Example:
|
|||
Initial code dealing with prefs:
|
|||
our $VERSION = v1;
|
|||
$user_prefs->store("selected tab", $::form->{selected_tab});
|
|||
And the someone edits the code and removes the tab "Webdav". To ensure
|
|||
favorites with webdav selected are upgraded:
|
|||
our $VERSION = v2;
|
|||
my $upgrade_callbacks = {
|
|||
2 => sub { $_[0] eq 'WebDav' ? 'MasterData' : $_[0]; },
|
|||
};
|
|||
my $val = $user_prefs->get("selected tab");
|
|||
=head1 LACK OF TYPING
|
|||
This controller will not attempt to preserve types. All data will be
|
|||
stringified. If your code needs to preserve numbers, you MUST encode the data
|
|||
to JSON or YAML before storing.
|
|||
=head1 PLANNED BEST PRACTICE
|
|||
To be able to decouple controllers and the schema upgrading required for this,
|
|||
there should be exactly one module responsible for managing user preferences for
|
|||
each namespace. You should find the corresponding preferences owners in the
|
|||
class namespace C<SL::Helper::UserPreferences>.
|
|||
For example the namespace C<PartsSearchFavorites> should only be managed by
|
|||
C<SL::Helper::UserPreferences::PartsSearchFavorites>. This way, it's possible
|
|||
to keep the upgrades in one place, and to migrate upgrades out of there into
|
|||
database upgrades during major releases. They also don't clutter up
|
|||
controllers.
|
|||
It is planned to strip all modules located there of their upgrade for a release
|
|||
and do automatic database upgrades.
|
|||
To avoid version clashes when developing customer branches, please only use
|
|||
stable version bumps in the unstable branch, and use dev versions in customer
|
|||
branches.
|
|||
=head1 BEHAVIOUR
|
|||
=over 4
|
|||
=item *
|
|||
If a (namepace, key) tuple exists, a store will overwrite the last version
|
|||
=item *
|
|||
If the value retrieved from the database is newer than the code version, an
|
|||
error must be thrown.
|
|||
=item *
|
|||
get will check the version against the current version and apply all upgrade
|
|||
steps.
|
|||
=item *
|
|||
If the final step is not the current version, behaviour is undefined
|
|||
=item *
|
|||
get_all will always return scalar context.
|
|||
=back
|
|||
=head1 TODO AND SPECIAL CASES
|
|||
* not defined whether it should be possible to retrieve the version of a tuple
|
|||
* it's not specified how to return invalidation from upgrade, nor how to handle
|
|||
that
|
|||
* it's not specified whether admin is a user. for now it dies.
|
|||
* We're missing user agnostic methods for database upgrades
|
|||
=head1 BUGS
|
|||
None yet :)
|
|||
=head1 AUTHOR
|
|||
Sven Schöling <s.schoeling@linet-services.de>
|
|||
=cut
|