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(sort_by 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 = sort_by { $_->config->sortkey } @return;
 108
 109     return \@return;
 110   }
 111 }
 112
 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) = @_;
 117
 118   no strict 'refs';
 119   *{ $caller_package . '::cvar_by_name' } = sub {
 120     my ($self, $name) = @_;
 121
 122     my $configs = _all_configs(%params);
 123     my $cvars   = $self->custom_variables;
 124     my $config  = first { $_->name eq $name } @$configs;
 125
 126     croak "unknown cvar name $name" unless $config;
 127
 128     my $cvar    = first { $_->config_id eq $config->id } @$cvars;
 129
 130     if (!$cvar) {
 131       $cvar = _new_cvar($self, %params, config => $config);
 132       $self->add_custom_variables($cvar);
 133     }
 134
 135     return $cvar;
 136   }
 137 }
 138
 139 sub make_cvar_as_hashref {
 140   my ($caller_package, %params) = @_;
 141
 142   no strict 'refs';
 143   *{ $caller_package . '::cvar_as_hashref' } = sub {
 144     my ($self) = @_;
 145     @_ > 1 and croak "not an accessor";
 146
 147     my $cvars_by_config = $self->cvars_by_config;
 148
 149     my %return = map {
 150       $_->config->name => { value => $_->value_as_text, is_valid => $_->is_valid }
 151     } @$cvars_by_config;
 152
 153     return \%return;
 154   }
 155 }
 156
 157 sub make_cvar_value_parser {
 158   my ($caller_package) = @_;
 159   no strict 'refs';
 160   *{ $caller_package . '::parse_custom_variable_values' } =  sub {
 161     my ($self) = @_;
 162
 163     $_->parse_value for @{ $self->custom_variables || [] };
 164
 165     return $self;
 166   };
 167
 168   $caller_package->before_save('parse_custom_variable_values');
 169 }
 170
 171 sub _all_configs {
 172   my (%params) = @_;
 173
 174   require SL::DB::CustomVariableConfig;
 175
 176   my $cache  = $::request->cache("::SL::DB::Helper::CustomVariables::object_cache");
 177
 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 };
 182   }
 183
 184   return $params{module} && !ref $params{module} ? $cache->{module}{$params{module}}
 185        : $params{module} &&  ref $params{module} ? [ map { @{ $cache->{module}{$_} } } @{ $params{module} } ]
 186        : $cache->{all};
 187 }
 188
 189 sub _overload_by_module {
 190   my ($module, %params) = @_;
 191
 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;
 195   }
 196
 197   croak "unknown overload, cannot resolve module $module";
 198 }
 199
 200 sub _new_cvar {
 201   my ($self, %params) = @_;
 202   my $inherited_value;
 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;
 208   }
 209
 210   my $cvar = SL::DB::CustomVariable->new(
 211     config     => $params{config},
 212     trans_id   => $self->${ \ $params{id} },
 213     sub_module => $params{sub_module},
 214   );
 215   # value needs config
 216   $inherited_value
 217    ? $cvar->value($inherited_value)
 218    : $cvar->value($params{config}->type_dependent_default_value);
 219   return $cvar;
 220 }
 221
 222 sub _calc_modules_from_overloads {
 223   my (%params) = @_;
 224   my %modules;
 225
 226   for my $def (values %{ $params{overloads} || {} }) {
 227     $modules{$def->{module}} = 1;
 228   }
 229
 230   return [ keys %modules ];
 231 }
 232
 233 sub _get_primary_key_column {
 234   my ($caller_package) = @_;
 235   my $meta             = $caller_package->meta;
 236
 237   my $column_name;
 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} }));
 239
 240   croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
 241
 242   return $column_name;
 243 }
 244
 245 sub make_cvar_custom_filter {
 246   my ($caller_package, %params) = @_;
 247
 248   my $manager    = $caller_package->meta->convention_manager->auto_manager_class_name;
 249
 250   return unless $manager->can('filter');
 251
 252   $manager->add_filter_specs(
 253     cvar => sub {
 254       my ($key, $value, $prefix, $config_id) = @_;
 255       my $config = SL::DB::Manager::CustomVariableConfig->find_by(id => $config_id);
 256
 257       if (!$config) {
 258         die "invalid config_id in $caller_package\::cvar custom filter: $config_id";
 259       }
 260
 261       if ($config->module != $params{module}) {
 262         die "invalid config_id in $caller_package\::cvar custom filter: expected module $params{module} - got @{[ $config->module ]}";
 263       }
 264
 265       my @filter;
 266       if ($config->type eq 'bool') {
 267         @filter = $value ? ($config->value_col => 1) : (or => [ $config->value_col => undef, $config->value_col => 0 ]);
 268       } else {
 269         @filter = ($config->value_col => $value);
 270       }
 271
 272       my (%query, %bind_vals);
 273       ($query{customized}, $bind_vals{customized}) = Rose::DB::Object::QueryBuilder::build_select(
 274         dbh                  => $config->dbh,
 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) ] },
 278         query                => [
 279           config_id          => $config_id,
 280           sub_module         => $params{sub_module},
 281           @filter,
 282         ],
 283         query_is_sql         => 1,
 284       );
 285
 286       if ($config->type eq 'bool') {
 287         if ($value) {
 288           @filter = (
 289             '!default_value' => undef,
 290             '!default_value' => '',
 291             default_value    => '1',
 292           );
 293
 294         } else {
 295           @filter = (
 296             or => [
 297               default_value => '0',
 298               default_value => '',
 299               default_value => undef,
 300             ],
 301           );
 302         }
 303
 304       } else {
 305         @filter = (
 306           '!default_value' => undef,
 307           '!default_value' => '',
 308           default_value    => $value,
 309         );
 310       }
 311
 312
 313       my $conversion  = $config->type =~ m{^(?:date|timestamp)$}       ? $config->type
 314                       : $config->type =~ m{^(?:customer|vendor|part)$} ? 'integer'
 315                       : $config->type eq 'number'                      ? 'numeric'
 316                       :                                                  '';
 317
 318       ($query{config}, $bind_vals{config}) = Rose::DB::Object::QueryBuilder::build_select(
 319         dbh                => $config->dbh,
 320         select             => 'id',
 321         tables             => [ 'custom_variable_configs' ],
 322         columns            => { custom_variable_configs => [ qw(id default_value) ] },
 323         query              => [
 324           id               => $config->id,
 325           @filter,
 326         ],
 327         query_is_sql       => 1,
 328       );
 329
 330       $query{config} =~ s{ (?<! NOT\( ) default_value (?! \s*is\s+not\s+null) }{default_value::${conversion}}x if $conversion;
 331
 332       ($query{not_customized}, $bind_vals{not_customized}) = Rose::DB::Object::QueryBuilder::build_select(
 333         dbh          => $config->dbh,
 334         select       => 'trans_id',
 335         tables       => [ 'custom_variables' ],
 336         columns      => { custom_variables => [ qw(trans_id config_id sub_module) ] },
 337         query        => [
 338           config_id  => $config_id,
 339           sub_module => $params{sub_module},
 340         ],
 341         query_is_sql => 1,
 342       );
 343
 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;
 347
 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;
 350
 351         $query{$key} =~ s{\n}{ }g;
 352       }
 353
 354       my $qry_config = "EXISTS (" . $query{config} . ")";
 355
 356       my @result = (
 357         'or' => [
 358           $prefix . 'id'   => [ \$query{customized} ],
 359           and              => [
 360             "!${prefix}id" => [ \$query{not_customized}  ],
 361             \$qry_config,
 362           ]
 363         ],
 364       );
 365
 366       return @result;
 367     }
 368   );
 369 }
 370
 371
 372 sub _all_invalids {
 373   my ($trans_id, $configs, %params) = @_;
 374
 375   require SL::DB::CustomVariableValidity;
 376
 377   # easy 1: no trans_id, all valid by default.
 378   return [] unless $trans_id;
 379
 380   # easy 2: no module in params? no validity
 381   return [] unless $params{module};
 382
 383   my @module_configs = grep { $_->module eq $params{module} } @$configs;
 384
 385   return [] unless @module_configs;
 386
 387   # nor find all entries for that and return
 388   SL::DB::Manager::CustomVariableValidity->get_all(
 389     query => [
 390       config_id => [ map { $_->id } @module_configs ],
 391       trans_id => $trans_id,
 392     ]
 393   );
 394 }
 395
 396 1;
 397
 398 __END__
 399
 400 =encoding utf-8
 401
 402 =head1 NAME
 403
 404 SL::DB::Helper::CustomVariables - Mixin to provide custom variable relations
 405
 406 =head1 SYNOPSIS
 407
 408   # use in a primary class
 409   use SL::DB::Helper::CustomVariables (
 410     module      => 'IC',
 411     cvars_alias => 1,
 412   );
 413
 414   # use overloading in a secondary class
 415   use SL::DB::Helper::CustomVariables (
 416     sub_module  => 'orderitems',
 417     cvars_alias => 1,
 418     overloads   => {
 419       parts_id    => {
 420         class => 'SL::DB::Part',
 421         module => 'IC',
 422       }
 423     }
 424   );
 425
 426 =head1 DESCRIPTION
 427
 428 This module provides methods to deal with named custom variables. Two concepts are understood.
 429
 430 =head2 Primary CVar Classes
 431
 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
 434 for the object.
 435
 436 =head2 Secondary CVar Classes
 437
 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.
 441
 442 Secondary classes may currently not have cvars of their own.
 443
 444 =head1 INSTALLED METHODS
 445
 446 =over 4
 447
 448 =item C<custom_variables [ CUSTOM_VARIABLES ]>
 449
 450 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
 451 like any other OneToMany relationship.
 452
 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
 456 created yet.
 457
 458 =item C<cvars [ CUSTOM_VARIABLES ]>
 459
 460 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
 461 passed to import.
 462
 463 =item C<cvars_by_config>
 464
 465 This will return a list of CVars with the following changes over the standard accessor:
 466
 467 =over 4
 468
 469 =item *
 470
 471 The list will be returned in the sorted order of the configs.
 472
 473 =item *
 474
 475 For every config exactly one CVar will be returned.
 476
 477 =item *
 478
 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.
 481
 482 =item *
 483
 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
 486 configs applies.
 487
 488 =back
 489
 490 This is useful if you need to list every possible CVar, like in CRUD masks.
 491
 492 =item C<cvar_by_name NAME [ VALUE ]>
 493
 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>.
 497
 498 =item C<parse_custom_variable_values>
 499
 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.
 503
 504 This function then processes all variables and parses their
 505 C<unparsed_value> field into the proper field. It returns C<$self> for
 506 easy chaining.
 507
 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
 510 values.
 511
 512 In an HTML form you could e.g. use something like the following:
 513
 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' %]
 518   [%- END %]
 519
 520 Later in the controller when you want to save this project you don't
 521 have to do anything special:
 522
 523   my $project = SL::DB::Project->new;
 524   my $params  = $::form->{project} || {};
 525
 526   $project->assign_attributes(%{ $params });
 527
 528   $project->parse_custom_variable_values->save;
 529
 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:
 532
 533   my $project = SL::DB::Project->new;
 534   my $params  = $::form->{project} || {};
 535
 536   $project->assign_attributes(%{ $params });
 537
 538   $project->parse_custom_variable_values;
 539
 540   print STDERR "CVar[0] value: " . $project->custom_variables->[0]->value . "\n";
 541
 542 =back
 543
 544 =head1 INSTALLED MANAGER METHODS
 545
 546 =over 4
 547
 548 =item Custom filter for GetModels
 549
 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:
 551
 552   filter.cvar.$config_id
 553
 554 =back
 555
 556 =head1 BUGS AND CAVEATS
 557
 558 =over 4
 559
 560 =item * Conditional method export
 561
 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.
 564
 565 =item * Semantics need to be updated
 566
 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.
 570
 571 =back
 572
 573 =head1 AUTHOR
 574
 575 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
 576 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 577
 578 =cut