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