Upgrade-Doku: Hinweis auf benötigtes Perl-Modul IPC::Run
[kivitendo-erp.git] / SL / DB / Helper / CustomVariables.pm
1 package SL::DB::Helper::CustomVariables;
2
3 use strict;
4 use Carp;
5 use Data::Dumper;
6 use List::Util qw(first);
7 use List::UtilsBy qw(partition_by);
8
9 use constant META_CVARS => 'cvars_config';
10
11 sub import {
12   my ($class, %params) = @_;
13   my $caller_package = caller;
14
15   # TODO: if module is empty, module overloading needs to take effect
16   # certain stuff may have more than one overload, or even more than one type
17   defined $caller_package     or croak 'need to be included from a caller reference';
18
19   $params{module}     ||= _calc_modules_from_overloads(%params) if $params{overloads};
20   $params{sub_module} ||= '';
21   $params{id}         ||= _get_primary_key_column($caller_package);
22
23   $params{module} || $params{sub_module}  or croak 'need param module or sub_module';
24
25   return unless save_meta_info($caller_package, %params);
26   make_cvar_accessor($caller_package, %params);
27   make_cvar_alias($caller_package, %params)      if $params{cvars_alias};
28   make_cvar_by_configs($caller_package, %params);
29   make_cvar_by_name($caller_package, %params);
30   make_cvar_as_hashref($caller_package, %params);
31   make_cvar_value_parser($caller_package, %params);
32   make_cvar_custom_filter($caller_package, %params);
33 }
34
35 sub save_meta_info {
36   my ($caller_package, %params) = @_;
37
38   my $meta = $caller_package->meta;
39   return 0 if $meta->{META_CVARS()};
40
41   $meta->{META_CVARS()} = \%params;
42
43   return 1;
44 }
45
46 sub make_cvar_accessor {
47   my ($caller_package, %params) = @_;
48
49   my $modules = ('ARRAY' eq ref $params{module}) ?
50       join ',', @{ $params{module} } :
51       $params{module};
52   my @module_filter = $modules ?
53     ("config_id" => [ \"(SELECT custom_variable_configs.id FROM custom_variable_configs WHERE custom_variable_configs.module IN ( '$modules' ))" ]) : # " make emacs happy
54     ();
55
56   $caller_package->meta->add_relationships(
57     custom_variables => {
58       type         => 'one to many',
59       class        => 'SL::DB::CustomVariable',
60       column_map   => { $params{id} => 'trans_id' },
61       query_args   => [ sub_module => $params{sub_module}, @module_filter ],
62     }
63   );
64 }
65
66 sub make_cvar_alias {
67   my ($caller_package) = @_;
68   no strict 'refs';
69   *{ $caller_package . '::cvars' } =  sub {
70     goto &{ $caller_package . '::custom_variables' };
71   }
72 }
73
74 # this is used for templates where you need to list every applicable config
75 # auto vivifies non existent cvar objects as necessary.
76 sub make_cvar_by_configs {
77   my ($caller_package, %params) = @_;
78
79   no strict 'refs';
80   *{ $caller_package . '::cvars_by_config' } = sub {
81     my ($self) = @_;
82     @_ > 1 and croak "not an accessor";
83
84     my $configs     = _all_configs(%params);
85     my $cvars       = $self->custom_variables;
86     my %cvars_by_config = map { $_->config_id => $_ } @$cvars;
87     my $invalids    = _all_invalids($self->${\ $self->meta->primary_key_columns->[0]->name }, $configs, %params);
88     my %invalids_by_config = map { $_->config_id => 1 } @$invalids;
89
90     my @return = map(
91       {
92         my $cvar;
93         if ( $cvars_by_config{$_->id} ) {
94           $cvar = $cvars_by_config{$_->id};
95         }
96         else {
97           $cvar = _new_cvar($self, %params, config => $_);
98           $self->add_custom_variables($cvar);
99         }
100         $cvar->{is_valid} = !$invalids_by_config{$_->id};
101         $cvar->{config}   = $_;
102         $cvar;
103       }
104       @$configs
105     );
106
107     return \@return;
108   }
109 }
110
111 # this is used for print templates where you need to refer to a variable by name
112 # TODO typically these were referred as prefix_'cvar'_name
113 sub make_cvar_by_name {
114   my ($caller_package, %params) = @_;
115
116   no strict 'refs';
117   *{ $caller_package . '::cvar_by_name' } = sub {
118     my ($self, $name) = @_;
119
120     my $configs = _all_configs(%params);
121     my $cvars   = $self->custom_variables;
122     my $config  = first { $_->name eq $name } @$configs;
123
124     croak "unknown cvar name $name" unless $config;
125
126     my $cvar    = first { $_->config_id eq $config->id } @$cvars;
127
128     if (!$cvar) {
129       $cvar = _new_cvar($self, %params, config => $config);
130       $self->add_custom_variables($cvar);
131     }
132
133     return $cvar;
134   }
135 }
136
137 sub make_cvar_as_hashref {
138   my ($caller_package, %params) = @_;
139
140   no strict 'refs';
141   *{ $caller_package . '::cvar_as_hashref' } = sub {
142     my ($self) = @_;
143     @_ > 1 and croak "not an accessor";
144
145     my $cvars_by_config = $self->cvars_by_config;
146
147     my %return = map {
148       $_->config->name => { value => $_->value_as_text, is_valid => $_->is_valid }
149     } @$cvars_by_config;
150
151     return \%return;
152   }
153 }
154
155 sub make_cvar_value_parser {
156   my ($caller_package) = @_;
157   no strict 'refs';
158   *{ $caller_package . '::parse_custom_variable_values' } =  sub {
159     my ($self) = @_;
160
161     $_->parse_value for @{ $self->custom_variables || [] };
162
163     return $self;
164   };
165
166   $caller_package->before_save('parse_custom_variable_values');
167 }
168
169 sub _all_configs {
170   my (%params) = @_;
171
172   require SL::DB::CustomVariableConfig;
173
174   my $cache  = $::request->cache("::SL::DB::Helper::CustomVariables::object_cache");
175
176   if (!$cache->{all}) {
177     my $configs = SL::DB::Manager::CustomVariableConfig->get_all_sorted;
178     $cache->{all}    =  $configs;
179     $cache->{module} = { partition_by { $_->module } @$configs };
180   }
181
182   return $params{module} && !ref $params{module} ? $cache->{module}{$params{module}}
183        : $params{module} &&  ref $params{module} ? [ map { @{ $cache->{module}{$_} // [] } } @{ $params{module} } ]
184        : $cache->{all};
185 }
186
187 sub _overload_by_module {
188   my ($module, %params) = @_;
189
190   keys %{ $params{overloads} }; # reset each iterator
191   while (my ($fk, $def) = each %{ $params{overloads} }) {
192     return ($fk, $def->{class}) if $def->{module} eq $module;
193   }
194
195   croak "unknown overload, cannot resolve module $module";
196 }
197
198 sub _new_cvar {
199   my ($self, %params) = @_;
200   my $inherited_value;
201   # check overloading first
202   if ($params{sub_module}) {
203     my ($fk, $class) = _overload_by_module($params{config}->module, %params);
204     my $base_cvar = $class->new(id => $self->$fk)->load->cvar_by_name($params{config}->name);
205     $inherited_value = $base_cvar->value;
206   }
207
208   my $cvar = SL::DB::CustomVariable->new(
209     config     => $params{config},
210     trans_id   => $self->${ \ $params{id} },
211     sub_module => $params{sub_module},
212   );
213   # value needs config
214   $inherited_value
215    ? $cvar->value($inherited_value)
216    : $cvar->value($params{config}->type_dependent_default_value);
217   return $cvar;
218 }
219
220 sub _calc_modules_from_overloads {
221   my (%params) = @_;
222   my %modules;
223
224   for my $def (values %{ $params{overloads} || {} }) {
225     $modules{$def->{module}} = 1;
226   }
227
228   return [ keys %modules ];
229 }
230
231 sub _get_primary_key_column {
232   my ($caller_package) = @_;
233   my $meta             = $caller_package->meta;
234
235   my $column_name;
236   $column_name = $meta->{primary_key}->{columns}->[0] if $meta->{primary_key} && (ref($meta->{primary_key}->{columns}) eq 'ARRAY') && (1 == scalar(@{ $meta->{primary_key}->{columns} }));
237
238   croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
239
240   return $column_name;
241 }
242
243 sub make_cvar_custom_filter {
244   my ($caller_package, %params) = @_;
245
246   my $manager    = $caller_package->meta->convention_manager->auto_manager_class_name;
247
248   return unless $manager->can('filter');
249
250   $manager->add_filter_specs(
251     cvar => sub {
252       my ($key, $value, $prefix, $config_id) = @_;
253       my $config = SL::DB::Manager::CustomVariableConfig->find_by(id => $config_id);
254
255       if (!$config) {
256         die "invalid config_id in $caller_package\::cvar custom filter: $config_id";
257       }
258
259       if ($config->module != $params{module}) {
260         die "invalid config_id in $caller_package\::cvar custom filter: expected module $params{module} - got @{[ $config->module ]}";
261       }
262
263       my @filter;
264       if ($config->type eq 'bool') {
265         @filter = $value ? ($config->value_col => 1) : (or => [ $config->value_col => undef, $config->value_col => 0 ]);
266       } else {
267         @filter = ($config->value_col => $value);
268       }
269
270       my (%query, %bind_vals);
271       ($query{customized}, $bind_vals{customized}) = Rose::DB::Object::QueryBuilder::build_select(
272         dbh                  => $config->dbh,
273         select               => 'trans_id',
274         tables               => [ 'custom_variables' ],
275         columns              => { custom_variables => [ qw(trans_id config_id text_value number_value bool_value timestamp_value sub_module) ] },
276         query                => [
277           config_id          => $config_id,
278           sub_module         => $params{sub_module},
279           @filter,
280         ],
281         query_is_sql         => 1,
282       );
283
284       if ($config->type eq 'bool') {
285         if ($value) {
286           @filter = (
287             '!default_value' => undef,
288             '!default_value' => '',
289             default_value    => '1',
290           );
291
292         } else {
293           @filter = (
294             or => [
295               default_value => '0',
296               default_value => '',
297               default_value => undef,
298             ],
299           );
300         }
301
302       } else {
303         @filter = (
304           '!default_value' => undef,
305           '!default_value' => '',
306           default_value    => $value,
307         );
308       }
309
310
311       my $conversion  = $config->type =~ m{^(?:date|timestamp)$}       ? $config->type
312                       : $config->type =~ m{^(?:customer|vendor|part)$} ? 'integer'
313                       : $config->type eq 'number'                      ? 'numeric'
314                       :                                                  '';
315
316       ($query{config}, $bind_vals{config}) = Rose::DB::Object::QueryBuilder::build_select(
317         dbh                => $config->dbh,
318         select             => 'id',
319         tables             => [ 'custom_variable_configs' ],
320         columns            => { custom_variable_configs => [ qw(id default_value) ] },
321         query              => [
322           id               => $config->id,
323           @filter,
324         ],
325         query_is_sql       => 1,
326       );
327
328       $query{config} =~ s{ (?<! NOT\( ) default_value (?! \s*is\s+not\s+null) }{default_value::${conversion}}x if $conversion;
329
330       ($query{not_customized}, $bind_vals{not_customized}) = Rose::DB::Object::QueryBuilder::build_select(
331         dbh          => $config->dbh,
332         select       => 'trans_id',
333         tables       => [ 'custom_variables' ],
334         columns      => { custom_variables => [ qw(trans_id config_id sub_module) ] },
335         query        => [
336           config_id  => $config_id,
337           sub_module => $params{sub_module},
338         ],
339         query_is_sql => 1,
340       );
341
342       foreach my $key (keys %query) {
343         # remove rose aliases. query builder sadly is not reentrant, and will reuse the same aliases. :(
344         $query{$key} =~ s{\bt\d+(?:\.)?\b}{}g;
345
346         # manually inline the values. again, rose doesn't know how to handle bind params in subqueries :(
347         $query{$key} =~ s{\?}{ $config->dbh->quote(shift @{ $bind_vals{$key} }) }xeg;
348
349         $query{$key} =~ s{\n}{ }g;
350       }
351
352       my $qry_config = "EXISTS (" . $query{config} . ")";
353
354       my @result = (
355         'or' => [
356           $prefix . 'id'   => [ \$query{customized} ],
357           and              => [
358             "!${prefix}id" => [ \$query{not_customized}  ],
359             \$qry_config,
360           ]
361         ],
362       );
363
364       return @result;
365     }
366   );
367 }
368
369
370 sub _all_invalids {
371   my ($trans_id, $configs, %params) = @_;
372
373   require SL::DB::CustomVariableValidity;
374
375   # easy 1: no trans_id, all valid by default.
376   return [] unless $trans_id;
377
378   # easy 2: no module in params? no validity
379   return [] unless $params{module};
380
381   my %wanted_modules = ref $params{module} ? map { $_ => 1 } @{ $params{module} } : ($params{module} => 1);
382   my @module_configs = grep { $wanted_modules{$_->module} } @$configs;
383
384   return [] unless @module_configs;
385
386   # nor find all entries for that and return
387   SL::DB::Manager::CustomVariableValidity->get_all(
388     query => [
389       config_id => [ map { $_->id } @module_configs ],
390       trans_id => $trans_id,
391     ]
392   );
393 }
394
395 1;
396
397 __END__
398
399 =encoding utf-8
400
401 =head1 NAME
402
403 SL::DB::Helper::CustomVariables - Mixin to provide custom variable relations
404
405 =head1 SYNOPSIS
406
407   # use in a primary class
408   use SL::DB::Helper::CustomVariables (
409     module      => 'IC',
410     cvars_alias => 1,
411   );
412
413   # use overloading in a secondary class
414   use SL::DB::Helper::CustomVariables (
415     sub_module  => 'orderitems',
416     cvars_alias => 1,
417     overloads   => {
418       parts_id    => {
419         class => 'SL::DB::Part',
420         module => 'IC',
421       }
422     }
423   );
424
425 =head1 DESCRIPTION
426
427 This module provides methods to deal with named custom variables. Two concepts are understood.
428
429 =head2 Primary CVar Classes
430
431 Primary classes are those that feature cvars for themselves. Currently those
432 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
433 for the object.
434
435 =head2 Secondary CVar Classes
436
437 Secondary classes inherit their cvars from member relationships. This is built
438 so that orders can save a copy of the cvars of their parts, customers and the
439 like to be immutable later on.
440
441 Secondary classes may currently not have cvars of their own.
442
443 =head1 INSTALLED METHODS
444
445 =over 4
446
447 =item C<custom_variables [ CUSTOM_VARIABLES ]>
448
449 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
450 like any other OneToMany relationship.
451
452 Note that unlike L</cvars_by_config> this accessor only returns
453 variables that have already been created for this object. No variables
454 will be autovivified for configs for which no variable has been
455 created yet.
456
457 =item C<cvars [ CUSTOM_VARIABLES ]>
458
459 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
460 passed to import.
461
462 =item C<cvars_by_config>
463
464 This will return a list of CVars with the following changes over the standard accessor:
465
466 =over 4
467
468 =item *
469
470 The list will be returned in the sorted order of the configs.
471
472 =item *
473
474 For every config exactly one CVar will be returned.
475
476 =item *
477
478 If no cvar was found for a config, a new one will be vivified, set to the
479 correct config, module etc, and registered into the object.
480
481 =item *
482
483 Vivified cvars for secondary classes will first try to find their base object
484 and use that value. If no such value or cvar is found the default value from
485 configs applies.
486
487 =back
488
489 This is useful if you need to list every possible CVar, like in CRUD masks.
490
491 =item C<cvar_by_name NAME [ VALUE ]>
492
493 Returns the CVar object for this object which matches the given internal name.
494 Useful for print templates. If the requested cvar is not present, it will be
495 vivified with the same rules as in C<cvars_by_config>.
496
497 =item C<parse_custom_variable_values>
498
499 When you want to edit custom variables in a form then you have
500 unparsed values from the user. These should be written to the
501 variable's C<unparsed_value> field.
502
503 This function then processes all variables and parses their
504 C<unparsed_value> field into the proper field. It returns C<$self> for
505 easy chaining.
506
507 This is automatically called in a C<before_save> hook so you don't
508 have to do it manually if you save directly after assigning the
509 values.
510
511 In an HTML form you could e.g. use something like the following:
512
513   [%- FOREACH var = SELF.project.cvars_by_config.as_list %]
514     [% HTML.escape(var.config.description) %]:
515     [% L.hidden_tag('project.custom_variables[+].config_id', var.config.id) %]
516     [% PROCESS 'common/render_cvar_input.html' var_name='project.custom_variables[].unparsed_value' %]
517   [%- END %]
518
519 Later in the controller when you want to save this project you don't
520 have to do anything special:
521
522   my $project = SL::DB::Project->new;
523   my $params  = $::form->{project} || {};
524
525   $project->assign_attributes(%{ $params });
526
527   $project->parse_custom_variable_values->save;
528
529 However, if you need access to a variable's value before saving in
530 some way then you have to call this function manually. For example:
531
532   my $project = SL::DB::Project->new;
533   my $params  = $::form->{project} || {};
534
535   $project->assign_attributes(%{ $params });
536
537   $project->parse_custom_variable_values;
538
539   print STDERR "CVar[0] value: " . $project->custom_variables->[0]->value . "\n";
540
541 =back
542
543 =head1 INSTALLED MANAGER METHODS
544
545 =over 4
546
547 =item Custom filter for GetModels
548
549 If the Manager for the calling C<SL::DB::Object> has included the helper L<SL::DB::Helper::Filtered>, a custom filter for cvars will be added to the specs, with the following syntax:
550
551   filter.cvar.$config_id
552
553 =back
554
555 =head1 BUGS AND CAVEATS
556
557 =over 4
558
559 =item * Conditional method export
560
561 Prolonged use has shown that users expect all methods to be present or none.
562 Future versions of this will likely remove the optional aliasing.
563
564 =item * Semantics need to be updated
565
566 There are a few transitions that are currently neither supported nor well
567 defined, most of them happening when the config of a cvar gets changed, but
568 whose instances have already been saved. This needs to be cleaned up.
569
570 =back
571
572 =head1 AUTHOR
573
574 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
575 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
576
577 =cut