1 package SL::DB::Helper::CustomVariables;
6 use List::Util qw(first);
7 use List::UtilsBy qw(sort_by partition_by);
9 use constant META_CVARS => 'cvars_config';
12 my ($class, %params) = @_;
13 my $caller_package = caller;
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';
19 $params{module} ||= _calc_modules_from_overloads(%params) if $params{overloads};
20 $params{sub_module} ||= '';
21 $params{id} ||= _get_primary_key_column($caller_package);
23 $params{module} || $params{sub_module} or croak 'need param module or sub_module';
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);
36 my ($caller_package, %params) = @_;
38 my $meta = $caller_package->meta;
39 return 0 if $meta->{META_CVARS()};
41 $meta->{META_CVARS()} = \%params;
46 sub make_cvar_accessor {
47 my ($caller_package, %params) = @_;
49 my $modules = ('ARRAY' eq ref $params{module}) ?
50 join ',', @{ $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
56 $caller_package->meta->add_relationships(
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 ],
67 my ($caller_package) = @_;
69 *{ $caller_package . '::cvars' } = sub {
70 goto &{ $caller_package . '::custom_variables' };
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) = @_;
80 *{ $caller_package . '::cvars_by_config' } = sub {
82 @_ > 1 and croak "not an accessor";
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;
93 if ( $cvars_by_config{$_->id} ) {
94 $cvar = $cvars_by_config{$_->id};
97 $cvar = _new_cvar($self, %params, config => $_);
98 $self->add_custom_variables($cvar);
100 $cvar->{is_valid} = !$invalids_by_config{$_->id};
101 $cvar->{config} = $_;
107 @return = sort_by { $_->config->sortkey } @return;
113 # this is used for print templates where you need to refer to a variable by name
114 # TODO typically these were referred as prefix_'cvar'_name
115 sub make_cvar_by_name {
116 my ($caller_package, %params) = @_;
119 *{ $caller_package . '::cvar_by_name' } = sub {
120 my ($self, $name) = @_;
122 my $configs = _all_configs(%params);
123 my $cvars = $self->custom_variables;
124 my $config = first { $_->name eq $name } @$configs;
126 croak "unknown cvar name $name" unless $config;
128 my $cvar = first { $_->config_id eq $config->id } @$cvars;
131 $cvar = _new_cvar($self, %params, config => $config);
132 $self->add_custom_variables($cvar);
139 sub make_cvar_as_hashref {
140 my ($caller_package, %params) = @_;
143 *{ $caller_package . '::cvar_as_hashref' } = sub {
145 @_ > 1 and croak "not an accessor";
147 my $cvars_by_config = $self->cvars_by_config;
150 $_->config->name => { value => $_->value_as_text, is_valid => $_->is_valid }
157 sub make_cvar_value_parser {
158 my ($caller_package) = @_;
160 *{ $caller_package . '::parse_custom_variable_values' } = sub {
163 $_->parse_value for @{ $self->custom_variables || [] };
168 $caller_package->before_save('parse_custom_variable_values');
174 require SL::DB::CustomVariableConfig;
176 my $cache = $::request->cache("::SL::DB::Helper::CustomVariables::object_cache");
178 if (!$cache->{all}) {
179 my $configs = SL::DB::Manager::CustomVariableConfig->get_all_sorted;
180 $cache->{all} = $configs;
181 $cache->{module} = { partition_by { $_->module } @$configs };
184 return $params{module} && !ref $params{module} ? $cache->{module}{$params{module}}
185 : $params{module} && ref $params{module} ? [ map { @{ $cache->{module}{$_} } } @{ $params{module} } ]
189 sub _overload_by_module {
190 my ($module, %params) = @_;
192 keys %{ $params{overloads} }; # reset each iterator
193 while (my ($fk, $def) = each %{ $params{overloads} }) {
194 return ($fk, $def->{class}) if $def->{module} eq $module;
197 croak "unknown overload, cannot resolve module $module";
201 my ($self, %params) = @_;
203 # check overloading first
204 if ($params{sub_module}) {
205 my ($fk, $class) = _overload_by_module($params{config}->module, %params);
206 my $base_cvar = $class->new(id => $self->$fk)->load->cvar_by_name($params{config}->name);
207 $inherited_value = $base_cvar->value;
210 my $cvar = SL::DB::CustomVariable->new(
211 config => $params{config},
212 trans_id => $self->${ \ $params{id} },
213 sub_module => $params{sub_module},
217 ? $cvar->value($inherited_value)
218 : $cvar->value($params{config}->type_dependent_default_value);
222 sub _calc_modules_from_overloads {
226 for my $def (values %{ $params{overloads} || {} }) {
227 $modules{$def->{module}} = 1;
230 return [ keys %modules ];
233 sub _get_primary_key_column {
234 my ($caller_package) = @_;
235 my $meta = $caller_package->meta;
238 $column_name = $meta->{primary_key}->{columns}->[0] if $meta->{primary_key} && (ref($meta->{primary_key}->{columns}) eq 'ARRAY') && (1 == scalar(@{ $meta->{primary_key}->{columns} }));
240 croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
245 sub make_cvar_custom_filter {
246 my ($caller_package, %params) = @_;
248 my $manager = $caller_package->meta->convention_manager->auto_manager_class_name;
250 return unless $manager->can('filter');
252 $manager->add_filter_specs(
254 my ($key, $value, $prefix, $config_id) = @_;
255 my $config = SL::DB::Manager::CustomVariableConfig->find_by(id => $config_id);
258 die "invalid config_id in $caller_package\::cvar custom filter: $config_id";
261 if ($config->module != $params{module}) {
262 die "invalid config_id in $caller_package\::cvar custom filter: expected module $params{module} - got @{[ $config->module ]}";
266 if ($config->type eq 'bool') {
267 @filter = $value ? ($config->value_col => 1) : (or => [ $config->value_col => undef, $config->value_col => 0 ]);
269 @filter = ($config->value_col => $value);
272 my (%query, %bind_vals);
273 ($query{customized}, $bind_vals{customized}) = Rose::DB::Object::QueryBuilder::build_select(
275 select => 'trans_id',
276 tables => [ 'custom_variables' ],
277 columns => { custom_variables => [ qw(trans_id config_id text_value number_value bool_value timestamp_value sub_module) ] },
279 config_id => $config_id,
280 sub_module => $params{sub_module},
286 if ($config->type eq 'bool') {
289 '!default_value' => undef,
290 '!default_value' => '',
291 default_value => '1',
297 default_value => '0',
299 default_value => undef,
306 '!default_value' => undef,
307 '!default_value' => '',
308 default_value => $value,
313 my $conversion = $config->type =~ m{^(?:date|timestamp)$} ? $config->type
314 : $config->type =~ m{^(?:customer|vendor|part)$} ? 'integer'
315 : $config->type eq 'number' ? 'numeric'
318 ($query{config}, $bind_vals{config}) = Rose::DB::Object::QueryBuilder::build_select(
321 tables => [ 'custom_variable_configs' ],
322 columns => { custom_variable_configs => [ qw(id default_value) ] },
330 $query{config} =~ s{ (?<! NOT\( ) default_value (?! \s*is\s+not\s+null) }{default_value::${conversion}}x if $conversion;
332 ($query{not_customized}, $bind_vals{not_customized}) = Rose::DB::Object::QueryBuilder::build_select(
334 select => 'trans_id',
335 tables => [ 'custom_variables' ],
336 columns => { custom_variables => [ qw(trans_id config_id sub_module) ] },
338 config_id => $config_id,
339 sub_module => $params{sub_module},
344 foreach my $key (keys %query) {
345 # remove rose aliases. query builder sadly is not reentrant, and will reuse the same aliases. :(
346 $query{$key} =~ s{\bt\d+(?:\.)?\b}{}g;
348 # manually inline the values. again, rose doesn't know how to handle bind params in subqueries :(
349 $query{$key} =~ s{\?}{ $config->dbh->quote(shift @{ $bind_vals{$key} }) }xeg;
351 $query{$key} =~ s{\n}{ }g;
354 my $qry_config = "EXISTS (" . $query{config} . ")";
358 $prefix . 'id' => [ \$query{customized} ],
360 "!${prefix}id" => [ \$query{not_customized} ],
373 my ($trans_id, $configs, %params) = @_;
375 require SL::DB::CustomVariableValidity;
377 # easy 1: no trans_id, all valid by default.
378 return [] unless $trans_id;
380 # easy 2: no module in params? no validity
381 return [] unless $params{module};
383 my @module_configs = grep { $_->module eq $params{module} } @$configs;
385 return [] unless @module_configs;
387 # nor find all entries for that and return
388 SL::DB::Manager::CustomVariableValidity->get_all(
390 config_id => [ map { $_->id } @module_configs ],
391 trans_id => $trans_id,
404 SL::DB::Helper::CustomVariables - Mixin to provide custom variable relations
408 # use in a primary class
409 use SL::DB::Helper::CustomVariables (
414 # use overloading in a secondary class
415 use SL::DB::Helper::CustomVariables (
416 sub_module => 'orderitems',
420 class => 'SL::DB::Part',
428 This module provides methods to deal with named custom variables. Two concepts are understood.
430 =head2 Primary CVar Classes
432 Primary classes are those that feature cvars for themselves. Currently those
433 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
436 =head2 Secondary CVar Classes
438 Secondary classes inherit their cvars from member relationships. This is built
439 so that orders can save a copy of the cvars of their parts, customers and the
440 like to be immutable later on.
442 Secondary classes may currently not have cvars of their own.
444 =head1 INSTALLED METHODS
448 =item C<custom_variables [ CUSTOM_VARIABLES ]>
450 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
451 like any other OneToMany relationship.
453 Note that unlike L</cvars_by_config> this accessor only returns
454 variables that have already been created for this object. No variables
455 will be autovivified for configs for which no variable has been
458 =item C<cvars [ CUSTOM_VARIABLES ]>
460 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
463 =item C<cvars_by_config>
465 This will return a list of CVars with the following changes over the standard accessor:
471 The list will be returned in the sorted order of the configs.
475 For every config exactly one CVar will be returned.
479 If no cvar was found for a config, a new one will be vivified, set to the
480 correct config, module etc, and registered into the object.
484 Vivified cvars for secondary classes will first try to find their base object
485 and use that value. If no such value or cvar is found the default value from
490 This is useful if you need to list every possible CVar, like in CRUD masks.
492 =item C<cvar_by_name NAME [ VALUE ]>
494 Returns the CVar object for this object which matches the given internal name.
495 Useful for print templates. If the requested cvar is not present, it will be
496 vivified with the same rules as in C<cvars_by_config>.
498 =item C<parse_custom_variable_values>
500 When you want to edit custom variables in a form then you have
501 unparsed values from the user. These should be written to the
502 variable's C<unparsed_value> field.
504 This function then processes all variables and parses their
505 C<unparsed_value> field into the proper field. It returns C<$self> for
508 This is automatically called in a C<before_save> hook so you don't
509 have to do it manually if you save directly after assigning the
512 In an HTML form you could e.g. use something like the following:
514 [%- FOREACH var = SELF.project.cvars_by_config.as_list %]
515 [% HTML.escape(var.config.description) %]:
516 [% L.hidden_tag('project.custom_variables[+].config_id', var.config.id) %]
517 [% PROCESS 'common/render_cvar_input.html' var_name='project.custom_variables[].unparsed_value' %]
520 Later in the controller when you want to save this project you don't
521 have to do anything special:
523 my $project = SL::DB::Project->new;
524 my $params = $::form->{project} || {};
526 $project->assign_attributes(%{ $params });
528 $project->parse_custom_variable_values->save;
530 However, if you need access to a variable's value before saving in
531 some way then you have to call this function manually. For example:
533 my $project = SL::DB::Project->new;
534 my $params = $::form->{project} || {};
536 $project->assign_attributes(%{ $params });
538 $project->parse_custom_variable_values;
540 print STDERR "CVar[0] value: " . $project->custom_variables->[0]->value . "\n";
544 =head1 INSTALLED MANAGER METHODS
548 =item Custom filter for GetModels
550 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:
552 filter.cvar.$config_id
556 =head1 BUGS AND CAVEATS
560 =item * Conditional method export
562 Prolonged use has shown that users expect all methods to be present or none.
563 Future versions of this will likely remove the optional aliasing.
565 =item * Semantics need to be updated
567 There are a few transitions that are currently neither supported nor well
568 defined, most of them happening when the config of a cvar gets changed, but
569 whose instances have already been saved. This needs to be cleaned up.
575 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
576 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>