1 package SL::DB::Helper::CustomVariables;
6 use List::Util qw(first);
7 use List::UtilsBy qw(sort_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;
90 if ( $cvars_by_config{$_->id} ) {
91 $cvars_by_config{$_->id};
94 my $cvar = _new_cvar($self, %params, config => $_);
95 $self->add_custom_variables($cvar);
102 @return = sort_by { $_->config->sortkey } @return;
108 # this is used for print templates where you need to refer to a variable by name
109 # TODO typically these were referred as prefix_'cvar'_name
110 sub make_cvar_by_name {
111 my ($caller_package, %params) = @_;
114 *{ $caller_package . '::cvar_by_name' } = sub {
115 my ($self, $name) = @_;
117 my $configs = _all_configs(%params);
118 my $cvars = $self->custom_variables;
119 my $config = first { $_->name eq $name } @$configs;
121 croak "unknown cvar name $name" unless $config;
123 my $cvar = first { $_->config_id eq $config->id } @$cvars;
126 $cvar = _new_cvar($self, %params, config => $config);
127 $self->add_custom_variables($cvar);
134 sub make_cvar_as_hashref {
135 my ($caller_package, %params) = @_;
138 *{ $caller_package . '::cvar_as_hashref' } = sub {
140 @_ > 1 and croak "not an accessor";
142 my $cvars_by_config = $self->cvars_by_config;
145 $_->config->name => { value => $_->value_as_text, is_valid => $_->is_valid }
152 sub make_cvar_value_parser {
153 my ($caller_package) = @_;
155 *{ $caller_package . '::parse_custom_variable_values' } = sub {
158 $_->parse_value for @{ $self->custom_variables || [] };
163 $caller_package->before_save('parse_custom_variable_values');
169 require SL::DB::CustomVariableConfig;
171 SL::DB::Manager::CustomVariableConfig->get_all_sorted($params{module} ? (query => [ module => $params{module} ]) : ());
174 sub _overload_by_module {
175 my ($module, %params) = @_;
177 keys %{ $params{overloads} }; # reset each iterator
178 while (my ($fk, $def) = each %{ $params{overloads} }) {
179 return ($fk, $def->{class}) if $def->{module} eq $module;
182 croak "unknown overload, cannot resolve module $module";
186 my ($self, %params) = @_;
188 # check overloading first
189 if ($params{sub_module}) {
190 my ($fk, $class) = _overload_by_module($params{config}->module, %params);
191 my $base_cvar = $class->new(id => $self->$fk)->load->cvar_by_name($params{config}->name);
192 $inherited_value = $base_cvar->value;
195 my $cvar = SL::DB::CustomVariable->new(
196 config => $params{config},
197 trans_id => $self->${ \ $params{id} },
198 sub_module => $params{sub_module},
202 ? $cvar->value($inherited_value)
203 : $cvar->value($params{config}->type_dependent_default_value);
207 sub _calc_modules_from_overloads {
211 for my $def (values %{ $params{overloads} || {} }) {
212 $modules{$def->{module}} = 1;
215 return [ keys %modules ];
218 sub _get_primary_key_column {
219 my ($caller_package) = @_;
220 my $meta = $caller_package->meta;
223 $column_name = $meta->{primary_key}->{columns}->[0] if $meta->{primary_key} && (ref($meta->{primary_key}->{columns}) eq 'ARRAY') && (1 == scalar(@{ $meta->{primary_key}->{columns} }));
225 croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
230 sub make_cvar_custom_filter {
231 my ($caller_package, %params) = @_;
233 my $manager = $caller_package->meta->convention_manager->auto_manager_class_name;
235 return unless $manager->can('filter');
237 $manager->add_filter_specs(
239 my ($key, $value, $prefix, $config_id) = @_;
240 my $config = SL::DB::Manager::CustomVariableConfig->find_by(id => $config_id);
243 die "invalid config_id in $caller_package\::cvar custom filter: $config_id";
246 if ($config->module != $params{module}) {
247 die "invalid config_id in $caller_package\::cvar custom filter: expected module $params{module} - got @{[ $config->module ]}";
251 if ($config->type eq 'bool') {
252 @filter = $value ? ($config->value_col => 1) : (or => [ $config->value_col => undef, $config->value_col => 0 ]);
254 @filter = ($config->value_col => $value);
257 my (%query, %bind_vals);
258 ($query{customized}, $bind_vals{customized}) = Rose::DB::Object::QueryBuilder::build_select(
260 select => 'trans_id',
261 tables => [ 'custom_variables' ],
262 columns => { custom_variables => [ qw(trans_id config_id text_value number_value bool_value timestamp_value sub_module) ] },
264 config_id => $config_id,
265 sub_module => $params{sub_module},
271 if ($config->type eq 'bool') {
274 '!default_value' => undef,
275 '!default_value' => '',
276 default_value => '1',
282 default_value => '0',
284 default_value => undef,
291 '!default_value' => undef,
292 '!default_value' => '',
293 default_value => $value,
298 my $conversion = $config->type =~ m{^(?:date|timestamp)$} ? $config->type
299 : $config->type =~ m{^(?:customer|vendor|part)$} ? 'integer'
300 : $config->type eq 'number' ? 'numeric'
303 ($query{config}, $bind_vals{config}) = Rose::DB::Object::QueryBuilder::build_select(
306 tables => [ 'custom_variable_configs' ],
307 columns => { custom_variable_configs => [ qw(id default_value) ] },
315 $query{config} =~ s{ (?<! NOT\( ) default_value (?! \s*is\s+not\s+null) }{default_value::${conversion}}x if $conversion;
317 ($query{not_customized}, $bind_vals{not_customized}) = Rose::DB::Object::QueryBuilder::build_select(
319 select => 'trans_id',
320 tables => [ 'custom_variables' ],
321 columns => { custom_variables => [ qw(trans_id config_id sub_module) ] },
323 config_id => $config_id,
324 sub_module => $params{sub_module},
329 foreach my $key (keys %query) {
330 # remove rose aliases. query builder sadly is not reentrant, and will reuse the same aliases. :(
331 $query{$key} =~ s{\bt\d+(?:\.)?\b}{}g;
333 # manually inline the values. again, rose doesn't know how to handle bind params in subqueries :(
334 $query{$key} =~ s{\?}{ $config->dbh->quote(shift @{ $bind_vals{$key} }) }xeg;
336 $query{$key} =~ s{\n}{ }g;
339 my $qry_config = "EXISTS (" . $query{config} . ")";
343 $prefix . 'id' => [ \$query{customized} ],
345 "!${prefix}id" => [ \$query{not_customized} ],
364 SL::DB::Helper::CustomVariables - Mixin to provide custom variable relations
368 # use in a primary class
369 use SL::DB::Helper::CustomVariables (
374 # use overloading in a secondary class
375 use SL::DB::Helper::CustomVariables (
376 sub_module => 'orderitems',
380 class => 'SL::DB::Part',
388 This module provides methods to deal with named custom variables. Two concepts are understood.
390 =head2 Primary CVar Classes
392 Primary classes are those that feature cvars for themselves. Currently those
393 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
396 =head2 Secondary CVar Classes
398 Secondary classes inherit their cvars from member relationships. This is built
399 so that orders can save a copy of the cvars of their parts, customers and the
400 like to be immutable later on.
402 Secondary classes may currently not have cvars of their own.
404 =head1 INSTALLED METHODS
408 =item C<custom_variables [ CUSTOM_VARIABLES ]>
410 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
411 like any other OneToMany relationship.
413 Note that unlike L</cvars_by_config> this accessor only returns
414 variables that have already been created for this object. No variables
415 will be autovivified for configs for which no variable has been
418 =item C<cvars [ CUSTOM_VARIABLES ]>
420 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
423 =item C<cvars_by_config>
425 Thi will return a list of CVars with the following changes over the standard accessor:
431 The list will be returned in the sorted order of the configs.
435 For every config exactly one CVar will be returned.
439 If no cvar was found for a config, a new one will be vivified, set to the
440 correct config, module etc, and registered into the object.
444 Vivified cvars for secondary classes will first try to find their base object
445 and use that value. If no such value or cvar is found the default value from
450 This is useful if you need to list every possible CVar, like in CRUD masks.
452 =item C<cvar_by_name NAME [ VALUE ]>
454 Returns the CVar object for this object which matches the given internal name.
455 Useful for print templates. If the requested cvar is not present, it will be
456 vivified with the same rules as in C<cvars_by_config>.
458 =item C<parse_custom_variable_values>
460 When you want to edit custom variables in a form then you have
461 unparsed values from the user. These should be written to the
462 variable's C<unparsed_value> field.
464 This function then processes all variables and parses their
465 C<unparsed_value> field into the proper field. It returns C<$self> for
468 This is automatically called in a C<before_save> hook so you don't
469 have to do it manually if you save directly after assigning the
472 In an HTML form you could e.g. use something like the following:
474 [%- FOREACH var = SELF.project.cvars_by_config.as_list %]
475 [% HTML.escape(var.config.description) %]:
476 [% L.hidden_tag('project.custom_variables[+].config_id', var.config.id) %]
477 [% PROCESS 'common/render_cvar_input.html' var_name='project.custom_variables[].unparsed_value' %]
480 Later in the controller when you want to save this project you don't
481 have to do anything special:
483 my $project = SL::DB::Project->new;
484 my $params = $::form->{project} || {};
486 $project->assign_attributes(%{ $params });
488 $project->parse_custom_variable_values->save;
490 However, if you need access to a variable's value before saving in
491 some way then you have to call this function manually. For example:
493 my $project = SL::DB::Project->new;
494 my $params = $::form->{project} || {};
496 $project->assign_attributes(%{ $params });
498 $project->parse_custom_variable_values;
500 print STDERR "CVar[0] value: " . $project->custom_variables->[0]->value . "\n";
504 =head1 INSTALLED MANAGER METHODS
508 =item Custom filter for GetModels
510 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:
512 filter.cvar.$config_id
518 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
519 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>