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 (%query, %bind_vals);
 248       ($query{customized}, $bind_vals{customized}) = Rose::DB::Object::QueryBuilder::build_select(
 249         dbh                  => $config->dbh,
 250         select               => 'trans_id',
 251         tables               => [ 'custom_variables' ],
 252         columns              => { custom_variables => [ qw(trans_id config_id text_value number_value bool_value timestamp_value sub_module) ] },
 253         query                => [
 254           config_id          => $config_id,
 255           sub_module         => $params{sub_module},
 256           $config->value_col => $value,
 257         ],
 258         query_is_sql         => 1,
 259       );
 260
 261       my $conversion  = $config->type =~ m{^(?:date|timestamp)$}       ? $config->type
 262                       : $config->type =~ m{^(?:customer|vendor|part)$} ? 'integer'
 263                       : $config->type eq 'bool'                        ? 'boolean'
 264                       : $config->type eq 'number'                      ? 'numeric'
 265                       :                                                  '';
 266
 267       ($query{config}, $bind_vals{config}) = Rose::DB::Object::QueryBuilder::build_select(
 268         dbh             => $config->dbh,
 269         select          => 'id',
 270         tables          => [ 'custom_variable_configs' ],
 271         columns         => { custom_variable_configs => [ qw(id default_value) ] },
 272         query           => [
 273           id            => $config->id,
 274           default_value => $value,
 275         ],
 276         query_is_sql    => 1,
 277       );
 278
 279       $query{config} =~ s{\bdefault_value\b}{default_value::${conversion}} if $conversion;
 280
 281       ($query{not_customized}, $bind_vals{not_customized}) = Rose::DB::Object::QueryBuilder::build_select(
 282         dbh          => $config->dbh,
 283         select       => 'trans_id',
 284         tables       => [ 'custom_variables' ],
 285         columns      => { custom_variables => [ qw(trans_id config_id sub_module) ] },
 286         query        => [
 287           config_id  => $config_id,
 288           sub_module => $params{sub_module},
 289         ],
 290         query_is_sql => 1,
 291       );
 292
 293       foreach my $key (keys %query) {
 294         # remove rose aliases. query builder sadly is not reentrant, and will reuse the same aliases. :(
 295         $query{$key} =~ s{\bt\d+(?:\.)?\b}{}g;
 296
 297         # manually inline the values. again, rose doen't know how to handly bind params in subqueries :(
 298         $query{$key} =~ s{\?}{ $config->dbh->quote($_) }xe for @{ $bind_vals{$key} };
 299
 300         $query{$key} =~ s{\n}{ }g;
 301       }
 302
 303       my $qry_config = "EXISTS (" . $query{config} . ")";
 304
 305       my @result = (
 306         'or' => [
 307           $prefix . 'id'   => [ \$query{customized} ],
 308           and              => [
 309             "!${prefix}id" => [ \$query{not_customized}  ],
 310             \$qry_config,
 311           ]
 312         ],
 313       );
 314
 315       return @result;
 316     }
 317   );
 318 }
 319
 320 1;
 321
 322 __END__
 323
 324 =encoding utf-8
 325
 326 =head1 NAME
 327
 328 SL::DB::Helper::CustomVariables - Mixin to provide custom variables relations
 329
 330 =head1 SYNOPSIS
 331
 332   # use in a primary class
 333   use SL::DB::Helper::CustomVariables (
 334     module      => 'IC',
 335     cvars_alias => 1,
 336   );
 337
 338   # use overloading in a secondary class
 339   use SL::DB::Helper::CustomVariables (
 340     sub_module  => 'orderitems',
 341     cvars_alias => 1,
 342     overloads   => {
 343       parts_id    => {
 344         class => 'SL::DB::Part',
 345         module => 'IC',
 346       }
 347     }
 348   );
 349
 350 =head1 DESCRIPTION
 351
 352 This module provides methods to deal with named custom variables. Two concepts are understood.
 353
 354 =head2 Primary CVar Classes
 355
 356 Primary classes are those that feature cvars for themselves. Currently those
 357 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
 358 for the object.
 359
 360 =head2 Secondary CVar Classes
 361
 362 Secondary classes inherit their cvars from member relationships. This is built
 363 so that orders can save a copy of the cvars of their parts, customers and the
 364 like to be immutable later on.
 365
 366 Secondary classes may currently not have cvars of their own.
 367
 368 =head1 INSTALLED METHODS
 369
 370 =over 4
 371
 372 =item C<custom_variables [ CUSTOM_VARIABLES ]>
 373
 374 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
 375 like any other OneToMany relationship.
 376
 377 Note that unlike L</cvars_by_config> this accessor only returns
 378 variables that have already been created for this object. No variables
 379 will be autovivified for configs for which no variable has been
 380 created yet.
 381
 382 =item C<cvars [ CUSTOM_VARIABLES ]>
 383
 384 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
 385 passed to import.
 386
 387 =item C<cvars_by_config>
 388
 389 Thi will return a list of CVars with the following changes over the standard accessor:
 390
 391 =over 4
 392
 393 =item *
 394
 395 The list will be returned in the sorted order of the configs.
 396
 397 =item *
 398
 399 For every config exactly one CVar will be returned.
 400
 401 =item *
 402
 403 If no cvar was found for a config, a new one will be vivified, set to the
 404 correct config, module etc, and registered into the object.
 405
 406 =item *
 407
 408 Vivified cvars for secondary classes will first try to find their base object
 409 and use that value. If no such value or cvar is found the default value from
 410 configs applies.
 411
 412 =back
 413
 414 This is useful if you need to list every possible CVar, like in CRUD masks.
 415
 416 =item C<cvar_by_name NAME [ VALUE ]>
 417
 418 Returns the CVar object for this object which matches the given internal name.
 419 Useful for print templates. If the requested cvar is not present, it will be
 420 vivified with the same rules as in C<cvars_by_config>.
 421
 422 =item C<parse_custom_variable_values>
 423
 424 When you want to edit custom variables in a form then you have
 425 unparsed values from the user. These should be written to the
 426 variable's C<unparsed_value> field.
 427
 428 This function then processes all variables and parses their
 429 C<unparsed_value> field into the proper field. It returns C<$self> for
 430 easy chaining.
 431
 432 This is automatically called in a C<before_save> hook so you don't
 433 have to do it manually if you save directly after assigning the
 434 values.
 435
 436 In an HTML form you could e.g. use something like the following:
 437
 438   [%- FOREACH var = SELF.project.cvars_by_config.as_list %]
 439     [% HTML.escape(var.config.description) %]:
 440     [% L.hidden_tag('project.custom_variables[+].config_id', var.config.id) %]
 441     [% PROCESS 'common/render_cvar_input.html' var_name='project.custom_variables[].unparsed_value' %]
 442   [%- END %]
 443
 444 Later in the controller when you want to save this project you don't
 445 have to do anything special:
 446
 447   my $project = SL::DB::Project->new;
 448   my $params  = $::form->{project} || {};
 449
 450   $project->assign_attributes(%{ $params });
 451
 452   $project->parse_custom_variable_values->save;
 453
 454 However, if you need access to a variable's value before saving in
 455 some way then you have to call this function manually. For example:
 456
 457   my $project = SL::DB::Project->new;
 458   my $params  = $::form->{project} || {};
 459
 460   $project->assign_attributes(%{ $params });
 461
 462   $project->parse_custom_variable_values;
 463
 464   print STDERR "CVar[0] value: " . $project->custom_variables->[0]->value . "\n";
 465
 466 =back
 467
 468 =head1 INSTALLED MANAGER METHODS
 469
 470 =over 4
 471
 472 =item Custom filter for GetModels
 473
 474 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:
 475
 476   filter.cvar.$config_id
 477
 478 =back
 479
 480 =head1 AUTHOR
 481
 482 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
 483 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 484
 485 =cut