File Coverage

blib/lib/RapidApp/TableSpec/Role/DBIC.pm
Criterion Covered Total %
statement 640 853 75.0
branch 220 392 56.1
condition 65 147 44.2
subroutine 68 88 77.2
pod 1 45 2.2
total 994 1525 65.1


line stmt bran cond sub pod time code
1             package RapidApp::TableSpec::Role::DBIC;
2 5     5   3701 use strict;
  5         10  
  5         134  
3 5     5   26 use Moose::Role;
  5         9  
  5         34  
4 5     5   21630 use Moose::Util::TypeConstraints;
  5         10  
  5         39  
5              
6 5     5   9084 use RapidApp::TableSpec::DbicTableSpec;
  5         11  
  5         150  
7 5     5   1966 use RapidApp::TableSpec::ColSpec;
  5         16  
  5         188  
8 5     5   41 use RapidApp::TableSpec::Column::Profile;
  5         11  
  5         232  
9              
10 5     5   27 use RapidApp::Util qw(:all);
  5         12  
  5         2221  
11              
12 5     5   575 use RapidApp::DBIC::Component::TableSpec;
  5         12  
  5         188  
13              
14 5     5   2449 use DBIx::Class::Helpers 2.033003;
  5         526  
  5         199  
15             require DBIx::Class::Helper::ResultSet::Util;
16              
17 5     5   369 use DBIx::Class::_Util qw/sigwarn_silencer/;
  5         7907  
  5         281  
18              
19             require Text::Glob;
20 5     5   1891 use Text::WagnerFischer qw(distance);
  5         3226  
  5         312  
21 5     5   33 use Clone qw( clone );
  5         11  
  5         176  
22 5     5   275 use Digest::MD5 qw(md5_hex);
  5         10  
  5         193  
23 5     5   2714 use curry;
  5         1249  
  5         1266  
24              
25             # hackish performance tweak:
26             my %match_glob_cache = ();
27             sub match_glob {
28 25024     25024 0 37708 my ($l,$r) = @_;
29             $match_glob_cache{$l}{$r} = Text::Glob::match_glob($l,$r)
30 25024 100       51045 unless (exists $match_glob_cache{$l}{$r});
31 25024         422992 return $match_glob_cache{$l}{$r};
32             }
33              
34             # ---
35             # Attributes 'ResultSource', 'ResultClass' and 'schema' are interdependent. If ResultSource
36             # is not supplied to the constructor, both ResultClass and schema must be.
37             has 'ResultSource', is => 'ro', isa => 'DBIx::Class::ResultSource', lazy => 1,
38             default => sub {
39             my $self = shift;
40            
41             my $schema_attr = $self->meta->get_attribute('schema');
42             $self->meta->throw_error("'schema' not supplied; cannot get ResultSource automatically!")
43             unless ($schema_attr->has_value($self));
44            
45             #return $self->schema->source($self->ResultClass);
46             return try{$self->schema->source($self->ResultClass)} ||
47             $self->schema->source((reverse split(/\:\:/,$self->ResultClass))[0]);
48             };
49              
50             has 'ResultClass', is => 'ro', isa => 'Str', lazy => 1,
51             default => sub {
52             my $self = shift;
53             my $source_name = $self->ResultSource->source_name;
54             return $self->ResultSource->schema->class($source_name);
55             };
56              
57             has 'schema', is => 'ro', lazy => 1, default => sub { (shift)->ResultSource->schema; };
58             # ---
59              
60 5     5   37 use List::Util;
  5         25  
  5         17687  
61              
62             sub _coerce_ColSpec {
63 751     751   1262 my $v = $_[0];
64             ( # quick/dirty simulate from 'ArrayRef[Str]'
65             ref $v && ref($v) eq 'ARRAY' &&
66 751 50 33 254   7294 !( List::Util::first { ref($_) || ! defined $_ } @$v )
  254         1159  
67             ) ? RapidApp::TableSpec::ColSpec->new(colspecs => $v) : $v
68             }
69              
70             subtype 'ColSpec', as 'Object';
71             coerce 'ColSpec', from 'ArrayRef[Str]', via { &_coerce_ColSpec($_) };
72              
73             has 'include_colspec', is => 'ro', isa => 'ColSpec',
74             required => 1, coerce => \&_coerce_ColSpec, trigger => sub { (shift)->_colspec_attr_init_trigger(@_) };
75            
76             has 'updatable_colspec', is => 'ro', isa => 'ColSpec',
77             default => sub {[]}, coerce => \&_coerce_ColSpec, trigger => sub { (shift)->_colspec_attr_init_trigger(@_) };
78            
79             has 'creatable_colspec', is => 'ro', isa => 'ColSpec',
80             default => sub {[]}, coerce => \&_coerce_ColSpec, trigger => sub { (shift)->_colspec_attr_init_trigger(@_) };
81            
82             has 'always_fetch_colspec', is => 'ro', isa => 'ColSpec',
83             default => sub {[]}, coerce => \&_coerce_ColSpec, trigger => sub { (shift)->_colspec_attr_init_trigger(@_) };
84              
85             # See attr in RapidApp::Module::StorCmp::Role::DbicLnk
86             has 'no_header_transform', is => 'ro', isa => 'Bool', default => 0;
87              
88             sub _colspec_attr_init_trigger {
89 384     384   795 my ($self,$ColSpec) = @_;
90 384         9937 my $sep = $self->relation_sep;
91 384   50     1074 /${sep}/ and die "Fatal: ColSpec '$_' is invalid because it contains the relation separater string '$sep'" for ($ColSpec->all_colspecs);
92            
93             $ColSpec->expand_colspecs(sub {
94 384     384   1315 $self->expand_relspec_wildcards(\@_)
95 384         2070 });
96             }
97              
98       176 0   sub BUILD {}
99             after BUILD => sub {
100             my $self = shift;
101            
102             $self->init_relspecs;
103            
104             };
105              
106             sub init_relspecs {
107 176     176 0 341 my $self = shift;
108            
109 176         5262 $self->multi_rel_columns_indx;
110            
111             $self->include_colspec->expand_colspecs(sub {
112 176     176   814 $self->expand_relationship_columns(@_)
113 176         4917 });
114            
115             $self->include_colspec->expand_colspecs(sub {
116 176     176   697 $self->expand_related_required_fetch_colspecs(@_)
117 176         5670 });
118            
119            
120 176         5494 foreach my $col ($self->no_column_colspec->base_colspec->all_colspecs) {
121 83 100       2122 $self->Cnf_columns->{$col} = {} unless ($self->Cnf_columns->{$col});
122 83         1979 %{$self->Cnf_columns->{$col}} = (
123 83         155 %{$self->Cnf_columns->{$col}},
  83         1998  
124             no_column => \1,
125             no_multifilter => \1,
126             no_quick_search => \1
127             );
128 83         198 push @{$self->Cnf_columns_order},$col;
  83         2242  
129             }
130 176         4789 uniq($self->Cnf_columns_order);
131            
132 176         4916 my @rels = $self->include_colspec->all_rel_order;
133            
134 176         438 $self->add_related_TableSpec($_) for (grep { $_ ne '' } @rels);
  260         827  
135            
136 176         703 $self->init_local_columns;
137            
138 176         383 foreach my $rel (@{$self->related_TableSpec_order}) {
  176         4971  
139 84         2150 my $TableSpec = $self->related_TableSpec->{$rel};
140 84         293 for my $name ($TableSpec->updated_column_order) {
141 166 50       505 die "Column name conflict: $name is already defined (rel: $rel)" if ($self->has_column($name));
142 166         4447 $self->column_name_relationship_map->{$name} = $rel;
143             }
144             }
145            
146             }
147              
148              
149             has 'column_data_alias', is => 'ro', isa => 'HashRef', default => sub {{}};
150 118     118 0 3058 sub apply_column_data_alias { my $h = (shift)->column_data_alias; %$h = ( %$h, @_ ) }
  118         465  
151              
152             has 'no_column_colspec', is => 'ro', isa => 'ColSpec', coerce => 1, default => sub {[]};
153             sub expand_relationship_columns {
154 176     176 0 365 my $self = shift;
155 176         493 my @columns = @_;
156 176         383 my @expanded = ();
157            
158 176   50     495 my $rel_cols = $self->get_Cnf('relationship_column_names') || return;
159            
160 176         405 my @no_cols = ();
161 176         413 foreach my $col (@columns) {
162 321         610 push @expanded, $col;
163            
164 321         635 foreach my $relcol (@$rel_cols) {
165 383 100       718 next unless (match_glob($col,$relcol));
166            
167             my @add = (
168             $self->Cnf_columns->{$relcol}->{keyField},
169             $relcol . '.' . $self->Cnf_columns->{$relcol}->{displayField},
170             $relcol . '.' . $self->Cnf_columns->{$relcol}->{valueField}
171 118         3208 );
172 118         261 push @expanded, @add;
173 118         2856 $self->apply_column_data_alias( $relcol => $self->Cnf_columns->{$relcol}->{keyField} );
174 118         242 push @no_cols, grep { !$self->colspecs_to_colspec_test(\@columns,$_) } @add;
  354         776  
175             }
176             }
177 176         5050 $self->no_column_colspec->add_colspecs(@no_cols);
178            
179 176         1221 return @expanded;
180             }
181              
182             sub expand_related_required_fetch_colspecs {
183 176     176 0 337 my $self = shift;
184 176         539 my @columns = @_;
185 176         309 my @expanded = ();
186            
187 176         699 my $local_cols = $self->get_Cnf_order('columns');
188              
189 176         421 my @no_cols = ();
190 176         434 foreach my $spec (@columns) {
191 675         1050 push @expanded, $spec;
192            
193 675         990 foreach my $col (@$local_cols) {
194 6174 100       8182 next unless (match_glob($spec,$col));
195            
196 940 50       22937 my $req = $self->Cnf_columns->{$col}->{required_fetch_colspecs} or next;
197 0 0       0 $req = [ $req ] unless (ref $req);
198            
199 0         0 my @req_columns = ();
200 0         0 foreach my $spec (@$req) {
201 0         0 my $colname = $spec;
202 0         0 my $sep = $self->relation_sep;
203 0         0 $colname =~ s/\./${sep}/g;
204 0         0 push @req_columns, $self->column_prefix . $colname;
205             #push @req_columns, $colname;
206             }
207             # This is then used later during the store read request in DbicLink2
208             $self->Cnf_columns->{$col}->{required_fetch_columns} = []
209 0 0       0 unless (defined $self->Cnf_columns->{$col}->{required_fetch_columns});
210            
211 0         0 push @{$self->Cnf_columns->{$col}->{required_fetch_columns}}, @req_columns;
  0         0  
212              
213 0         0 push @expanded, @$req;
214 0         0 push @no_cols, grep { !$self->colspecs_to_colspec_test(\@columns,$_) } @$req;
  0         0  
215             }
216             }
217 176         4955 $self->no_column_colspec->add_colspecs(@no_cols);
218              
219 176         1128 return @expanded;
220             }
221              
222              
223             sub base_colspec {
224 176     176 0 301 my $self = shift;
225 176         4598 return $self->include_colspec->base_colspec->colspecs;
226             }
227              
228             has 'Cnf_columns', is => 'ro', isa => 'HashRef', lazy => 1, default => sub {
229             my $self = shift;
230             return clone($self->get_Cnf('columns'));
231             };
232             has 'Cnf_columns_order', is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub {
233             my $self = shift;
234             return clone($self->get_Cnf_order('columns'));
235             };
236              
237             sub init_local_columns {
238 176     176 0 396 my $self = shift;
239            
240 176         4631 my $class = $self->ResultClass;
241 176 50       3229 unless ( $class->primary_columns > 0 ) {
242 0     0   0 local $SIG{__WARN__} = sub {}; # GitHub Issue #167 - TODO/FIXME
243 0         0 $class->set_primary_key( $class->columns )
244             }
245            
246 176         8268 my @order = @{$self->Cnf_columns_order};
  176         4778  
247 176         794 @order = $self->filter_base_columns(@order);
248            
249 176         5771 $self->add_db_column($_,$self->Cnf_columns->{$_}) for (@order);
250             };
251              
252              
253             sub add_db_column($@) {
254 781     781 0 1473 my $self = shift;
255 781         1338 my $name = shift;
256 781 50       2194 my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  781         4891  
257            
258 781 100       2856 %opt = $self->get_relationship_column_cnf($name,\%opt) if($opt{relationship_info});
259            
260 781         21111 $opt{name} = $self->column_prefix . $name;
261            
262 781         2750 my $editable = $self->filter_updatable_columns($name,$opt{name});
263 781         3584 my $creatable = $self->filter_creatable_columns($name,$opt{name});
264            
265             # -- NEW: VIRTUAL COLUMNS SUPPORT:
266 781 100       21458 if($self->ResultClass->has_virtual_column($name)) {
267             # Only editable if a custom 'set_function' has been defined for the virtual column:
268 11 100   11   480 unless(try{$self->ResultClass->column_info($name)->{set_function}}) {
  11         652  
269 4         512 $editable = 0;
270 4         12 $creatable = 0;
271             }
272             }
273             # --
274            
275             ## -- (see also below comment and commit 2dccadc6f3 which was a regression)
276             ## Hate having to do this, but we have to consider the column profiles here,
277             ## because this happens before they are applied (->add_columns, at the end of this
278             ## method). Specifically, we need to consider profiles which turn OFF allow_add
279             ## and allow_edit, otherwise, we'll clobber those settings if we want to turn
280             ## them on here. And we do need to turn them on, specifically again for the case of
281             ## creatable but not editable, because the default of editable changes the default
282             ## for creatable.
283             $creatable = 0 if List::Util::first {
284 2196     2196   4374 $RapidApp::TableSpec::Column::Profile::NO_ALLOW_ADD_PROFILES{$_}
285 781 50       33952 } @{$opt{profiles}||[]};
  781 100       3682  
286            
287             $editable = 0 if List::Util::first {
288 2196     2196   3451 $RapidApp::TableSpec::Column::Profile::NO_ALLOW_EDIT_PROFILES{$_}
289 781 50       3369 } @{$opt{profiles}||[]};
  781 100       2450  
290             ## --
291            
292            
293 781 100       2518 $opt{allow_edit} = \0 unless ($editable);
294 781 100       2004 $opt{allow_add} = \0 unless ($creatable);
295            
296             #### We do need this code after all -- see above comment. Was removed in 2dccadc6f3
297             # New: flip the allow edit/add flags on if they are not already set to something,
298             # and no_column is not set. This is needed for the case of creatable but not
299             # editable, since the default allow_add is based on the value of allow_edit, which
300             # is intended for the case of it being set by the user
301 781 100       3445 unless(jstrue($opt{no_column})) {
302 717 100 100     2230 $opt{allow_edit} //= \1 if ($editable);
303 717 100 100     1841 $opt{allow_add} //= \1 if ($creatable);
304             }
305              
306 781 100 100     3415 unless ($editable or $creatable) {
307 641 100       1634 $opt{rel_combo_field_cnf} = $opt{editor} if($opt{editor});
308 641         1430 $opt{editor} = '' ;
309             }
310              
311 781         2759 $self->add_columns(\%opt);
312             }
313              
314              
315              
316             # Load and process config params from TableSpec_cnf in the ResultClass plus
317             # additional defaults:
318             has 'Cnf_order', is => 'ro', isa => 'HashRef', default => sub {{}};
319 352     352 0 8772 sub get_Cnf_order { (shift)->Cnf_order->{$_[0]} }
320              
321              
322             has 'Cnf', is => 'ro', lazy => 1, default => sub {
323             my $self = shift;
324             my $class = $self->ResultClass;
325            
326             # Load the TableSpec Component on the Result Class if it isn't already:
327             # (should this be done like this? this is a global change and could be an overreach)
328             unless($class->can('TableSpec_cnf')) {
329             $class->load_components('+RapidApp::DBIC::Component::TableSpec');
330             $class->apply_TableSpec;
331             }
332            
333             my $cf = $class->get_built_Cnf;
334            
335             #%{$self->Cnf_order} = %{ $cf->{order} || {} };
336             #return $cf->{data} || {};
337            
338             # Legacy/backcompat: simulate the olf TableSpec_cnf format:
339             my $sim_order = { columns => [ keys %{$cf->{columns}} ] };
340            
341             %{$self->Cnf_order} = %{ $sim_order || {} };
342             return $cf || {};
343             }, isa => 'HashRef';
344 528     528 0 12889 sub get_Cnf { (shift)->Cnf->{$_[0]} }
345              
346             has 'relationship_column_configs', is => 'ro', isa => 'HashRef', lazy_build => 1;
347             sub _build_relationship_column_configs {
348 0     0   0 my $self = shift;
349            
350 0         0 my $class = $self->ResultClass;
351 0 0       0 return {} unless ($class->can('TableSpec_cnf'));
352            
353 0         0 my %rel_cols_indx = map {$_=>1} @{$self->get_Cnf('relationship_column_names')};
  0         0  
  0         0  
354 0         0 my %columns = $class->TableSpec_get_conf('columns');
355 0         0 return { map { $_ => $columns{$_} } grep { $rel_cols_indx{$_} } keys %columns };
  0         0  
  0         0  
356             };
357              
358              
359             # colspecs that were added solely for the relationship columns
360             # get stored in 'added_relationship_column_relspecs' and are then
361             # hidden in DbicLink2.
362             # TODO: come up with a better way to handle this. It's ugly.
363             has 'added_relationship_column_relspecs' => (
364             is => 'rw', isa => 'ArrayRef', default => sub {[]},
365             #trigger => sub { my ($self,$val) = @_; uniq($val) }
366             );
367              
368              
369             sub expand_relspec_wildcards {
370 752     752 0 1436 my $self = shift;
371 752         988 my $colspec = shift;
372            
373 752 100       1595 if(ref($colspec) eq 'ARRAY') {
374 384         653 my @exp = ();
375 384         1071 push @exp, $self->expand_relspec_wildcards($_,@_) for (@$colspec);
376 384         1166 return @exp;
377             }
378            
379 368   66     9673 my $Source = shift || $self->ResultSource;
380 368         756 my @ovr_macro_keywords = @_;
381            
382             # Exclude colspecs that start with #
383 368 50       955 return () if ($colspec =~ /^\#/);
384            
385 368         1011 my @parts = split(/\./,$colspec);
386 368 100       1353 return ($colspec) unless (@parts > 1);
387            
388 85         165 my $clspec = pop @parts;
389 85         173 my $relspec = join('.',@parts);
390            
391             # There is nothing to expand if the relspec doesn't contain wildcards:
392 85 100       355 return ($colspec) unless ($relspec =~ /[\*\?\[\]\{]/);
393            
394 1         4 push @parts,$clspec;
395            
396 1         2 my $rel = shift @parts;
397 1 50       3 my $pre; { my ($match) = ($rel =~ /^(\!)/); $rel =~ s/^(\!)//; $pre = $match ? $match : ''; }
  1         3  
  1         4  
  1         2  
  1         4  
398            
399 1         16 my @rel_list = $Source->relationships;
400             #scream($_) for (map { $Source->relationship_info($_) } @rel_list);
401            
402 1         13 my @macro_keywords = @ovr_macro_keywords;
403 1         3 my $macro; {
404 1         1 my ($match) = ($rel =~ /^\{([\?\:a-zA-Z0-9]+)\}/);
  1         4  
405 1         2 $rel =~ s/^\{([\?\:a-zA-Z0-9]+)\}//;
406 1         1 $macro = $match;
407             }
408 1 50       12 push @macro_keywords, split(/\:/,$macro) if ($macro);
409 1         5 my %macros = map { $_ => 1 } @macro_keywords;
  0         0  
410            
411 1 0 0     3 my @accessors = grep { $_ eq 'single' or $_ eq 'multi' or $_ eq 'filter'} @macro_keywords;
  0         0  
412 1 50       4 if (@accessors > 0) {
413 0         0 my %ac = map { $_ => 1 } @accessors;
  0         0  
414 0         0 @rel_list = grep { $ac{ $Source->relationship_info($_)->{attrs}->{accessor} } } @rel_list;
  0         0  
415             }
416              
417 1         4 my @matching_rels = grep { match_glob($rel,$_) } @rel_list;
  2         7  
418             die 'Invalid ColSpec: "' . $rel . '" doesn\'t match any relationships of ' .
419             $Source->schema->class($Source->source_name)
420 1 50 33     19 unless ($macros{'?'} or @matching_rels > 0 or scalar(@rel_list) == 0);
      33        
421            
422 1         4 my @expanded = ();
423 1         3 foreach my $rel_name (@matching_rels) {
424 2         12 my @suffix = $self->expand_relspec_wildcards(join('.',@parts),$Source->related_source($rel_name),@ovr_macro_keywords);
425 2         13 push @expanded, $pre . $rel_name . '.' . $_ for (@suffix);
426             }
427              
428 1         6 return (@expanded);
429             }
430              
431              
432             has 'relation_sep' => ( is => 'ro', isa => 'Str', required => 1 );
433             has 'relspec_prefix' => ( is => 'ro', isa => 'Str', default => '' );
434             # needed_join is the relspec_prefix in DBIC 'join' attr format
435             has 'needed_join' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub {
436             my $self = shift;
437             return {} if ($self->relspec_prefix eq '');
438             return $self->chain_to_hash(split(/\./,$self->relspec_prefix));
439             });
440             has 'column_prefix' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub {
441             my $self = shift;
442             return '' if ($self->relspec_prefix eq '');
443             my $col_pre = $self->relspec_prefix;
444             my $sep = $self->relation_sep;
445             $col_pre =~ s/\./${sep}/g;
446             return $col_pre . $self->relation_sep;
447             });
448              
449              
450              
451              
452             around 'get_column' => sub {
453             my $orig = shift;
454             my $self = shift;
455             my $name = shift;
456            
457             my $rel = $self->column_name_relationship_map->{$name};
458             if ($rel) {
459             my $TableSpec = $self->related_TableSpec->{$rel};
460             return $TableSpec->get_column($name) if ($TableSpec);
461             }
462            
463             return $self->$orig($name);
464             };
465              
466              
467             # accepts a list of column names and returns the names that match the base colspec
468             sub filter_base_columns {
469 176     176 0 333 my $self = shift;
470 176         543 my @columns = @_;
471            
472             # Why has this come up?
473             # filter out columns with invalid characters (*):
474 176         392 @columns = grep { /^[A-Za-z0-9\-\_\.]+$/ } @columns;
  1403         3037  
475            
476 176         663 return $self->colspec_select_columns({
477             colspecs => $self->base_colspec,
478             columns => \@columns,
479             });
480             }
481              
482             sub filter_include_columns {
483 781     781 0 1129 my $self = shift;
484 781         1513 my @columns = @_;
485            
486 781         20411 my @inc_cols = $self->colspec_select_columns({
487             colspecs => $self->include_colspec->colspecs,
488             columns => \@columns,
489             });
490            
491 781         28229 my @rel_cols = $self->colspec_select_columns({
492             colspecs => $self->added_relationship_column_relspecs,
493             columns => \@columns,
494             });
495            
496 781         1997 my %allowed = map {$_=>1} @inc_cols,@rel_cols;
  688         2490  
497 781         1395 return grep { $allowed{$_} } @columns;
  1376         3411  
498             }
499              
500             # accepts a list of column names and returns the names that match updatable_colspec
501             sub filter_updatable_columns {
502 784     784 0 1336 my $self = shift;
503 784         1989 my @columns = @_;
504            
505             #exclude all multi relationship columns (except new m2m multi rel columns)
506             @columns = grep {
507 784         1582 $self->m2m_rel_columns_indx->{$self->column_prefix . $_} ||
508 1565 100       40499 !$self->multi_rel_columns_indx->{$self->column_prefix . $_}
509             } @columns;
510            
511 784         20334 return $self->colspec_select_columns({
512             colspecs => $self->updatable_colspec->colspecs,
513             columns => \@columns,
514             });
515             }
516              
517              
518              
519             # accepts a list of column names and returns the names that match creatable_colspec
520             sub filter_creatable_columns {
521 781     781 0 1256 my $self = shift;
522 781         1897 my @columns = @_;
523            
524             #exclude all multi relationship columns
525             #@columns = grep {!$self->multi_rel_columns_indx->{$_}} @columns;
526            
527             #exclude all multi relationship columns (except new m2m multi rel columns)
528             @columns = grep {
529 781         1459 $self->m2m_rel_columns_indx->{$self->column_prefix . $_} ||
530 1562 100       44164 !$self->multi_rel_columns_indx->{$self->column_prefix . $_}
531             } @columns;
532              
533             # First filter by include_colspec:
534 781         2089 @columns = $self->filter_include_columns(@columns);
535            
536 781         23573 return $self->colspec_select_columns({
537             colspecs => $self->creatable_colspec->colspecs,
538             columns => \@columns,
539             });
540             }
541              
542              
543              
544             # Tests whether or not the colspec in the second arg matches the colspec of the first arg
545             # The second arg colspec does NOT expand wildcards, it has to be a specific rel/col string
546             sub colspec_to_colspec_test {
547 1683     1683 0 1835 my $self = shift;
548 1683         1893 my $colspec = shift;
549 1683         1786 my $test_spec = shift;
550            
551 1683         2157 my ($match) = ($colspec =~ /^(\!)/); $colspec =~ s/^(\!)//;
  1683         1933  
552 1683 50       2319 my $x = $match ? -1 : 1;
553            
554 1683         2738 my @parts = split(/\./,$colspec);
555 1683         2381 my @test_parts = split(/\./,$test_spec);
556 1683 100       3519 return undef unless(scalar @parts == scalar @test_parts);
557            
558 841         1210 foreach my $part (@parts) {
559 1151 50       1786 my $test = shift @test_parts or return undef;
560 1151 100       1694 return undef unless (match_glob($part,$test));
561             }
562            
563 472         1002 return $x;
564             }
565              
566             sub colspecs_to_colspec_test {
567 354     354 0 447 my $self = shift;
568 354         412 my $colspecs = shift;
569 354         418 my $test_spec = shift;
570            
571 354 50       711 $colspecs = [ $colspecs ] unless (ref($colspecs) eq 'ARRAY');
572            
573 354         422 my $match = 0;
574 354         540 foreach my $colspec (@$colspecs) {
575 1683   100     2497 my $result = $self->colspec_to_colspec_test($colspec,$test_spec) || next;
576 472 50       771 return 0 if ($result < 0);
577 472 50       880 $match = 1 if ($result > 0);
578             }
579            
580 354         865 return $match;
581             }
582              
583              
584              
585             my %dist_cache = ();
586             sub get_distance {
587 2196     2196 0 3397 my ($l,$r) = @_;
588 2196 100       5981 $dist_cache{$l}{$r} = distance($l,$r) unless (exists $dist_cache{$l}{$r});
589 2196         365184 return $dist_cache{$l}{$r};
590             }
591              
592              
593             #around colspec_test => &func_debug_around();
594              
595             # TODO:
596             # abstract this logic (much of which is redundant) into its own proper class
597             # (merge with Mike's class)
598             # Tests whether or not the supplied column name matches the supplied colspec.
599             # Returns 1 for positive match, 0 for negative match (! prefix) and undef for no match
600             sub _colspec_test($$){
601 34688     34688   43446 my $self = shift;
602 34688   50     52180 my $full_colspec = shift || die "full_colspec is required";
603 34688   50     49575 my $col = shift || die "col is required";
604            
605             # @other_colspecs - optional.
606             # If supplied, the column will also be tested against the colspecs in @other_colspecs,
607             # and no match will be returned unless this colspec matches *and* has the lowest
608             # edit distance of any other matches. This logic is designed so that remaining
609             # colspecs to be tested can be considered, and only the best match will win. This
610             # is meaningful when determining things like order based on a list of colspecs. This
611             # doesn't serve any purpose when doing a straight bool up/down test
612             # tested with
613 34688         52000 my @other_colspecs = @_;
614            
615            
616 34688         37538 my $full_colspec_orig = $full_colspec;
617 34688         48614 my ($neg_flag) = ($full_colspec =~ /^(\!)/); $full_colspec =~ s/^(\!)//;
  34688         43359  
618 34688 50       48220 my $x = $neg_flag ? -1 : 1;
619 34688 50       43215 my $match_return = $neg_flag ? 0 : 1;
620            
621 34688         58910 my @parts = split(/\./,$full_colspec);
622 34688         46626 my $colspec = pop @parts;
623 34688         48221 my $relspec = join('.',@parts);
624              
625 34688         875190 my $sep = $self->relation_sep;
626 34688         43535 my $prefix = $relspec;
627 34688         44197 $prefix =~ s/\./${sep}/g;
628            
629 34688         70049 @parts = split(/${sep}/,$col);
630 34688         49447 my $test_col = pop @parts;
631 34688         46437 my $test_prefix = join($sep,@parts);
632            
633             # no match:
634 34688 100       101544 return undef unless ($prefix eq $test_prefix);
635            
636             # match (return 1 or 0):
637 17314 100       26659 if (match_glob($colspec,$test_col)) {
638             # Calculate WagnerFischer edit distance
639 2196         3604 my $distance = get_distance($colspec,$test_col);
640            
641             # multiply my $x to set the sign, then flip so bigger numbers
642             # mean better match instead of the reverse
643 2196         3675 my $value = $x * (1000 - $distance); # <-- flip
644            
645 2196         3450 foreach my $spec (@other_colspecs) {
646 13414 100       23084 my $other_val = $self->colspec_test($spec,$col) or next;
647              
648             # A colspec in @other_colspecs is a better match than us, so we defer:
649 1304 100       2928 return undef if (abs $other_val > abs $value);
650             }
651 2128         8217 return $value;
652             };
653            
654             # no match:
655 15118         62392 return undef;
656             }
657              
658             #
659             # colspec_test_key is used to see if _colspec_test changed, this is
660             # the only relevant indicator to refetch the result for the given
661             # colspec_test
662             #
663 5     5   44 use B::Deparse;
  5         20  
  5         34693  
664             our $colspec_test_source;
665             {
666             my $deparse = B::Deparse->new;
667             $colspec_test_source = $deparse->coderef2text(\&_colspec_test);
668             }
669              
670             # New: caching wrapper for performance:
671             sub colspec_test($$){
672 37116     37116 0 66093 my ( $self, @args ) = @_;
673 37116         66815 my $colspec_key = join('|',@args);
674 37116   100     106945 return $self->{_colspec_test_cache}{$colspec_key} //= $self->_colspec_test(@args);
675             }
676              
677             # returns a list of loaded column names that match the supplied colspec set
678             sub get_colspec_column_names {
679 0     0 0 0 my $self = shift;
680 0         0 my @colspecs = @_;
681 0 0       0 @colspecs = @{$_[0]} if (ref($_[0]) eq 'ARRAY');
  0         0  
682            
683             # support for passing colspecs with relspec wildcards:
684 0         0 @colspecs = $self->expand_relspec_wildcards(\@colspecs,undef,'?');
685            
686 0         0 return $self->colspec_select_columns({
687             colspecs => \@colspecs,
688             columns => [ $self->updated_column_order ]
689             });
690             }
691              
692             # returns a list of all loaded column names except those that match the supplied colspec set
693             sub get_except_colspec_column_names {
694 0     0 0 0 my $self = shift;
695            
696 0         0 my %colmap = map { $_ => 1} $self->get_colspec_column_names(@_);
  0         0  
697 0         0 return grep { ! $colmap{$_} } $self->updated_column_order;
  0         0  
698             }
699              
700             # Tests if the supplied colspec set matches all of the supplied columns
701             sub colspec_matches_columns {
702 0     0 0 0 my $self = shift;
703 0         0 my $colspecs = shift;
704 0         0 my @columns = @_;
705 0         0 my @matches = $self->colspec_select_columns({
706             colspecs => $colspecs,
707             columns => \@columns
708             });
709 0 0       0 return 1 if (@columns == @matches);
710 0         0 return 0;
711             }
712              
713             our $colspec_select_columns_source;
714              
715             # Returns a sublist of the supplied columns that match the supplied colspec set.
716             # The colspec set is considered as a whole, with each column name tested against
717             # the entire compiled set, which can contain both positive and negative (!) colspecs,
718             # with the most recent match taking precidence.
719             sub colspec_select_columns {
720 3395     3395 0 5520 my $self = shift;
721 3395 50       7923 my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  3395         11041  
722              
723             $self->{_colspec_select_columns_cache} = {}
724 3395 100       8247 unless defined $self->{_colspec_select_columns_cache};
725              
726 3395 50       6909 my $colspecs = $opt{colspecs} or die "colspec_select_columns(): expected 'colspecs'";
727 3395 50       6064 my $columns = $opt{columns} or die "colspec_select_columns(): expected 'columns'";
728 3395         4228 $columns = [ sort { $a cmp $b } @{$columns} ];
  7513         13953  
  3395         9791  
729              
730             my $colspec_select_columns_key = join('_',
731 3395         14468 md5_hex(join('_',@{$colspecs})),
732 3395         5415 md5_hex(join('_',@{$columns})),
  3395         10703  
733             );
734              
735 1296         4140 return @{$self->{_colspec_select_columns_cache}{$colspec_select_columns_key}}
736 3395 100       9408 if defined $self->{_colspec_select_columns_cache}{$colspec_select_columns_key};
737              
738 2099         3158 my $cache_key;
739 2099 100       54626 if ($self->has_cache) {
740 1557         76090 $cache_key = join('_','colspec_select_columns_cache',
741             md5_hex($colspec_test_source.$colspec_select_columns_source),
742             md5_hex($self->ResultClass),
743             $colspec_select_columns_key,
744             );
745 1557         34267 my $cache_content = $self->cache->get($cache_key);
746 1557 100       352484 return @{$self->{_colspec_select_columns_cache}{$colspec_select_columns_key} = $cache_content}
  683         4137  
747             if $cache_content;
748             }
749              
750             # if best_match_look_ahead is true, the current remaining colspecs will be passed
751             # to each invocation of colspec_test which will cause it to only return a match
752             # when testing the *closest* (according to WagnerFischer edit distance) colspec
753             # of the set to the column. This prevents
754 1416         3304 my $best_match = $opt{best_match_look_ahead};
755            
756 1416 50       3063 $colspecs = [ $colspecs ] unless (ref $colspecs);
757 1416 50       2568 $columns = [ $columns ] unless (ref $columns);
758            
759 1416 50       3753 $opt{match_data} = {} unless ($opt{match_data});
760              
761 1416         2680 my %match = map { $_ => 0 } @$columns;
  3815         7774  
762 1416         2385 my @order = ();
763 1416         1791 my $i = 0;
764 1416         2780 for my $spec (@$colspecs) {
765 5852         15591 my @remaining = @$colspecs[++$i .. $#$colspecs];
766 5852         9685 for my $col (@$columns) {
767              
768 23702         38374 my @arg = ($spec,$col);
769 23702 100       45591 push @arg, @remaining if ($best_match); # <-- push the rest of the colspecs after the current for index
770            
771 23702 100       38097 my $result = $self->colspec_test(@arg) or next;
772 3252 50       6840 push @order, $col if ($result > 0);
773 3252         4653 $match{$col} = $result;
774             $opt{match_data}->{$col} = {
775             index => $i - 1,
776             colspec => $spec
777 3252 100       12064 } unless ($opt{match_data}->{$col});
778             }
779             }
780            
781 1416         3365 my $colspec_select_columns = [ uniq(grep { $match{$_} > 0 } @order) ];
  3252         7283  
782 1416 100       2897 if ($cache_key) {
783 874         21609 $self->cache->set($cache_key,$colspec_select_columns);
784             }
785 1416         787153 return @{$self->{_colspec_select_columns_cache}{$colspec_select_columns_key} = $colspec_select_columns};
  1416         10692  
786             }
787              
788             {
789             my $deparse = B::Deparse->new;
790             $colspec_select_columns_source = $deparse->coderef2text(\&colspec_select_columns);
791             }
792              
793             # Applies the original column order defined in the table Schema:
794             sub apply_natural_column_order {
795 92     92 0 191 my $self = shift;
796 92         2282 my $class = $self->ResultClass;
797              
798             # New: need to consult the TableSpec method now that we move single-rels up into the column
799             # list at the location of their FK column -- its no longer as simple as columns then rels
800 92 50       1634 my @local = $class->can('default_TableSpec_cnf_column_order')
801             ? ( $class->default_TableSpec_cnf_column_order )
802             : ( $class->columns, $class->relationships ); # fall-back for good measure
803              
804             $self->reorder_by_colspec_list(
805 92 50       256 @local, @{ $self->include_colspec->colspecs || [] }
  92         2739  
806             );
807             }
808              
809             # reorders the entire column list according to a list of colspecs. This is called
810             # by DbicLink2 to use the same include_colspec to also define the column order
811             sub reorder_by_colspec_list {
812 92     92 0 234 my $self = shift;
813 92         367 my @colspecs = @_;
814 92 50       337 @colspecs = @{$_[0]} if (ref($_[0]) eq 'ARRAY');
  0         0  
815            
816             # Check the supplied colspecs for any that don't contain '.'
817             # if there are none, and all of them contain a '.', then we
818             # need to add the base colspec '*'
819 92         220 my $need_base = 1;
820 92   100     1037 ! /\./ and $need_base = 0 for (@colspecs);
821 92 50       288 unshift @colspecs, '*' if ($need_base);
822            
823 92         672 my @new_order = $self->colspec_select_columns({
824             colspecs => \@colspecs,
825             columns => [ $self->updated_column_order ],
826             best_match_look_ahead => 1
827             });
828            
829             # Add all the current columns to the end of the new list in case any
830             # got missed. (this prevents the chance of this operation dropping any
831             # of the existing columns, dupes are filtered out below):
832 92         812 push @new_order, $self->updated_column_order;
833            
834 92         279 my %seen = ();
835 92         224 @{$self->column_order} = grep { !$seen{$_}++ } @new_order;
  92         2040  
  1548         2393  
836 92         313 return $self->updated_column_order; #<-- for good measure
837             }
838              
839             sub relation_colspecs {
840 0     0 0 0 my $self = shift;
841 0         0 return $self->include_colspec->subspec;
842             }
843              
844             sub relation_order {
845 0     0 0 0 my $self = shift;
846 0         0 return $self->include_colspec->rel_order;
847             }
848              
849              
850             sub new_TableSpec {
851 84     84 0 184 my $self = shift;
852 84         2752 return RapidApp::TableSpec::DbicTableSpec->new(@_);
853             #return RapidApp::TableSpec->with_traits('RapidApp::TableSpec::Role::DBIC')->new(@_);
854             }
855              
856              
857              
858             # Returns the TableSpec associated with the supplied column name
859             sub column_TableSpec {
860 0     0 0 0 my $self = shift;
861 0         0 my $column = shift;
862              
863 0         0 my $rel = $self->column_name_relationship_map->{$column};
864 0 0       0 unless ($rel) {
865 0         0 my %ndx = map {$_=>1}
866 0         0 keys %{$self->columns},
867 0         0 @{$self->added_relationship_column_relspecs};
  0         0  
868            
869             #scream($column,\%ndx);
870            
871 0 0       0 return $self if ($ndx{$column});
872 0         0 return undef;
873             }
874            
875 0         0 return $self->related_TableSpec->{$rel}->column_TableSpec($column);
876             }
877              
878             # Accepts a list of columns and divides them into a hash of arrays
879             # with keys of the relspec to which each set of columns belongs, with
880             # both the localized and original column names in a hashref.
881             # This logic is used in update in DbicLink2
882             sub columns_to_relspec_map {
883 0     0 0 0 my $self = shift;
884 0         0 my @columns = @_;
885 0         0 my $map = {};
886            
887 0         0 foreach my $col (@columns) {
888 0 0       0 my $TableSpec = $self->column_TableSpec($col) or next;
889 0         0 my $pre = $TableSpec->column_prefix;
890 0         0 my $local_name = $col;
891 0         0 $local_name =~ s/^${pre}//;
892 0         0 push @{$map->{$TableSpec->relspec_prefix}}, {
  0         0  
893             local_colname => $local_name,
894             orig_colname => $col
895             };
896             }
897            
898 0         0 return $map;
899             }
900              
901              
902             sub columns_to_reltree {
903 0     0 0 0 my $self = shift;
904 0         0 my @columns = @_;
905 0         0 my %map = (''=>[]);
906 0         0 foreach my $col (@columns) {
907 0   0     0 my $rel = $self->column_name_relationship_map->{$col} || '';
908 0         0 push @{$map{$rel}}, $col;
  0         0  
909             }
910            
911 0         0 my %tree = map {$_=>1} @{delete $map{''}};
  0         0  
  0         0  
912             #$tree{'@' . $_} = $self->columns_to_reltree(@{$map{$_}}) for (keys %map);
913            
914 0         0 foreach my $rel (keys %map) {
915 0 0       0 my $TableSpec = $self->related_TableSpec->{$rel} or die "Failed to find related TableSpec $rel";
916 0         0 $tree{'@' . $rel} = $TableSpec->columns_to_reltree(@{$map{$rel}});
  0         0  
917             }
918              
919 0         0 return \%tree;
920             }
921              
922              
923             sub walk_columns_deep {
924 3     3 0 9 my $self = shift;
925 3         6 my $code = shift;
926 3         8 my @columns = @_;
927            
928 3         8 my $recurse = 0;
929 3 50       37 $recurse = 1 if((caller(1))[3] eq __PACKAGE__ . '::walk_columns_deep');
930 3 50       19 local $_{return} = undef unless ($recurse);
931 3 50       15 local $_{rel} = undef unless ($recurse);
932 3 50       12 local $_{depth} = 0 unless ($recurse);
933              
934            
935 3         12 my %map = (''=>[]);
936 3         10 foreach my $col (@columns) {
937 3   50     100 my $rel = $self->column_name_relationship_map->{$col} || '';
938 3         9 push @{$map{$rel}}, $col;
  3         12  
939             }
940            
941            
942 3         7 my @local_cols = @{delete $map{''}};
  3         11  
943            
944 3         83 my $pre = $self->column_prefix;
945 3         9 my %name_map = map { my $name = $_; $name =~ s/^${pre}//; $name => $_ } @local_cols;
  3         7  
  3         25  
  3         15  
946 3         12 local $_{name_map} = \%name_map;
947 3         10 local $_{return} = $code->($self,@local_cols);
948 3         7 local $_{depth} = $_{depth}; $_{depth}++;
  3         7  
949 3         22 foreach my $rel (keys %map) {
950 0 0       0 my $TableSpec = $self->related_TableSpec->{$rel} or die "Failed to find related TableSpec $rel";
951 0         0 local $_{last_rel} = $_{rel};
952 0         0 local $_{rel} = $rel;
953 0         0 $TableSpec->walk_columns_deep($code,@{$map{$rel}});
  0         0  
954             }
955             }
956              
957              
958              
959              
960             # Accepts a DBIC Row object and a relspec, and returns the related DBIC
961             # Row object associated with that relspec
962             sub related_Row_from_relspec {
963 0     0 0 0 my $self = shift;
964 0   0     0 my $Row = shift || return undef;
965 0   0     0 my $relspec = shift || '';
966            
967 0         0 my @parts = split(/\./,$relspec);
968 0   0     0 my $rel = shift @parts || return $Row;
969 0 0       0 return $Row if ($rel eq '');
970            
971 0 0       0 my $info = $Row->result_source->relationship_info($rel) or die "Relationship $rel not found";
972            
973             # Skip unless its a single (not multi) relationship:
974 0 0 0     0 return undef unless ($info->{attrs}->{accessor} eq 'single' || $info->{attrs}->{accessor} eq 'filter');
975            
976 0         0 my $Related = $Row->$rel;
977 0         0 return $self->related_Row_from_relspec($Related,join('.',@parts));
978             }
979              
980              
981             # Is this func still used??
982             # Like column_order but only considers columns in the local TableSpec object
983             # (i.e. not in related TableSpecs)
984             sub local_column_names {
985 0     0 0 0 my $self = shift;
986 0         0 my %seen = ();
987 0 0       0 return grep { !$seen{$_}++ && exists $self->columns->{$_} } @{$self->column_order}, keys %{$self->columns};
  0         0  
  0         0  
  0         0  
988             }
989              
990              
991             has 'column_name_relationship_map' => ( is => 'ro', isa => 'HashRef[Str]', default => sub {{}} );
992             has 'related_TableSpec' => ( is => 'ro', isa => 'HashRef[RapidApp::TableSpec]', default => sub {{}} );
993             has 'related_TableSpec_order' => ( is => 'ro', isa => 'ArrayRef[Str]', default => sub {[]} );
994             sub add_related_TableSpec {
995 84     84 0 171 my $self = shift;
996 84         152 my $rel = shift;
997 84 50       299 my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  0         0  
998            
999             die "There is already a related TableSpec associated with the '$rel' relationship - " . Dumper(caller_data_brief(20,'^RapidApp')) if (
1000 84 50       2319 defined $self->related_TableSpec->{$rel}
1001             );
1002            
1003 84 50       2163 my $info = $self->ResultClass->relationship_info($rel) or die "Relationship '$rel' not found.";
1004 84         4397 my $relclass = $info->{class};
1005              
1006 84         2360 my $relspec_prefix = $self->relspec_prefix;
1007 84 100 66     308 $relspec_prefix .= '.' if ($relspec_prefix and $relspec_prefix ne '');
1008 84         235 $relspec_prefix .= $rel;
1009            
1010 84         1227 my $table = RapidApp::DBIC::Component::TableSpec::_table_name_safe($relclass->table);
1011 84         2436 my %params = (
1012             name => $table,
1013             ResultClass => $relclass,
1014             schema => $self->schema, #<-- need both ResultClass and schema to identify ResultSource
1015             relation_sep => $self->relation_sep,
1016             relspec_prefix => $relspec_prefix,
1017             include_colspec => $self->include_colspec->get_subspec($rel),
1018             no_header_transform => $self->no_header_transform
1019             );
1020              
1021 84   100     2283 $params{updatable_colspec} = $self->updatable_colspec->get_subspec($rel) || [];
1022 84   50     2269 $params{creatable_colspec} = $self->creatable_colspec->get_subspec($rel) || [];
1023 84   100     2217 $params{no_column_colspec} = $self->no_column_colspec->get_subspec($rel) || [];
1024              
1025 84         740 %params = ( %params, %opt );
1026            
1027 84         2141 my $class = $self->ResultClass;
1028 84 50 33     1183 if($class->can('TableSpec_get_conf') and $class->TableSpec_has_conf('related_column_property_transforms')) {
1029 84         337 my $rel_transforms = $class->TableSpec_get_conf('related_column_property_transforms');
1030 84 50       243 $params{column_property_transforms} = $rel_transforms->{$rel} if ($rel_transforms->{$rel});
1031            
1032             # -- Hard coded default 'header' transform (2011-12-25 by HV)
1033             # If there isn't already a configured column_property_transform for 'header'
1034             # add one that appends the relspec prefix. This is currently built-in because
1035             # it is such a ubiquotous need and it is just more intuitive than creating yet
1036             # other param that will always be 'on'. I am sure there are cases where this is
1037             # not desired, but until I run across them it will just be hard coded:
1038             # * Update: Yes, we do want an option to turn this off, and now there is (2015-09-29 by HV)
1039 84 50       2459 unless($self->no_header_transform) {
1040 84 100 50 292   789 $params{column_property_transforms}->{header} ||= sub { $_ ? "$_ ($relspec_prefix)" : $_ };
  292         1403  
1041             }
1042             # --
1043            
1044             }
1045            
1046 84 50       574 my $TableSpec = $self->new_TableSpec(%params) or die "Failed to create related TableSpec";
1047            
1048 84         2388 $self->related_TableSpec->{$rel} = $TableSpec;
1049 84         194 push @{$self->related_TableSpec_order}, $rel;
  84         2183  
1050            
1051 84         550 return $TableSpec;
1052             }
1053              
1054             sub addIf_related_TableSpec {
1055 0     0 0 0 my $self = shift;
1056 0         0 my ($rel) = @_;
1057            
1058 0   0     0 my $TableSpec = $self->related_TableSpec->{$rel} || $self->add_related_TableSpec(@_);
1059 0         0 return $TableSpec;
1060             }
1061              
1062             around 'get_column' => \&_has_get_column_modifier;
1063             around 'has_column' => \&_has_get_column_modifier;
1064             sub _has_get_column_modifier {
1065 1768     1768   15609 my $orig = shift;
1066 1768         2451 my $self = shift;
1067 1768         2563 my $name = $_[0];
1068            
1069 1768         47680 my $rel = $self->column_name_relationship_map->{$name};
1070 1768         2589 my $obj = $self;
1071 1768 100       10218 $obj = $self->related_TableSpec->{$rel} if (defined $rel);
1072            
1073 1768         8275 return $obj->$orig(@_);
1074             }
1075              
1076              
1077             around 'updated_column_order' => sub {
1078             my $orig = shift;
1079             my $self = shift;
1080            
1081             my %seen = ();
1082             # Start with and preserve the column order in this object:
1083             my @order = grep { !$seen{$_}++ } @{$self->column_order};
1084            
1085             # Pull in any unseen columns from the superclass (should normally be none, except when initializing)
1086             push @order, grep { !$seen{$_}++ } $self->$orig(@_);
1087            
1088             my @rels = ();
1089             push @rels, $self->related_TableSpec->{$_}->updated_column_order for (@{$self->related_TableSpec_order});
1090            
1091             # Preserve the existing order, adding only new/unseen related columns:
1092             push @order, grep { !$seen{$_}++ } @rels;
1093            
1094             @{$self->column_order} = @order;
1095             return @{$self->column_order};
1096             };
1097              
1098              
1099              
1100              
1101             has 'multi_rel_columns_indx', is => 'ro', lazy => 1, default => sub {
1102             my $self = shift;
1103             my $list = $self->get_Cnf('multi_relationship_column_names') || [];
1104            
1105             my %indx = ();
1106             foreach my $rel (@$list) {
1107             unless($self->ResultSource->has_relationship($rel)) {
1108             warn RED.BOLD . "\n\nMulti-rel column error: '$rel' is not a valid " .
1109             "relationship of ResultSource '" . $self->ResultSource->source_name .
1110             "'\n\n" . CLEAR;
1111             next;
1112             }
1113             my $info = $self->ResultSource->relationship_info($rel) || {};
1114             my $cond = $info->{cond};
1115             my $h = $cond ? $self->ResultClass->parse_relationship_cond($cond) : {};
1116             my ($rev_relname) = (keys %{$self->ResultSource->reverse_relationship_info($rel)});
1117             $indx{$rel} = { %$h,
1118             info => $info,
1119             rev_relname => $rev_relname,
1120             relname => $rel,
1121             parent_source => $self->ResultSource->source_name
1122             };
1123             }
1124            
1125             # -- finally refactored this into simpler code above (with error handling).
1126             # Got too carried away with map!!!
1127             #my %indx = map { $_ =>
1128             # { %{$self->ResultClass->parse_relationship_cond(
1129             # $self->ResultSource->relationship_info($_)->{cond}
1130             # )},
1131             # info => $self->ResultSource->relationship_info($_),
1132             # rev_relname => (keys %{$self->ResultSource->reverse_relationship_info($_)})[0],
1133             # relname => $_
1134             # }
1135             #} @$list;
1136             # --
1137            
1138             # Add in any defined functions (this all needs to be cleaned up/refactored):
1139             $self->Cnf_columns->{$_}->{function} and $indx{$_}->{function} = $self->Cnf_columns->{$_}->{function}
1140             for (keys %indx);
1141            
1142             #scream_color(GREEN,'loading');
1143             #scream_color(GREEN.BOLD,$_,$self->Cnf_columns->{$_}) for (keys %indx);
1144            
1145             #scream(\%indx);
1146              
1147             return \%indx;
1148             }, isa => 'HashRef';
1149              
1150              
1151              
1152             =head2 resolve_dbic_colname
1153              
1154             =over 4
1155              
1156             =item Arguments: $fieldName, \%merge_join, $get_render_col (bool)
1157              
1158             =item Return Value: Valid DBIC 'select'
1159              
1160             =back
1161              
1162             Returns a value which can be added to DBIC's ->{attr}{select} in order to select the column.
1163              
1164             $fieldName is the ExtJS column name to resolve. This contains the full path to the column which
1165             may span multiple joins, for example:
1166              
1167             rel1__rel2__foo
1168              
1169             In this case, 'rel1' is a relationship of the local (top-level) source, and rel2 is a relationship
1170             of the 'rel1' source. The \%merge_join argument is passed by reference and modified to contain the
1171             join needed for the select. In the case, assuming 'foo' is an ordinary column of the 'rel2' source,
1172             the select/as/join might be the following:
1173              
1174             select : 'rel2.foo'
1175             as : 'rel1__rel2__foo' # already implied by the $fieldName
1176             join : { rel1 => 'rel2' } # merged into %merge_join
1177              
1178             However, 'foo' might not be a column in the relationship of the 'rel2' source - it might be a
1179             relationship or a virtual column. In these cases, a sub-select/query is generated for the select,
1180             which is dependent on what foo actually is. For multi-rels it is a count of the related rows while
1181             for single rels it is a select of the remote display_column. For virtual columns, it is a
1182             sub-select of whatever the 'sql' attr is set to for the given virtual_column config.
1183              
1184             =cut
1185             sub resolve_dbic_colname {
1186 46     46 1 106 my ($self, $fieldName, $merge_join, $get_render_col)= @_;
1187 46   50     179 $get_render_col ||= 0;
1188              
1189             # $rel is the alias of the last relationship name in the chain --
1190             # if $fieldName is 'rel1__rel2__rel3__blah', $rel is 'rel3'
1191             #
1192             # $col is the column name in the remote source --
1193             # if $fieldName is 'rel1__rel2__rel3__blah', $col is 'blah'
1194             #
1195             # $join is the join attr needed to get to $rel/$col
1196             # if $fieldName is 'rel1__rel2__rel3__blah', $join is { rel1 => { rel2 => 'rel3' } }
1197             # the join needs to be merged into the common %merge_join hash
1198             #
1199             # $cond_data contains details about $col when $col is a relationship (otherwise it is undef)
1200             # if $fieldName is 'rel1__rel2__rel3__blah', $cond_data contains info about
1201             # the relationship 'blah', which is a relationship of the rel3 source
1202 46         133 my ($rel,$col,$join,$cond_data) = $self->resolve_dbic_rel_alias_by_column_name($fieldName,$get_render_col);
1203              
1204 46 50 33     186 %$merge_join = %{ merge($merge_join,$join) }
  46         166  
1205             if ($merge_join and $join);
1206              
1207              
1208 46 100       130 if (!defined $cond_data) {
1209             # $col is a simple column, not a relationship, we're done:
1210 17         78 return "$rel.$col";
1211             } else {
1212              
1213             # If cond_data is defined, the relation is a multi-relation, and we need to either
1214             # join and group-by, or run a sub-query. If join-and-group-by happens twice, it
1215             # breaks COUNT() (because the number of joined rows gets multiplied) so by default
1216             # we only use sub-queries. In fact, join and group-by has a lot of problems on
1217             # MySQL and we should probably never use it.
1218 29   66     209 $cond_data->{function} = $cond_data->{function} || $self->multi_rel_columns_indx->{$fieldName};
1219            
1220             # Support for a custom aggregate function
1221 29 100       91 if (ref($cond_data->{function}) eq 'CODE') {
1222             # TODO: we should use hash-style parameters
1223 7         26 return $cond_data->{function}->($self,$rel,$col,$join,$cond_data,$fieldName);
1224             }
1225             else {
1226 22         68 my $m2m_attrs = $cond_data->{info}->{attrs}->{m2m_attrs};
1227 22 100       48 if($m2m_attrs) {
1228             # -- m2m relationship column --
1229             #
1230             # Setup the special GROUP_CONCAT render/function
1231             #
1232             # This is a partial implementation supporting "m2m" (many_to_many)
1233             # relationship columns as added by the special result class function:
1234             # __PACKAGE__->TableSpec_m2m( 'rel' => 'linkrel', 'foreignrel' );
1235             # Which needs to be used instead of the built-in __PACKAGE__->many_to_many
1236             # function. (side note: this is needed for the same reason that
1237             # DBIx::Class::IntrospectableM2M was created).
1238             #
1239             # This function renders the values as a CSV list, so it is only suitable
1240             # for many_to_many cases with a limited number of rows (e.g. roles table)
1241             # which is probably the most common scenario, but certainly not the only
1242             # one. Also, this CSV list is tied into the functioning of the m2m column
1243             # editor. It is also db-specific, and only tested is MySQL and SQLite.
1244             # All these reasons are why I say this implementation is "partial" in
1245             # its current form.
1246              
1247 7         22 my $rel_info = $m2m_attrs->{rinfo};
1248 7         13 my $rev_rel_info = $m2m_attrs->{rrinfo};
1249            
1250             # initial hard-coded example the dynamic logic was based on:
1251             #my $sql = '(' .
1252             # # SQLite Specific:
1253             # #'SELECT(GROUP_CONCAT(flags.flag,", "))' .
1254             #
1255             # # MySQL Sepcific:
1256             # #'SELECT(GROUP_CONCAT(flags.flag SEPARATOR ", "))' .
1257             #
1258             # # Generic (MySQL & SQLite):
1259             # 'SELECT(GROUP_CONCAT(flags.flag))' .
1260             #
1261             # ' FROM ' . $source->from .
1262             # ' JOIN `flags` `flags` ON customers_to_flags.flag = flags.flag' .
1263             # ' WHERE ' . $cond_data->{foreign} . ' = ' . $rel . '.' . $cond_data->{self} .
1264             #')';
1265            
1266            
1267             ### TODO: build this using DBIC (subselect_rs as_query? resultset_column ?)
1268             ### This is unfortunately database specific. It works in MySQL and SQLite, and
1269             ### should work in any database with the GROUP_CONCAT function. It doesn't work
1270             ### in PostgrSQL because it doesn't have GROUP_CONCAT. This will have to be implemented
1271             ### separately first each db. TODO: ask the storage engine for the db type and apply
1272             ### a correct version of the function:
1273             ### UPDATE: Now works with PostgreSQL - PR #150, mst++, TBSliver++
1274            
1275             # TODO: support cross-db relations
1276            
1277 7         209 local *_ = $self->schema->storage->sql_maker->curry::_quote;
1278              
1279 7         662 my $rel_table_raw = $self->schema->source($rel_info->{source})->name;
1280 7         696 my $rev_rel_table_raw = $self->schema->source($rev_rel_info->{source})->name;
1281              
1282 7         411 my $rel_table = _($rel_table_raw);
1283 7         338 my $rev_rel_table = _($rev_rel_table_raw);
1284            
1285 7         210 my $rel_alias = (reverse split(/\./,$rel_table_raw))[0];
1286 7         37 my $rev_rel_alias = (reverse split(/\./,$rev_rel_table_raw))[0];
1287            
1288 7         42 my $rel_join_col = _(join '.', $rel_alias, $rev_rel_info->{cond_info}{self});
1289 7         226 my $rev_rel_join_col = _(join '.', $rev_rel_alias, $rev_rel_info->{cond_info}{foreign});
1290            
1291 7         209 my $rev_rel_col = _(join '.', $rel_alias, $rel_info->{cond_info}{foreign});
1292 7         202 my $rel_col = _(join '.', $rel, $cond_data->{self});
1293              
1294 7         185 my $sql = do {
1295              
1296 7         200 my $sqlt_type = $self->schema->storage->sqlt_type;
1297 7         622 my $concat = do {
1298 7 50       35 if ($sqlt_type eq 'PostgreSQL') {
1299 0         0 "STRING_AGG($rev_rel_join_col, ',')"
1300             } else {
1301 7         27 "GROUP_CONCAT($rev_rel_join_col)";
1302             }
1303             };
1304 7         62 join(' ', '(',
1305             "SELECT($concat)",
1306             " FROM $rel_table",
1307             " JOIN $rev_rel_table",
1308             " ON $rel_join_col = $rev_rel_join_col",
1309             " WHERE $rev_rel_col = $rel_col",
1310             ')');
1311              
1312             };
1313              
1314 7         63 return { '' => \$sql, -as => $fieldName };
1315             }
1316             else {
1317            
1318             die '"parent_source" missing from $cond_data -- cannot correlate sub-select for "$col"'
1319 15 50       69 unless ($cond_data->{parent_source});
1320            
1321 15         421 my $p_source = $self->schema->source($cond_data->{parent_source});
1322 15         579 my $rel_attrs = $p_source->relationship_info($col)->{attrs};
1323            
1324 15         84 my $rel_rs;
1325            
1326 15 50       140 my $recent_dbic = $p_source->can('resolve_relationship_condition') ? 1 : 0;
1327            
1328             # Github Issue #95
1329 15 50       44 if(!$rel_attrs->{where}) {
1330             # correlate logic works as-is unless the relationship has a 'where'
1331 15         58 $rel_rs = $self->_correlate_rs_rel(
1332             $p_source->resultset->search_rs(undef,{ alias => $rel }),
1333             $col
1334             );
1335             }
1336             else {
1337             ##########################################################################################
1338             # If there is a 'where' we have to fall back to the old logic -- FIXME!!!
1339             ##########################################################################################
1340 0         0 my $source = $self->schema->source($cond_data->{info}{source});
1341              
1342             # $rel_rs is a resultset object for $col when $col is the name of a relationship (which
1343             # it is because we're here). We are using $rel_rs to create a sub-query for a count.
1344             # We are suppling a custom alias that is not likely to conflict with the rest of the
1345             # query.
1346             $rel_rs = $source->resultset_class
1347             ->new($source, { alias => "${col}_alias" })
1348             ->search_rs(undef,{
1349 0 0       0 %{$source->resultset_attributes || {}},
1350 0 0       0 %{$cond_data->{info}{attrs} || {}}
  0         0  
1351             });
1352              
1353             # --- Github Issue #40 ---
1354             # This was the original, manual condition generation which only supported
1355             # single-key relationship conditions (and not multi-key or CodeRef):
1356             #my $cond = { "${rel}_alias.$cond_data->{foreign}" => \[" = $rel.$cond_data->{self}"] };
1357            
1358 0         0 my $cond = do {
1359 0 0       0 if($recent_dbic) {
1360             # On recent versions on DBIC, we now have a public method to do this:
1361             $p_source->resolve_relationship_condition(
1362             rel_name => $col,
1363             foreign_alias => $rel_rs->current_source_alias,
1364             self_alias => $rel
1365             )->{condition}
1366 0         0 }
1367             else {
1368             # LEGACY - this code path only applies to relationships with a 'where' in their attrs
1369             # and on a version of DBIC prior to the addition of ->resolve_relationship_condition
1370             #
1371             # Original/old comments on this block -
1372             # This is the new way which uses DBIC's internal machinery in the proper way
1373             # and works for any multi-rel cond type, including CodeRef:
1374             # UPDATE (#68): Starting in DBIC 0.08280 this invocation is producing a
1375             # warning because it doesn't know what "${col}_alias" is
1376             # (we're declaring it as the alias in $rel_rs above). It thinks
1377             # it should be a relationship, but it is just the local ('me')
1378             # alias (from the perspective of $rel_rs)
1379             #
1380             # This is not the way _resolve_condition is supposed to be called
1381             # and this will stop working in the next major DBIC release. _resolve_condition
1382             # needs to be called with a valid relname which we do not have in this case. In
1383             # order to fix this, we need to call _resolve_condition from one rel higher so
1384             # we can pass $col as the rel. For now we are just ignoring the warning which
1385             # we know is being produced. See Github Issue #68
1386 0         0 local $SIG{__WARN__} = sigwarn_silencer(qr/\Qresolution on non-existent relationship/);
1387             $source->_resolve_condition(
1388             $cond_data->{info}{cond},
1389 0         0 $rel_rs->current_source_alias, #<-- the self alias ("${col}_alias" as set above)
1390             $rel, #<-- the foreign alias
1391             )
1392             }
1393             };
1394             # ---
1395              
1396 0         0 $rel_rs = $rel_rs->search_rs($cond);
1397             ##########################################################################################
1398             }
1399              
1400 15 50       12003 if($cond_data->{info}{attrs}{accessor} eq 'multi') {
1401             # -- standard multi relationship column --
1402             # This is where the count sub-query is generated that provides
1403             # the numeric count of related items for display in multi rel columns.
1404 15         412 return { '' => $rel_rs->count_rs->as_query, -as => $fieldName };
1405             }
1406             else {
1407             # -- NEW: virtualized single relationship column --
1408             # Returns the related display_column value as a subquery using the same
1409             # technique as the count for multi-relationship columns
1410 0         0 my $source = $self->schema->source($cond_data->{info}{source});
1411 0 0       0 my $display_column = $source->result_class->TableSpec_get_conf('display_column')
1412             or die "Failed to get display_column";
1413 0         0 return { '' => $rel_rs->get_column($display_column)->as_query, -as => $fieldName };
1414             }
1415             }
1416             }
1417             }
1418             }
1419              
1420             # Now a passthrough to the stand-alone DBIx::Class::Helpers util function:
1421             sub _correlate_rs_rel {
1422 15     15   8042 my ($self, $Rs, $rel) = @_;
1423 15         87 DBIx::Class::Helper::ResultSet::Util::correlate( $Rs, $rel )
1424             }
1425              
1426             sub resolve_dbic_rel_alias_by_column_name {
1427 46     46 0 67 my $self = shift;
1428 46         69 my $fieldName = shift;
1429 46   50     132 my $get_render_col = shift || 0;
1430            
1431             # -- applies only to relationship columns and currently only used for sort:
1432             # UPDATE: now also used for column_summaries
1433 46 50       87 if($get_render_col) {
1434 0         0 my $render_col = $self->relationship_column_render_column_map->{$fieldName};
1435 0 0       0 $fieldName = $render_col if ($render_col);
1436             }
1437             # --
1438            
1439 46         1254 my $rel = $self->column_name_relationship_map->{$fieldName};
1440 46 50       97 unless ($rel) {
1441            
1442 46         1122 my $join = $self->needed_join;
1443 46         1197 my $pre = $self->column_prefix;
1444 46         198 $fieldName =~ s/^${pre}//;
1445            
1446             # Special case for "multi" relationships... they return the related row count
1447 46         1204 my $cond_data = $self->multi_rel_columns_indx->{$fieldName};
1448 46 100       100 if ($cond_data) {
1449             # Need to manually build the join to include the rel column:
1450             # Update: we no longer add this to the join, because we use a sub-select
1451             # to query the multi-relation, and don't want a product-style join in
1452             # the top-level query.
1453             #my $rel_pre = $self->relspec_prefix;
1454             #$rel_pre .= '.' unless ($rel_pre eq '');
1455             #$rel_pre .= $name;
1456             #$join = $self->chain_to_hash(split(/\./,$rel_pre));
1457            
1458             # ---
1459             # What was the purpose of this? The above was commented out and this was added
1460             # in its place (Mike?) it doesn't seem to do anything but break multi-rel columns
1461             # when joined via several intermediate single rels. Removed 2012-07-07 by HV.
1462             #$join = $self->chain_to_hash($self->relspec_prefix)
1463             # if length $self->relspec_prefix;
1464             # ---
1465            
1466 22         82 return ('me',$fieldName,$join,$cond_data);
1467             }
1468            
1469            
1470             ## ----
1471             ## NEW: VIRTUAL COLUMNS SUPPORT (added 2012-07-06 by HV)
1472             ## Check if this column has been setup via 'add_virtual_columns' in the
1473             ## Result class and look for special attributes 'function' (higher priority)
1474             ## or 'sql' (lower priority) for virtualizing the column in the
1475             ## query. This is similar to a multi rel column, but is still a column
1476             ## and not a relationship (TODO: combine this logic with the older multi
1477             ## rel column logic)
1478 24 100       588 if ($self->ResultClass->has_virtual_column($fieldName)) {
    50          
1479 7   50     458 my $info = $self->ResultClass->column_info($fieldName) || {};
1480             my $function = $info->{function} || sub {
1481 7     7   24 my ($self,$rel,$col,$join,$cond_data2,$name2) = @_;
1482 7         22 my $sql = $info->{sql} || 'SELECT(NULL)';
1483             # also see RapidApp::DBIC::Component::VirtualColumnsExt
1484 7         24 $sql = $info->{sql}->($self->ResultClass, $col) if ref $sql eq 'CODE';
1485            
1486             # ** translate 'self.' into the relname of the current context. This
1487             # should either be 'me.' or the join name. This logic is important
1488             # to be able to have an sql snippet defined in a Result class that will
1489             # work across different join/perspectives.
1490 7         27 $sql =~ s/self\./${rel}\./g;
1491 7         13 $sql =~ s/\`self\`\./\`${rel}\`\./g; #<-- also support backtic quoted form (quote_sep)
1492             # **
1493            
1494 7         83 return { '' => \"($sql)", -as => $col };
1495 7   50     784 };
1496 7         31 $cond_data = { function => $function };
1497            
1498 7 50       29 if ($info->{join}) {
1499 0         0 my @prefix = split(/\./,$self->relspec_prefix);
1500 0         0 push @prefix, $info->{join};
1501 0         0 $join = $self->chain_to_hash(@prefix);
1502             }
1503            
1504 7         36 return ('me',$fieldName,$join,$cond_data);
1505             }
1506             ## ----
1507             ## --- NEW: Virtual Single Relationship Column (Github Issue #40)
1508             elsif($self->ResultClass->has_relationship($fieldName)){
1509 0         0 my $cnf = $self->Cnf_columns->{$fieldName};
1510 0 0 0     0 if ($cnf && $cnf->{virtualized_single_rel}) {
1511             # This is emulating the existing format being passed around and
1512             # used for relationship columns (see multi_rel_columns_indx). This
1513             # is going to be totally refactored and simplified later (also,
1514             # note that 'me' has no actual meaning and is a throwback)
1515 0         0 return ('me',$fieldName,$join,{
1516             relname => $fieldName,
1517             info => $self->ResultClass->relationship_info($fieldName),
1518             parent_source => $self->ResultSource->source_name
1519             });
1520             }
1521             }
1522             # ---
1523            
1524 17         788 return ('me',$fieldName,$join);
1525             }
1526            
1527 0         0 my $TableSpec = $self->related_TableSpec->{$rel};
1528 0         0 my ($alias,$dbname,$join,$cond_data) = $TableSpec->resolve_dbic_rel_alias_by_column_name($fieldName,$get_render_col);
1529 0 0       0 $alias = $rel if ($alias eq 'me');
1530 0         0 return ($alias,$dbname,$join,$cond_data);
1531             }
1532              
1533              
1534             # This exists specifically to handle relationship columns:
1535             has 'custom_dbic_rel_aliases' => ( is => 'ro', isa => 'HashRef', default => sub {{}} );
1536              
1537             # Updated: the last item may now be a ref in which case it will be set
1538             # as the last value instead of {}
1539             sub chain_to_hash {
1540 0     0 0 0 my $self = shift;
1541 0         0 my @chain = @_;
1542            
1543 0         0 my $hash = {};
1544 0         0 my $last;
1545              
1546 0         0 my @evals = ();
1547 0         0 my $i = 0;
1548 0         0 foreach my $item (@chain) {
1549 0         0 my $right = '{}';
1550 0         0 my $set_end = 0;
1551 0 0       0 if($i++ == 0) {
1552 0         0 $last = pop @chain;
1553 0 0       0 if(ref $last) {
1554 0         0 $right = '$last';
1555 0         0 $set_end = 1;
1556             }
1557             else {
1558             # Put it back if its not a ref:
1559 0         0 push @chain, $last;
1560             }
1561             }
1562 0         0 my $left = '$hash->{\'' . join('\'}->{\'',@chain) . '\'}';
1563 0         0 unshift @evals, $left . ' = ' . $right;
1564 0 0       0 pop @chain unless ($set_end);
1565             }
1566 0         0 eval $_ for (@evals);
1567            
1568 0         0 return $hash;
1569             }
1570              
1571              
1572             has 'relationship_column_render_column_map', is => 'ro', isa => 'HashRef', default => sub {{}};
1573             sub get_relationship_column_cnf {
1574 184     184 0 435 my $self = shift;
1575 184         415 my $rel = shift;
1576 184 50       621 my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  184         987  
1577            
1578             # New: apply profiles early so any profiles which set rel column options
1579             # are available (e.g. 'soft_rel' which sets 'auto_editor_params' -- added for #77)
1580 184 100       711 if ($opt{profiles}) {
1581 102         1014 my $o = RapidApp::TableSpec::Column::Profile->_apply_profiles_soft(\%opt);
1582 102         1024 %opt = %$o;
1583             }
1584              
1585 184 50       659 return $self->get_virtual_relationship_column_cnf($rel,\%opt) if ($opt{virtualized_single_rel});
1586 184 100       5823 return $self->get_multi_relationship_column_cnf($rel,\%opt) if ($self->multi_rel_columns_indx->{$rel});
1587            
1588 82         228 my $conf = \%opt;
1589 82 50       273 my $info = $conf->{relationship_info} or die "relationship_info is required";
1590            
1591 82         2111 my $table = RapidApp::DBIC::Component::TableSpec::_table_name_safe($self->ResultClass->table);
1592 82         669 my $err_info = "rel col: " . $table . ".$rel - " . Dumper($conf);
1593            
1594 82 50       22186 die "displayField is required ($err_info)" unless (defined $conf->{displayField});
1595 82 50       317 die "valueField is required ($err_info)" unless (defined $conf->{valueField});
1596 82 50       254 die "keyField is required ($err_info)" unless (defined $conf->{keyField});
1597            
1598 82     82   7089 my $Source = try{$self->ResultSource->related_source($rel)} catch {
1599 0     0   0 warn RED.BOLD . $_ . CLEAR;
1600 0         0 return undef;
1601 82 50       929 } or return undef;
1602              
1603            
1604             # --- Disable quick searching on rel cols with virtual display_column
1605             # If the display column of the remote result class is virtual we turn
1606             # off quick searching. This *could* be supported in the future; it would require
1607             # some special coding. It is probably not something that should be on per
1608             # default anyway, because searching on a virtual column could be slow
1609             # (see the complex HAVING stuff for multifilters)**
1610             $conf = { %$conf,
1611             # TODO: this can probably be enabled much easier now, just like column summaries (#93)
1612             # the complex 'HAVING' stuff mentioned above has since been unfactored (#51)
1613             no_quick_search => \1,
1614 82 100   82   13795 } if (try{$self->ResultSource->related_class($rel)->has_virtual_column($conf->{displayField})});
  82         3875  
1615             #
1616             # ---
1617              
1618 82         7793 my $render_col = $self->column_prefix . $rel . $self->relation_sep . $conf->{displayField};
1619 82         2103 my $key_col = $self->column_prefix . $rel . $self->relation_sep . $conf->{valueField};
1620 82         2063 my $upd_key_col = $self->column_prefix . $conf->{keyField};
1621            
1622             # -- Assume the the column profiles of the display column:
1623 82         2121 my $relTS = $self->related_TableSpec->{$rel};
1624 82 50       228 if($relTS) {
1625 82         2044 my $relconf = $relTS->Cnf_columns->{$conf->{displayField}};
1626 82   33     357 $conf->{profiles} = $relconf->{profiles} || $conf->{profiles};
1627            
1628             # New: special exception - do not assume the 'autoinc' profile which
1629             # disables add/edit for the purposes of the *local* table. This does
1630             # not apply to the relationship column context, and we need to remove
1631             # it to prevent relationship columns with auto_increment display_column
1632             # from being forced read-only. This is a bit hackish - TODO/FIXME
1633 82         291 @{$conf->{profiles}} = grep { $_ ne 'autoinc' } @{$conf->{profiles}}
  672         1032  
  82         251  
1634 82 50       250 if($conf->{profiles});
1635             }
1636             # --
1637            
1638 82         2087 my $colname = $self->column_prefix . $rel;
1639            
1640             # --
1641             # Store the render column that is associated with this relationship column
1642             # Currently we use this for sorting on relationship columns:
1643 82         2405 $self->relationship_column_render_column_map->{$colname} = $render_col;
1644             # Also store in the column itself - added for excel export - is this redundant to above? probably. FIXME
1645 82         208 $conf->{render_column} = $render_col;
1646             # --
1647              
1648 82         155 my $rows;
1649             my $read_raw_munger = sub {
1650 0     0   0 $rows = (shift)->{rows};
1651 0 0       0 $rows = [ $rows ] unless (ref($rows) eq 'ARRAY');
1652 0         0 foreach my $row (@$rows) {
1653 0 0       0 $row->{$colname} = $row->{$upd_key_col} if (exists $row->{$upd_key_col});
1654             }
1655 82         411 };
1656            
1657 82         257 my $required_fetch_columns = [
1658             $render_col,
1659             $key_col,
1660             $upd_key_col
1661             ];
1662            
1663 82 50       318 $conf->{renderer} = 'Ext.ux.showNull' unless ($conf->{renderer});
1664            
1665             # ---
1666             # We need to set 'no_fetch' to prevent DbicLink2 trying to fetch the rel name
1667             # as a column -- EXCEPT if the rel name is ALSO a column name:
1668 82 100       2083 my $is_also_local_col = $self->ResultSource->has_column($rel) ? 1 : 0;
1669 82 100       853 $conf->{no_fetch} = 1 unless ($is_also_local_col);
1670             # ---
1671            
1672            
1673 82         962 $conf = { %$conf,
1674            
1675             #no_quick_search => \1,
1676             #no_multifilter => \1,
1677            
1678             query_id_use_column => $upd_key_col,
1679             query_search_use_column => $render_col,
1680            
1681             #required_fetch_colspecs => [],
1682            
1683             required_fetch_columns => $required_fetch_columns,
1684            
1685             read_raw_munger => RapidApp::Handler->new( code => $read_raw_munger ),
1686             #update_munger => RapidApp::Handler->new( code => $update_munger ),
1687             };
1688            
1689 82         1464 my $cur_renderer = $conf->{renderer};
1690            
1691 82         184 my $is_phy = $conf->{is_phy_colname};
1692            
1693             # NEW: use simpler DbicRelRestRender to generate a REST link. Check to make sure
1694             # the relationship references the *single* primary column of the related row
1695 82         140 my $use_rest = 1; #<-- simple toggle var
1696 82     82   567 my $cond_data = try{$self->ResultClass->parse_relationship_cond($info->{cond})};
  82         4152  
1697 82     82   1330 my $rel_rest_key = try{$self->ResultSource->related_class($rel)->getRestKey};
  82         3741  
1698 82 100 33     1697 if($use_rest && $cond_data && $rel_rest_key && $conf->{open_url}) {
      33        
      66        
1699             # Toggle setting the 'key' arg in the link (something/1234 vs something/key/1234)
1700 80 50       302 my $rest_key = $rel_rest_key eq $cond_data->{foreign} ? undef : $cond_data->{foreign};
1701             $conf->{renderer} = jsfunc(
1702             'function(value, metaData, record) { return Ext.ux.RapidApp.DbicRelRestRender({' .
1703             'value:value,record:record,' .
1704             'key_col: "' . $key_col . '",' .
1705             'render_col: "' . $render_col . '",' .
1706 80 50       819 'open_url: "' . $conf->{open_url} . '"' .
    50          
1707             ( $rest_key ? ',rest_key:"' . $rest_key . '"' : '') .
1708             ( $is_phy ? ',is_phy_colname: true' : '') .
1709             '})}',$cur_renderer
1710             );
1711             }
1712             # Fall back to the older loadCnf inlineLink:
1713             else {
1714             $conf->{renderer} = jsfunc(
1715             'function(value, metaData, record, rowIndex, colIndex, store) {' .
1716             'return Ext.ux.RapidApp.DbicSingleRelationshipColumnRender({' .
1717             'value:value,metaData:metaData,record:record,rowIndex:rowIndex,colIndex:colIndex,store:store,' .
1718             'render_col: "' . $render_col . '",' .
1719             'key_col: "' . $key_col . '",' .
1720             'upd_key_col: "' . $upd_key_col . '"' .
1721 2 50       23 ( $conf->{open_url} ? ",open_url: '" . $conf->{open_url} . "'" : '' ) .
1722             '});' .
1723             '}', $cur_renderer
1724             );
1725             }
1726            
1727            
1728             ############# ---
1729 82   50     471 $conf->{editor} = $conf->{editor} || {};
1730 82   50     250 $conf->{auto_editor_params} = $conf->{auto_editor_params} || {};
1731            
1732             # ----
1733             # Set allowBlank according to the db schema of the key column. This is handled
1734             # automatically in normal columns in the profile stuff, but has to be done special
1735             # for relationship columns:
1736 82 50       2293 my $cinfo = exists $conf->{keyField} ? $self->ResultSource->column_info($conf->{keyField}) : undef;
1737 82 50 33     1572 if($cinfo and defined $cinfo->{is_nullable} and ! exists $conf->{editor}->{allowBlank}) {
      33        
1738             # This logic is specific instead of being a blanket boolean choice. If there is some other,
1739             # different, unexpected value for 'is_nullable', don't set allowBlank one way or the other
1740 82 100       324 $conf->{editor}->{allowBlank} = \0 if($cinfo->{is_nullable} == 0);
1741 82 100       309 if($cinfo->{is_nullable} == 1) {
1742 38         114 $conf->{editor}->{allowBlank} = \1;
1743             # This setting will only have an effect if the editor is AppCombo2 based:
1744 38         133 $conf->{editor}->{allowSelectNone} = \1;
1745             }
1746             }
1747             # same for 'default_value', if defined (again, this logic already happens for normal columns):
1748 82 50 33     417 $conf->{editor}->{value} = $cinfo->{default_value} if ($cinfo && exists $cinfo->{default_value});
1749             # TODO: refactor so the 'normal' column logic from 'profiles' etc gets applied here so this
1750             # duplicate logic isn't needed
1751             # ----
1752              
1753 82   50     265 $conf->{auto_editor_params} = $conf->{auto_editor_params} || {};
1754              
1755              
1756 82         168 my $aet = $conf->{auto_editor_type};
1757 82 100 66     573 if($aet eq 'combo' || $aet eq 'dropdown') {
    50          
    50          
1758            
1759             my $params = {
1760             valueField => $conf->{valueField},
1761             displayField => $conf->{displayField},
1762             name => $colname,
1763             ResultSet => $Source->resultset,
1764             record_pk => $conf->{valueField},
1765             # Optional custom ResultSet params applied to the dropdown query
1766             RS_condition => $conf->{RS_condition} ? $conf->{RS_condition} : {},
1767             RS_attr => $conf->{RS_attr} ? $conf->{RS_attr} : {},
1768 10 50       65 };
    50          
1769            
1770 10 50       3987 $params->{type_filter} = 1 if ($aet eq 'combo');
1771            
1772 10         295 my $table = RapidApp::DBIC::Component::TableSpec::_table_name_safe($self->ResultClass->table);
1773 10         37 my $module_name = 'combo_' . $table . '_' . $colname;
1774             my $Module = $self->get_or_create_rapidapp_module( $module_name,
1775             class => 'RapidApp::Module::DbicCombo',
1776 10         51 params => { %$params, %{ $conf->{auto_editor_params} } }
  10         105  
1777             );
1778            
1779 10 50       102 if($conf->{editor}) {
1780 10 50       49 if($conf->{editor}->{listeners}) {
1781 0         0 my $listeners = delete $conf->{editor}->{listeners};
1782 0         0 $Module->add_listener( $_ => $listeners->{$_} ) for (keys %$listeners);
1783             }
1784 10 50       18 $Module->apply_extconfig(%{$conf->{editor}}) if (keys %{$conf->{editor}} > 0);
  10         393  
  10         67  
1785             }
1786            
1787 10         135 $conf->{editor} = $Module->content;
1788             }
1789            
1790             elsif($aet eq 'grid') {
1791            
1792             die "display_columns is required with 'grid' auto_editor_type"
1793 0 0       0 unless (defined $conf->{display_columns});
1794            
1795 0   0 0   0 my $custOnBUILD = $conf->{auto_editor_params}->{onBUILD} || sub{};
1796             my $onBUILD = sub {
1797 0     0   0 my $self = shift;
1798 0         0 $self->apply_to_all_columns( hidden => \1 );
1799 0         0 $self->apply_columns_list($conf->{display_columns},{ hidden => \0 });
1800 0         0 return $custOnBUILD->($self);
1801 0         0 };
1802 0         0 $conf->{auto_editor_params}->{onBUILD} = $onBUILD;
1803            
1804 0         0 my $table = RapidApp::DBIC::Component::TableSpec::_table_name_safe($self->ResultClass->table);
1805 0         0 my $grid_module_name = 'grid_' . $table . '_' . $colname;
1806             my $GridModule = $self->get_or_create_rapidapp_module( $grid_module_name,
1807             class => 'RapidApp::Module::DbicGrid',
1808             params => {
1809             ResultSource => $Source,
1810             include_colspec => [ '*', '{?:single}*.*' ],
1811             #include_colspec => [ ($conf->{valueField},$conf->{displayField},@{$conf->{display_columns}}) ],
1812             title => '',
1813 0         0 %{ $conf->{auto_editor_params} }
  0         0  
1814             }
1815             );
1816            
1817 0 0       0 my $title = $conf->{header} ? 'Select ' . $conf->{header} : 'Select Record';
1818             $conf->{editor} = {
1819              
1820             # These can be overridden
1821             header => $conf->{header},
1822             win_title => $title,
1823             win_height => 450,
1824             win_width => 650,
1825            
1826 0         0 %{$conf->{editor}},
1827            
1828             # These can't be overridden
1829             name => $colname,
1830             xtype => 'datastore-app-field',
1831             valueField => $conf->{valueField},
1832             displayField => $conf->{displayField},
1833 0         0 load_url => $GridModule->base_url,
1834            
1835             };
1836             }
1837            
1838             elsif($aet eq 'custom') {
1839            
1840             # Use whatever is already in 'editor' plus some sane defaults
1841 72 50       331 my $title = $conf->{header} ? 'Select ' . $conf->{header} : 'Select Record';
1842             $conf->{editor} = {
1843              
1844             # These can be overridden
1845             header => $conf->{header},
1846             win_title => $title,
1847             win_height => 450,
1848             win_width => 650,
1849             valueField => $conf->{valueField},
1850             displayField => $conf->{displayField},
1851             name => $colname,
1852            
1853 72         215 %{$conf->{auto_editor_params}},
1854 72         238 %{$conf->{editor}},
  72         552  
1855             };
1856             }
1857             ############# ---
1858              
1859 82         1850 return (name => $colname, %$conf);
1860             }
1861              
1862              
1863             sub get_multi_relationship_column_cnf {
1864 102     102 0 278 my $self = shift;
1865 102         201 my $rel = shift;
1866 102 50       375 my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  102         674  
1867            
1868             return $self->get_m2m_multi_relationship_column_cnf($rel,\%opt)
1869 102 100       513 if ($opt{relationship_cond_data}->{attrs}->{m2m_attrs});
1870            
1871 101         227 my $conf = \%opt;
1872            
1873 101         2251 my $rel_data = clone($conf->{relationship_cond_data});
1874            
1875             ## -- allow override of the associated TabsleSpec cnfs from the relationship attrs:
1876 101 50       464 $conf->{title_multi} = delete $rel_data->{attrs}->{title_multi} if ($rel_data->{attrs}->{title_multi});
1877 101 50       331 $conf->{multiIconCls} = delete $rel_data->{attrs}->{multiIconCls} if ($rel_data->{attrs}->{multiIconCls});
1878 101 50       309 $conf->{open_url_multi} = delete $rel_data->{attrs}->{open_url_multi} if ($rel_data->{attrs}->{open_url_multi});
1879 101 50       349 $conf->{open_url_multi_rs_join_name} = delete $rel_data->{attrs}->{open_url_multi_rs_join_name} if ($rel_data->{attrs}->{open_url_multi_rs_join_name});
1880 101         207 delete $rel_data->{attrs}->{cascade_copy};
1881 101         209 delete $rel_data->{attrs}->{cascade_delete};
1882 101         183 delete $rel_data->{attrs}->{join_type};
1883 101         186 delete $rel_data->{attrs}->{accessor};
1884            
1885             $rel_data->{attrs}->{join} = [ $rel_data->{attrs}->{join} ] if (
1886             defined $rel_data->{attrs}->{join} and
1887 101 50 33     406 ref($rel_data->{attrs}->{join}) ne 'ARRAY'
1888             );
1889            
1890 101 50       315 if($rel_data->{attrs}->{join}) {
1891 0         0 @{$rel_data->{attrs}->{join}} = grep { $_ ne $conf->{open_url_multi_rs_join_name} } @{$rel_data->{attrs}->{join}};
  0         0  
  0         0  
  0         0  
1892 0 0       0 delete $rel_data->{attrs}->{join} unless (scalar @{$rel_data->{attrs}->{join}} > 0);
  0         0  
1893             }
1894            
1895            
1896 101 50       421 my $title = $conf->{title_multi} ? $conf->{title_multi} : 'Related "' . $rel . '" Rows';
1897            
1898             my $loadCfg = {
1899             title => $title,
1900             iconCls => $conf->{multiIconCls} ,
1901             autoLoad => {
1902             url => $conf->{open_url_multi},
1903 101         757 params => {}
1904             }
1905             };
1906            
1907             my $div_open =
1908             '<div' .
1909 101 100       608 ( $conf->{multiIconCls} ? ' class="with-inline-icon ' . $conf->{multiIconCls} . '"' : '' ) . '><span>' .
1910             $title .
1911             '&nbsp;<span class="superscript-navy">';
1912            
1913 101         267 my $cur_renderer = $conf->{renderer};
1914            
1915 101         2916 my $open_url = $self->ResultClass->TableSpec_get_conf('open_url');
1916 101     101   827 my $rel_rest_key = try{$self->ResultClass->getRestKey};
  101         5975  
1917 101 50       4405 my $orgnCol = $rel_rest_key ? join('',$self->column_prefix,$rel_rest_key) : undef;
1918            
1919 101   50     621 $conf->{required_fetch_columns} ||= [];
1920 101 50       268 push @{$conf->{required_fetch_columns}}, $orgnCol if ($orgnCol);
  101         297  
1921            
1922 101 50       2797 my $rSelfCol = $rel_data->{self} ? join('',$self->column_prefix,$rel_data->{self}) : undef;
1923 101 100 50     620 push @{$conf->{required_fetch_columns}}, $rSelfCol if ($rSelfCol && $rSelfCol ne ($orgnCol || ''));
  3   66     8  
1924              
1925             # Allow old apps to turn off using this source as a rest origin and force fallback to
1926             # the fugly, original loadCnf inlineLink
1927             my $use_rest =
1928             $rel_data->{attrs}{allow_rel_rest_origin}
1929 101   33 101   730 // try{$rel_data->{class}->TableSpec_get_conf('allow_rel_rest_origin')};
  101         2952  
1930            
1931 101 50       1519 $use_rest = 1 unless (defined $use_rest);
1932 101 100 33     700 if($use_rest && $orgnCol && $open_url) {
      66        
1933 96         887 $conf->{renderer} = jsfunc(
1934             'function(value, metaData, record) { return Ext.ux.RapidApp.DbicRelRestRender({' .
1935             'value:value,record:record,' .
1936             "disp: '" . $div_open . "' + value + '</span>'," .
1937             'key_col: "' . $orgnCol . '",' .
1938             'open_url: "' . $open_url . '",' .
1939             'multi_rel: true,' .
1940             'rs: "' . $rel . '"' .
1941             '})}',$cur_renderer
1942             );
1943             }
1944             else {
1945              
1946             # Fall back to the old thick, ugly loadCnf inlineLink:
1947             # This code path should never happen with RapidDbic, but will still happen for
1948             # manual setups where there is no 'open_url', other missing TableSpec data,
1949             # or the fallback 'allow_rel_rest_origin => 0' has been set
1950            
1951             ## -----
1952             ## This code block generates the 'resultset_attr' json in perl instead of
1953             ## in ExtJS (Ext.encode) so we can reach in and prevent the character sequence ']}'
1954             ## which occurs if the last *value* of a hash (Object) happens to be an array
1955             ## which only sometimes occurs (and, not consistently across restarts). The bug
1956             ## this created was in the compile of Ext.XTemplate, because they use {[ ... ]} as
1957             ## markers for inline javascript, so this would cause Syntax Exception.
1958             ## The exact JavaScript logic was attempted to be reproduced, just to try to keep
1959             ## the behavior as close to the way it was. Note that this codepath itself is
1960             ## legacy and only happens in special cases (and then the bug was a special case
1961             ## of a special case). This is probably the most ugly code in the whole codebase.
1962 5         13 my $join_name = $conf->{open_url_multi_rs_join_name};
1963 5         9 my $personality = $join_name;
1964 5         9 my $attr_json = do {
1965 5         39 my $attr = clone($rel_data->{attrs});
1966 5   50     41 $attr->{join} ||= [];
1967 5         13 push @{$attr->{join}}, $join_name;
  5         16  
1968 5         10 @{$attr->{join}} = grep { $_ ne 'me' } @{$attr->{join}};
  5         9  
  5         16  
  5         12  
1969            
1970 5 50 33     20 $personality = $attr->{join}[0] if $attr->{join}[0] && $join_name eq 'me';
1971            
1972 5 50       11 if(scalar(@{$attr->{join}}) == 0) { delete $attr->{join}; }
  5 0       19  
  5         10  
1973 0         0 elsif(scalar(@{$attr->{join}}) == 1) { $attr->{join} = $attr->{join}[0]; }
  0         0  
1974            
1975 5         45 my $json = encode_json_utf8($attr);
1976            
1977 5         332 $json =~ s/\{\[/\{ \[/g;
1978 5         17 $json =~ s/\]\}/\] \}/g;
1979            
1980 5         14 $json
1981             };
1982             ## -----
1983            
1984             $conf->{renderer} = $rel_data->{self} ? jsfunc(
1985             'function(value, metaData, record, rowIndex, colIndex, store) {' .
1986             "var div_open = '$div_open';" .
1987             "var disp = div_open + value + '</span>';" .
1988            
1989             #'var key_key = ' .
1990             'var key_val = record && record.data ? record.data["' . $rSelfCol . '"] : null;' .
1991            
1992             #'var attr = ' . RapidApp::JSON::MixedEncoder::encode_json($rel_data->{attrs}) . ';' .
1993            
1994             ( # TODO: needs to be generalized better
1995             $conf->{open_url_multi} ?
1996             'if(key_val && value && value > 0 && !Ext.ux.RapidApp.NO_DBIC_REL_LINKS) {' .
1997             'var loadCfg = ' . RapidApp::JSON::MixedEncoder::encode_json($loadCfg) . ';' .
1998            
1999             'var join_name = "' . $join_name . '";' .
2000            
2001             'var cond = {};' .
2002 5 50       70 'cond[join_name + ".' . $rel_data->{foreign} . '"] = key_val;' .
    50          
2003            
2004             #'var attr = {};' .
2005             #'if(join_name != "me"){ if(!attr.join) { attr.join = []; } attr.join.push(join_name); }' .
2006            
2007             # Fix!!!
2008             #'if(join_name == "me" && Ext.isArray(attr.join) && attr.join.length > 0) { join_name = attr.join[0]; }' .
2009            
2010             #Fix!! -- Note that 'personality' is for a specific legacy app
2011             'loadCfg.autoLoad.params.personality = "' . $personality . '";' .
2012            
2013             #'loadCfg.autoLoad.params.base_params = Ext.encode({' .
2014             # 'resultset_condition: Ext.encode(cond),' .
2015             # 'resultset_attr: Ext.encode(attr)' .
2016             #'});' .
2017            
2018             'loadCfg.autoLoad.params.base_params_base64 = base64.encode(Ext.encode({' .
2019             'resultset_condition: Ext.encode(cond),' .
2020             #'resultset_attr: Ext.encode(attr)' .
2021             "resultset_attr: '" . $attr_json . "'" .
2022             '}));' .
2023            
2024             'var href = "#loadcfg:" + Ext.urlEncode({data: Ext.encode(loadCfg)});' .
2025             'disp += "&nbsp;" + Ext.ux.RapidApp.inlineLink(' .
2026             'href,"<span>open</span>","ra-nav-link ra-icon-magnify-tiny",null,"Open/view: " + loadCfg.title' .
2027             ');' .
2028             '}'
2029             :
2030             ''
2031             ) .
2032             "disp += '</span></div>';" .
2033             'return disp;' .
2034             '}', $cur_renderer
2035             ) : jsfunc(
2036             # New: skip all the above open link logic in advance if we don't have
2037             # self/foreign rel data. Added for Github Issue #40 now that it is
2038             # possible for it to be missing (just means there will be no open link):
2039             join("\n",
2040             'function(value, metaData, record, rowIndex, colIndex, store) {',
2041             "var div_open = '$div_open';",
2042             "return div_open + value + '</span></span></div>';",
2043             '}'
2044             )
2045             );
2046             }
2047            
2048              
2049 101         2805 $conf->{name} = join('',$self->column_prefix,$rel);
2050            
2051 101         1894 return %$conf;
2052             }
2053              
2054             has 'm2m_rel_columns_indx', is => 'ro', isa => 'HashRef', default => sub {{}};
2055              
2056             sub get_m2m_multi_relationship_column_cnf {
2057 1     1 0 3 my $self = shift;
2058 1         3 my $rel = shift;
2059 1 50       4 my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  1         7  
2060            
2061 1         3 my $conf = \%opt;
2062            
2063 1         3 $conf->{no_quick_search} = \1;
2064 1         3 $conf->{no_summary} = \1;
2065            
2066 1         6 $conf->{renderer} = jsfunc 'Ext.ux.RapidApp.prettyCsvRenderer';
2067            
2068 1         2 my $m2m_attrs = $conf->{relationship_cond_data}->{attrs}->{m2m_attrs};
2069 1         3 my $rinfo = $m2m_attrs->{rinfo};
2070 1         2 my $rrinfo = $m2m_attrs->{rrinfo};
2071            
2072 1         28 my $colname = $self->column_prefix . $rel;
2073 1         3 $conf->{name} = $colname;
2074            
2075 1         27 $self->m2m_rel_columns_indx->{$colname} = 1;
2076            
2077             ### This is the initial editor type 'multi-check-combo' which is only suitable if
2078             ### there are a relatively limited number of remote linkable rows (such as roles)
2079             ### TODO: add more types (like combo vs grid in single relationship combos) such
2080             ### as one that is paged and can support lots of rows to select from
2081            
2082             ### Also, TODO: add support for different diplayField and valueField. This will
2083             ### require setting up a whole additional relationship for rendering. Also, need
2084             ### to add the ability to customize the render mode. Currently it is hard coded to
2085             ### csv list of key/link values. It will always have to be something like this, but
2086             ### it could render differently. If there are many values, there might be a better way
2087             ### to render/display, such as a count like the default regular multi rel column
2088            
2089 1         27 my $schema = $self->ResultSource->schema;
2090 1         14 my $Source = $schema->source($rrinfo->{source});
2091            
2092 1         104 my $table = RapidApp::DBIC::Component::TableSpec::_table_name_safe($self->ResultClass->table);
2093 1         4 my $module_name = 'm2mcombo_' . $table . '_' . $colname;
2094             my $Module = $self->get_or_create_rapidapp_module( $module_name,
2095             class => 'RapidApp::Module::DbicCombo',
2096             params => {
2097             valueField => $rrinfo->{cond_info}->{foreign},
2098             displayField => $rrinfo->{cond_info}->{foreign},
2099             name => $colname,
2100             ResultSet => $Source->resultset,
2101             record_pk => $rrinfo->{cond_info}->{foreign},
2102             # Optional custom ResultSet params applied to the dropdown query
2103             RS_condition => $conf->{RS_condition} ? $conf->{RS_condition} : {},
2104             RS_attr => $conf->{RS_attr} ? $conf->{RS_attr} : {},
2105             #%{ $conf->{auto_editor_params} },
2106             }
2107 1 50       8 );
    50          
2108 1         41 $Module->apply_extconfig( xtype => 'multi-check-combo' );
2109            
2110 1   50     21 $conf->{editor} = $conf->{editor} || {};
2111            
2112             # allowBlank per-default. There are no database-level rules for "nullable" since the
2113             # column is virtual and has no schema/properties
2114 1 50       6 $conf->{editor}->{allowBlank} = \1 unless (exists $conf->{editor}->{allowBlank});
2115            
2116 1 50       4 if($conf->{editor}->{listeners}) {
2117 0         0 my $listeners = delete $conf->{editor}->{listeners};
2118 0         0 $Module->add_listener( $_ => $listeners->{$_} ) for (keys %$listeners);
2119             }
2120 1 50       3 $Module->apply_extconfig(%{$conf->{editor}}) if (keys %{$conf->{editor}} > 0);
  1         35  
  1         5  
2121            
2122 1         9 $conf->{editor} = $Module->content;
2123            
2124 1         36 return %$conf;
2125             }
2126              
2127              
2128             # TODO: consolidate/simplify all "virtual" relationship columns here. Multi-relationship
2129             # columns are themselves a virtual column...
2130             sub get_virtual_relationship_column_cnf {
2131 0     0 0 0 my $self = shift;
2132 0         0 my $rel = shift;
2133 0 0       0 my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  0         0  
2134            
2135 0         0 my $conf = {
2136             %opt,
2137             name => join('',$self->column_prefix,$rel)
2138             };
2139            
2140 0         0 my $cur_renderer = $conf->{renderer};
2141            
2142 0     0   0 my $rel_rest_key = try{$self->ResultClass->getRestKey};
  0         0  
2143 0 0       0 my $orgnCol = $rel_rest_key ? join('',$self->column_prefix,$rel_rest_key) : undef;
2144            
2145 0   0     0 $conf->{required_fetch_columns} ||= [];
2146 0 0       0 push @{$conf->{required_fetch_columns}}, $orgnCol if ($orgnCol);
  0         0  
2147              
2148 0         0 my $use_rest = 1;
2149 0 0 0     0 if($use_rest && $orgnCol) {
2150 0         0 my $open_url = $self->ResultClass->TableSpec_get_conf('open_url');
2151 0         0 $conf->{renderer} = jsfunc( join('',
2152             'function(value, metaData, record) { return Ext.ux.RapidApp.DbicRelRestRender({',
2153             'value:value,',
2154             'record:record,',
2155             'key_col: "',$orgnCol,'",',
2156             'open_url: "',$open_url,'",',
2157             'rs: "',$rel,'"',
2158             '})}'
2159             ),$cur_renderer);
2160             }
2161            
2162 0         0 return %$conf;
2163             }
2164              
2165              
2166             sub get_or_create_rapidapp_module {
2167 11     11 0 371 my $self = shift;
2168 11 50       35 my $name = shift or die "get_or_create_rapidapp_module(): Missing module name";
2169 11 50       72 my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  0         0  
2170              
2171 11 50       92 my $rootModule = RapidApp->_rootModule or die "Failed to find RapidApp Root Module!!";
2172            
2173 11 100       386 $rootModule->apply_init_modules( tablespec => 'RapidApp::Module' )
2174             unless ( $rootModule->has_module('tablespec') );
2175            
2176 11         71 my $TMod = $rootModule->Module('tablespec');
2177            
2178 11 100       327 $TMod->apply_init_modules( $name => \%opt ) unless ( $TMod->has_module($name) );
2179            
2180 11         50 my $Module = $TMod->Module($name);
2181 11         55 $Module->call_ONREQUEST_handlers;
2182 11         451 $Module->DataStore->call_ONREQUEST_handlers;
2183            
2184 11         92 return $Module;
2185             }
2186              
2187             1;