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