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 }
  31
  32 sub save_meta_info {
  33   my ($caller_package, %params) = @_;
  34
  35   my $meta = $caller_package->meta;
  36   return 0 if $meta->{META_CVARS()};
  37
  38   $meta->{META_CVARS()} = \%params;
  39
  40   return 1;
  41 }
  42
  43 sub make_cvar_accessor {
  44   my ($caller_package, %params) = @_;
  45
  46   my $modules = ('ARRAY' eq ref $params{module}) ?
  47       join ',', @{ $params{module} } :
  48       $params{module};
  49   my @module_filter = $modules ?
  50     ("config_id" => [ \"(SELECT custom_variable_configs.id FROM custom_variable_configs WHERE custom_variable_configs.module IN ( '$modules' ))" ]) : # " make emacs happy
  51     ();
  52
  53   $caller_package->meta->add_relationships(
  54     custom_variables => {
  55       type         => 'one to many',
  56       class        => 'SL::DB::CustomVariable',
  57       column_map   => { $params{id} => 'trans_id' },
  58       query_args   => [ sub_module => $params{sub_module}, @module_filter ],
  59     }
  60   );
  61 }
  62
  63 sub make_cvar_alias {
  64   my ($caller_package) = @_;
  65   no strict 'refs';
  66   *{ $caller_package . '::cvars' } =  sub {
  67     goto &{ $caller_package . '::custom_variables' };
  68   }
  69 }
  70
  71 # this is used for templates where you need to list every applicable config
  72 # auto vivifies non existent cvar objects as necessary.
  73 sub make_cvar_by_configs {
  74   my ($caller_package, %params) = @_;
  75
  76   no strict 'refs';
  77   *{ $caller_package . '::cvars_by_config' } = sub {
  78     my ($self) = @_;
  79     @_ > 1 and croak "not an accessor";
  80
  81     my $configs     = _all_configs(%params);
  82     my $cvars       = $self->custom_variables;
  83     my %cvars_by_config = map { $_->config_id => $_ } @$cvars;
  84
  85     my @return = map(
  86       {
  87         if ( $cvars_by_config{$_->id} ) {
  88           $cvars_by_config{$_->id};
  89         }
  90         else {
  91           my $cvar = _new_cvar($self, %params, config => $_);
  92           $self->add_custom_variables($cvar);
  93           $cvar;
  94         }
  95       }
  96       @$configs
  97     );
  98
  99     return \@return;
 100   }
 101 }
 102
 103 # this is used for print templates where you need to refer to a variable by name
 104 # TODO typically these were referred as prefix_'cvar'_name
 105 sub make_cvar_by_name {
 106   my ($caller_package, %params) = @_;
 107
 108   no strict 'refs';
 109   *{ $caller_package . '::cvar_by_name' } = sub {
 110     my ($self, $name) = @_;
 111
 112     my $configs = _all_configs(%params);
 113     my $cvars   = $self->custom_variables;
 114     my $config  = first { $_->name eq $name } @$configs;
 115
 116     croak "unknown cvar name $name" unless $config;
 117
 118     my $cvar    = first { $_->config_id eq $config->id } @$cvars;
 119
 120     if (!$cvar) {
 121       $cvar = _new_cvar($self, %params, config => $config);
 122       $self->add_custom_variables($cvar);
 123     }
 124
 125     return $cvar;
 126   }
 127 }
 128
 129 sub make_cvar_as_hashref {
 130   my ($caller_package, %params) = @_;
 131
 132   no strict 'refs';
 133   *{ $caller_package . '::cvar_as_hashref' } = sub {
 134     my ($self) = @_;
 135     @_ > 1 and croak "not an accessor";
 136
 137     my $cvars_by_config = $self->cvars_by_config;
 138
 139     my %return = map {
 140       $_->config->name => { value => $_->value_as_text, is_valid => $_->is_valid }
 141     } @$cvars_by_config;
 142
 143     return \%return;
 144   }
 145 }
 146
 147 sub _all_configs {
 148   my (%params) = @_;
 149
 150   require SL::DB::CustomVariableConfig;
 151
 152   $params{module}
 153     ? SL::DB::Manager::CustomVariableConfig->get_all(query => [ module => $params{module} ])
 154     : SL::DB::Manager::CustomVariableConfig->get_all;
 155 }
 156
 157 sub _overload_by_module {
 158   my ($module, %params) = @_;
 159
 160   keys %{ $params{overloads} }; # reset each iterator
 161   while (my ($fk, $def) = each %{ $params{overloads} }) {
 162     return ($fk, $def->{class}) if $def->{module} eq $module;
 163   }
 164
 165   croak "unknown overload, cannot resolve module $module";
 166 }
 167
 168 sub _new_cvar {
 169   my ($self, %params) = @_;
 170   my $inherited_value;
 171   # check overloading first
 172   if ($params{sub_module}) {
 173     my ($fk, $class) = _overload_by_module($params{config}->module, %params);
 174     my $base_cvar = $class->new(id => $self->$fk)->load->cvar_by_name($params{config}->name);
 175     $inherited_value = $base_cvar->value;
 176   }
 177
 178   my $cvar = SL::DB::CustomVariable->new(
 179     config     => $params{config},
 180     trans_id   => $self->${ \ $params{id} },
 181     sub_module => $params{sub_module},
 182   );
 183   # value needs config
 184   $inherited_value
 185    ? $cvar->value($inherited_value)
 186    : $cvar->value($params{config}->default_value);
 187   return $cvar;
 188 }
 189
 190 sub _calc_modules_from_overloads {
 191   my (%params) = @_;
 192   my %modules;
 193
 194   for my $def (values %{ $params{overloads} || {} }) {
 195     $modules{$def->{module}} = 1;
 196   }
 197
 198   return [ keys %modules ];
 199 }
 200
 201 sub _get_primary_key_column {
 202   my ($caller_package) = @_;
 203   my $meta             = $caller_package->meta;
 204
 205   my $column_name;
 206   $column_name = $meta->{primary_key}->{columns}->[0] if $meta->{primary_key} && (ref($meta->{primary_key}->{columns}) eq 'ARRAY') && (1 == scalar(@{ $meta->{primary_key}->{columns} }));
 207
 208   croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
 209
 210   return $column_name;
 211 }
 212
 213 1;
 214
 215 __END__
 216
 217 =encoding utf-8
 218
 219 =head1 NAME
 220
 221 SL::DB::Helper::CustomVariables - Mixin to provide custom variables relations
 222
 223 =head1 SYNOPSIS
 224
 225   # use in a primary class
 226   use SL::DB::Helper::CustomVariables (
 227     module      => 'IC',
 228     cvars_alias => 1,
 229   );
 230
 231   # use overloading in a secondary class
 232   use SL::DB::Helper::CustomVariables (
 233     sub_module  => 'orderitems',
 234     cvars_alias => 1,
 235     overloads   => {
 236       parts_id    => {
 237         class => 'SL::DB::Part',
 238         module => 'IC',
 239       }
 240     }
 241   );
 242
 243 =head1 DESCRIPTION
 244
 245 This module provides methods to deal with named custom variables. Two concepts are understood.
 246
 247 =head2 Primary CVar Classes
 248
 249 Primary classes are those that feature cvars for themselves. Currently those
 250 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
 251 for the object.
 252
 253 =head2 Secondary CVar Classes
 254
 255 Secondary classes inherit their cvars from member relationships. This is built
 256 so that orders can save a copy of the cvars of their parts, customers and the
 257 like to be immutable later on.
 258
 259 Secondary classes may currently not have cvars of their own.
 260
 261 =head1 INSTALLED METHODS
 262
 263 =over 4
 264
 265 =item C<custom_variables [ CUSTOM_VARIABLES ]>
 266
 267 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
 268 like any other OneToMany relationship.
 269
 270 =item C<cvars [ CUSTOM_VARIABLES ]>
 271
 272 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
 273 passed to import.
 274
 275 =item C<cvars_by_config>
 276
 277 Thi will return a list of CVars with the following changes over the standard accessor:
 278
 279 =over 4
 280
 281 =item *
 282
 283 The list will be returned in the sorted order of the configs.
 284
 285 =item *
 286
 287 For every config exactly one CVar will be returned.
 288
 289 =item *
 290
 291 If no cvar was found for a config, a new one will be vivified, set to the
 292 correct config, module etc, and registered into the object.
 293
 294 =item *
 295
 296 Vivified cvars for secondary classes will first try to find their base object
 297 and use that value. If no such value or cvar is found the default value from
 298 configs applies.
 299
 300 =back
 301
 302 This is useful if you need to list every possible CVar, like in CRUD masks.
 303
 304 =item C<cvar_by_name NAME [ VALUE ]>
 305
 306 Returns the CVar object for this object which matches the given internal name.
 307 Useful for print templates. If the requested cvar is not present, it will be
 308 vivified with the same rules as in C<cvars_by_config>.
 309
 310 =back
 311
 312 =head1 AUTHOR
 313
 314 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 315
 316 =cut