| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package RapidApp::TableSpec::Role::DBIC; | 
| 2 | 5 |  |  | 5 |  | 3687 | use strict; | 
|  | 5 |  |  |  |  | 11 |  | 
|  | 5 |  |  |  |  | 169 |  | 
| 3 | 5 |  |  | 5 |  | 25 | use Moose::Role; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 30 |  | 
| 4 | 5 |  |  | 5 |  | 21273 | use Moose::Util::TypeConstraints; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 41 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 5 |  |  | 5 |  | 9070 | use RapidApp::TableSpec::DbicTableSpec; | 
|  | 5 |  |  |  |  | 12 |  | 
|  | 5 |  |  |  |  | 145 |  | 
| 7 | 5 |  |  | 5 |  | 2020 | use RapidApp::TableSpec::ColSpec; | 
|  | 5 |  |  |  |  | 15 |  | 
|  | 5 |  |  |  |  | 175 |  | 
| 8 | 5 |  |  | 5 |  | 37 | use RapidApp::TableSpec::Column::Profile; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 227 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 5 |  |  | 5 |  | 25 | use RapidApp::Util qw(:all); | 
|  | 5 |  |  |  |  | 11 |  | 
|  | 5 |  |  |  |  | 2126 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 | 5 |  |  | 5 |  | 666 | use RapidApp::DBIC::Component::TableSpec; | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 210 |  | 
| 13 |  |  |  |  |  |  |  | 
| 14 | 5 |  |  | 5 |  | 2288 | use DBIx::Class::Helpers 2.033003; | 
|  | 5 |  |  |  |  | 509 |  | 
|  | 5 |  |  |  |  | 191 |  | 
| 15 |  |  |  |  |  |  | require DBIx::Class::Helper::ResultSet::Util; | 
| 16 |  |  |  |  |  |  |  | 
| 17 | 5 |  |  | 5 |  | 406 | use DBIx::Class::_Util qw/sigwarn_silencer/; | 
|  | 5 |  |  |  |  | 8538 |  | 
|  | 5 |  |  |  |  | 275 |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | require Text::Glob; | 
| 20 | 5 |  |  | 5 |  | 1867 | use Text::WagnerFischer qw(distance); | 
|  | 5 |  |  |  |  | 3236 |  | 
|  | 5 |  |  |  |  | 316 |  | 
| 21 | 5 |  |  | 5 |  | 321 | use Clone qw( clone ); | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 186 |  | 
| 22 | 5 |  |  | 5 |  | 27 | use Digest::MD5 qw(md5_hex); | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 181 |  | 
| 23 | 5 |  |  | 5 |  | 2697 | use curry; | 
|  | 5 |  |  |  |  | 1293 |  | 
|  | 5 |  |  |  |  | 1269 |  | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | # hackish performance tweak: | 
| 26 |  |  |  |  |  |  | my %match_glob_cache = (); | 
| 27 |  |  |  |  |  |  | sub match_glob { | 
| 28 | 23608 |  |  | 23608 | 0 | 36049 | my ($l,$r) = @_; | 
| 29 |  |  |  |  |  |  | $match_glob_cache{$l}{$r} = Text::Glob::match_glob($l,$r) | 
| 30 | 23608 | 100 |  |  |  | 47315 | unless (exists $match_glob_cache{$l}{$r}); | 
| 31 | 23608 |  |  |  |  | 389279 | 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 |  | 43 | use List::Util; | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 17737 |  | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | sub _coerce_ColSpec { | 
| 63 | 751 |  |  | 751 |  | 1218 | my $v = $_[0]; | 
| 64 |  |  |  |  |  |  | ( # quick/dirty simulate from 'ArrayRef[Str]' | 
| 65 |  |  |  |  |  |  | ref $v && ref($v) eq 'ARRAY' && | 
| 66 | 751 | 50 | 33 | 254 |  | 7528 | !( List::Util::first { ref($_) || ! defined $_ } @$v ) | 
|  | 254 |  |  |  |  | 1094 |  | 
| 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 |  | 781 | my ($self,$ColSpec) = @_; | 
| 90 | 384 |  |  |  |  | 9935 | my $sep = $self->relation_sep; | 
| 91 | 384 |  | 50 |  |  | 1014 | /${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 |  | 1235 | $self->expand_relspec_wildcards(\@_) | 
| 95 | 384 |  |  |  |  | 2112 | }); | 
| 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 | 266 | my $self = shift; | 
| 108 |  |  |  |  |  |  |  | 
| 109 | 176 |  |  |  |  | 5194 | $self->multi_rel_columns_indx; | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | $self->include_colspec->expand_colspecs(sub { | 
| 112 | 176 |  |  | 176 |  | 742 | $self->expand_relationship_columns(@_) | 
| 113 | 176 |  |  |  |  | 5016 | }); | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | $self->include_colspec->expand_colspecs(sub { | 
| 116 | 176 |  |  | 176 |  | 720 | $self->expand_related_required_fetch_colspecs(@_) | 
| 117 | 176 |  |  |  |  | 5530 | }); | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  |  | 
| 120 | 176 |  |  |  |  | 5513 | foreach my $col ($self->no_column_colspec->base_colspec->all_colspecs) { | 
| 121 | 83 | 100 |  |  |  | 2112 | $self->Cnf_columns->{$col} = {} unless ($self->Cnf_columns->{$col}); | 
| 122 | 83 |  |  |  |  | 1946 | %{$self->Cnf_columns->{$col}} = ( | 
| 123 | 83 |  |  |  |  | 162 | %{$self->Cnf_columns->{$col}}, | 
|  | 83 |  |  |  |  | 1938 |  | 
| 124 |  |  |  |  |  |  | no_column => \1, | 
| 125 |  |  |  |  |  |  | no_multifilter => \1, | 
| 126 |  |  |  |  |  |  | no_quick_search => \1 | 
| 127 |  |  |  |  |  |  | ); | 
| 128 | 83 |  |  |  |  | 169 | push @{$self->Cnf_columns_order},$col; | 
|  | 83 |  |  |  |  | 2203 |  | 
| 129 |  |  |  |  |  |  | } | 
| 130 | 176 |  |  |  |  | 4779 | uniq($self->Cnf_columns_order); | 
| 131 |  |  |  |  |  |  |  | 
| 132 | 176 |  |  |  |  | 4808 | my @rels = $self->include_colspec->all_rel_order; | 
| 133 |  |  |  |  |  |  |  | 
| 134 | 176 |  |  |  |  | 408 | $self->add_related_TableSpec($_) for (grep { $_ ne '' } @rels); | 
|  | 260 |  |  |  |  | 869 |  | 
| 135 |  |  |  |  |  |  |  | 
| 136 | 176 |  |  |  |  | 676 | $self->init_local_columns; | 
| 137 |  |  |  |  |  |  |  | 
| 138 | 176 |  |  |  |  | 393 | foreach my $rel (@{$self->related_TableSpec_order}) { | 
|  | 176 |  |  |  |  | 4724 |  | 
| 139 | 84 |  |  |  |  | 2190 | my $TableSpec = $self->related_TableSpec->{$rel}; | 
| 140 | 84 |  |  |  |  | 297 | for my $name ($TableSpec->updated_column_order) { | 
| 141 | 166 | 50 |  |  |  | 529 | die "Column name conflict: $name is already defined (rel: $rel)" if ($self->has_column($name)); | 
| 142 | 166 |  |  |  |  | 4252 | $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 | 3080 | sub apply_column_data_alias { my $h = (shift)->column_data_alias; %$h = ( %$h, @_ ) } | 
|  | 118 |  |  |  |  | 422 |  | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | has 'no_column_colspec', is => 'ro', isa => 'ColSpec', coerce => 1, default => sub {[]}; | 
| 153 |  |  |  |  |  |  | sub expand_relationship_columns { | 
| 154 | 176 |  |  | 176 | 0 | 328 | my $self = shift; | 
| 155 | 176 |  |  |  |  | 458 | my @columns = @_; | 
| 156 | 176 |  |  |  |  | 354 | my @expanded = (); | 
| 157 |  |  |  |  |  |  |  | 
| 158 | 176 |  | 50 |  |  | 513 | my $rel_cols = $self->get_Cnf('relationship_column_names') || return; | 
| 159 |  |  |  |  |  |  |  | 
| 160 | 176 |  |  |  |  | 382 | my @no_cols = (); | 
| 161 | 176 |  |  |  |  | 449 | foreach my $col (@columns) { | 
| 162 | 321 |  |  |  |  | 638 | push @expanded, $col; | 
| 163 |  |  |  |  |  |  |  | 
| 164 | 321 |  |  |  |  | 632 | foreach my $relcol (@$rel_cols) { | 
| 165 | 383 | 100 |  |  |  | 691 | 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 |  |  |  |  | 3229 | ); | 
| 172 | 118 |  |  |  |  | 259 | push @expanded, @add; | 
| 173 | 118 |  |  |  |  | 2858 | $self->apply_column_data_alias( $relcol => $self->Cnf_columns->{$relcol}->{keyField} ); | 
| 174 | 118 |  |  |  |  | 299 | push @no_cols, grep { !$self->colspecs_to_colspec_test(\@columns,$_) } @add; | 
|  | 354 |  |  |  |  | 782 |  | 
| 175 |  |  |  |  |  |  | } | 
| 176 |  |  |  |  |  |  | } | 
| 177 | 176 |  |  |  |  | 4986 | $self->no_column_colspec->add_colspecs(@no_cols); | 
| 178 |  |  |  |  |  |  |  | 
| 179 | 176 |  |  |  |  | 1117 | return @expanded; | 
| 180 |  |  |  |  |  |  | } | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | sub expand_related_required_fetch_colspecs { | 
| 183 | 176 |  |  | 176 | 0 | 410 | my $self = shift; | 
| 184 | 176 |  |  |  |  | 475 | my @columns = @_; | 
| 185 | 176 |  |  |  |  | 371 | my @expanded = (); | 
| 186 |  |  |  |  |  |  |  | 
| 187 | 176 |  |  |  |  | 556 | my $local_cols = $self->get_Cnf_order('columns'); | 
| 188 |  |  |  |  |  |  |  | 
| 189 | 176 |  |  |  |  | 393 | my @no_cols = (); | 
| 190 | 176 |  |  |  |  | 403 | foreach my $spec (@columns) { | 
| 191 | 675 |  |  |  |  | 1087 | push @expanded, $spec; | 
| 192 |  |  |  |  |  |  |  | 
| 193 | 675 |  |  |  |  | 961 | foreach my $col (@$local_cols) { | 
| 194 | 6174 | 100 |  |  |  | 8041 | next unless (match_glob($spec,$col)); | 
| 195 |  |  |  |  |  |  |  | 
| 196 | 940 | 50 |  |  |  | 22929 | 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 |  |  |  |  | 4726 | $self->no_column_colspec->add_colspecs(@no_cols); | 
| 218 |  |  |  |  |  |  |  | 
| 219 | 176 |  |  |  |  | 1123 | return @expanded; | 
| 220 |  |  |  |  |  |  | } | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | sub base_colspec { | 
| 224 | 176 |  |  | 176 | 0 | 328 | my $self = shift; | 
| 225 | 176 |  |  |  |  | 4483 | 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 | 337 | my $self = shift; | 
| 239 |  |  |  |  |  |  |  | 
| 240 | 176 |  |  |  |  | 4465 | my $class = $self->ResultClass; | 
| 241 | 176 | 50 |  |  |  | 3167 | 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 |  |  |  |  | 8170 | my @order = @{$self->Cnf_columns_order}; | 
|  | 176 |  |  |  |  | 4692 |  | 
| 247 | 176 |  |  |  |  | 643 | @order = $self->filter_base_columns(@order); | 
| 248 |  |  |  |  |  |  |  | 
| 249 | 176 |  |  |  |  | 5729 | $self->add_db_column($_,$self->Cnf_columns->{$_}) for (@order); | 
| 250 |  |  |  |  |  |  | }; | 
| 251 |  |  |  |  |  |  |  | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | sub add_db_column($@) { | 
| 254 | 781 |  |  | 781 | 0 | 1272 | my $self = shift; | 
| 255 | 781 |  |  |  |  | 1152 | my $name = shift; | 
| 256 | 781 | 50 |  |  |  | 2066 | my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref | 
|  | 781 |  |  |  |  | 4610 |  | 
| 257 |  |  |  |  |  |  |  | 
| 258 | 781 | 100 |  |  |  | 2631 | %opt = $self->get_relationship_column_cnf($name,\%opt) if($opt{relationship_info}); | 
| 259 |  |  |  |  |  |  |  | 
| 260 | 781 |  |  |  |  | 21134 | $opt{name} = $self->column_prefix . $name; | 
| 261 |  |  |  |  |  |  |  | 
| 262 | 781 |  |  |  |  | 2344 | my $editable = $self->filter_updatable_columns($name,$opt{name}); | 
| 263 | 781 |  |  |  |  | 3344 | my $creatable = $self->filter_creatable_columns($name,$opt{name}); | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | # --  NEW: VIRTUAL COLUMNS SUPPORT: | 
| 266 | 781 | 100 |  |  |  | 21366 | 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 |  | 509 | unless(try{$self->ResultClass->column_info($name)->{set_function}}) { | 
|  | 11 |  |  |  |  | 650 |  | 
| 269 | 4 |  |  |  |  | 522 | $editable = 0; | 
| 270 | 4 |  |  |  |  | 11 | $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 |  | 4025 | $RapidApp::TableSpec::Column::Profile::NO_ALLOW_ADD_PROFILES{$_} | 
| 285 | 781 | 50 |  |  |  | 32178 | } @{$opt{profiles}||[]}; | 
|  | 781 | 100 |  |  |  | 3293 |  | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | $editable = 0 if List::Util::first { | 
| 288 | 2196 |  |  | 2196 |  | 3367 | $RapidApp::TableSpec::Column::Profile::NO_ALLOW_EDIT_PROFILES{$_} | 
| 289 | 781 | 50 |  |  |  | 2935 | } @{$opt{profiles}||[]}; | 
|  | 781 | 100 |  |  |  | 2276 |  | 
| 290 |  |  |  |  |  |  | ## -- | 
| 291 |  |  |  |  |  |  |  | 
| 292 |  |  |  |  |  |  |  | 
| 293 | 781 | 100 |  |  |  | 2359 | $opt{allow_edit} = \0 unless ($editable); | 
| 294 | 781 | 100 |  |  |  | 1810 | $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 |  |  |  | 3172 | unless(jstrue($opt{no_column})) { | 
| 302 | 717 | 100 | 100 |  |  | 2078 | $opt{allow_edit} //= \1 if ($editable); | 
| 303 | 717 | 100 | 100 |  |  | 1848 | $opt{allow_add}  //= \1 if ($creatable); | 
| 304 |  |  |  |  |  |  | } | 
| 305 |  |  |  |  |  |  |  | 
| 306 | 781 | 100 | 100 |  |  | 3098 | unless ($editable or $creatable) { | 
| 307 | 641 | 100 |  |  |  | 1454 | $opt{rel_combo_field_cnf} = $opt{editor} if($opt{editor}); | 
| 308 | 641 |  |  |  |  | 1396 | $opt{editor} = '' ; | 
| 309 |  |  |  |  |  |  | } | 
| 310 |  |  |  |  |  |  |  | 
| 311 | 781 |  |  |  |  | 2675 | $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 | 8517 | 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 | 12531 | 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 | 1320 | my $self = shift; | 
| 371 | 752 |  |  |  |  | 1002 | my $colspec = shift; | 
| 372 |  |  |  |  |  |  |  | 
| 373 | 752 | 100 |  |  |  | 1574 | if(ref($colspec) eq 'ARRAY') { | 
| 374 | 384 |  |  |  |  | 740 | my @exp = (); | 
| 375 | 384 |  |  |  |  | 1155 | push @exp, $self->expand_relspec_wildcards($_,@_) for (@$colspec); | 
| 376 | 384 |  |  |  |  | 1147 | return @exp; | 
| 377 |  |  |  |  |  |  | } | 
| 378 |  |  |  |  |  |  |  | 
| 379 | 368 |  | 66 |  |  | 9700 | my $Source = shift || $self->ResultSource; | 
| 380 | 368 |  |  |  |  | 734 | my @ovr_macro_keywords = @_; | 
| 381 |  |  |  |  |  |  |  | 
| 382 |  |  |  |  |  |  | # Exclude colspecs that start with # | 
| 383 | 368 | 50 |  |  |  | 882 | return () if ($colspec =~ /^\#/); | 
| 384 |  |  |  |  |  |  |  | 
| 385 | 368 |  |  |  |  | 966 | my @parts = split(/\./,$colspec); | 
| 386 | 368 | 100 |  |  |  | 1393 | return ($colspec) unless (@parts > 1); | 
| 387 |  |  |  |  |  |  |  | 
| 388 | 85 |  |  |  |  | 145 | my $clspec = pop @parts; | 
| 389 | 85 |  |  |  |  | 184 | my $relspec = join('.',@parts); | 
| 390 |  |  |  |  |  |  |  | 
| 391 |  |  |  |  |  |  | # There is nothing to expand if the relspec doesn't contain wildcards: | 
| 392 | 85 | 100 |  |  |  | 334 | return ($colspec) unless ($relspec =~ /[\*\?\[\]\{]/); | 
| 393 |  |  |  |  |  |  |  | 
| 394 | 1 |  |  |  |  | 5 | push @parts,$clspec; | 
| 395 |  |  |  |  |  |  |  | 
| 396 | 1 |  |  |  |  | 3 | my $rel = shift @parts; | 
| 397 | 1 | 50 |  |  |  | 2 | my $pre; { my ($match) = ($rel =~ /^(\!)/); $rel =~ s/^(\!)//; $pre = $match ? $match : ''; } | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 7 |  | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 5 |  | 
| 398 |  |  |  |  |  |  |  | 
| 399 | 1 |  |  |  |  | 6 | my @rel_list = $Source->relationships; | 
| 400 |  |  |  |  |  |  | #scream($_) for (map { $Source->relationship_info($_) } @rel_list); | 
| 401 |  |  |  |  |  |  |  | 
| 402 | 1 |  |  |  |  | 12 | my @macro_keywords = @ovr_macro_keywords; | 
| 403 | 1 |  |  |  |  | 2 | my $macro; { | 
| 404 | 1 |  |  |  |  | 1 | my ($match) = ($rel =~ /^\{([\?\:a-zA-Z0-9]+)\}/); | 
|  | 1 |  |  |  |  | 3 |  | 
| 405 | 1 |  |  |  |  | 2 | $rel =~ s/^\{([\?\:a-zA-Z0-9]+)\}//; | 
| 406 | 1 |  |  |  |  | 2 | $macro = $match; | 
| 407 |  |  |  |  |  |  | } | 
| 408 | 1 | 50 |  |  |  | 4 | push @macro_keywords, split(/\:/,$macro) if ($macro); | 
| 409 | 1 |  |  |  |  | 2 | my %macros = map { $_ => 1 } @macro_keywords; | 
|  | 0 |  |  |  |  | 0 |  | 
| 410 |  |  |  |  |  |  |  | 
| 411 | 1 | 0 | 0 |  |  | 2 | 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 |  |  |  |  | 3 | my @matching_rels = grep { match_glob($rel,$_) } @rel_list; | 
|  | 2 |  |  |  |  | 5 |  | 
| 418 |  |  |  |  |  |  | die 'Invalid ColSpec: "' . $rel . '" doesn\'t match any relationships of ' . | 
| 419 |  |  |  |  |  |  | $Source->schema->class($Source->source_name) | 
| 420 | 1 | 50 | 33 |  |  | 16 | 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 |  |  |  |  | 15 | push @expanded, $pre . $rel_name . '.' . $_ for (@suffix); | 
| 426 |  |  |  |  |  |  | } | 
| 427 |  |  |  |  |  |  |  | 
| 428 | 1 |  |  |  |  | 5 | 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 | 328 | my $self = shift; | 
| 470 | 176 |  |  |  |  | 553 | my @columns = @_; | 
| 471 |  |  |  |  |  |  |  | 
| 472 |  |  |  |  |  |  | # Why has this come up? | 
| 473 |  |  |  |  |  |  | # filter out columns with invalid characters (*): | 
| 474 | 176 |  |  |  |  | 417 | @columns = grep { /^[A-Za-z0-9\-\_\.]+$/ } @columns; | 
|  | 1403 |  |  |  |  | 3065 |  | 
| 475 |  |  |  |  |  |  |  | 
| 476 | 176 |  |  |  |  | 653 | 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 | 1195 | my $self = shift; | 
| 484 | 781 |  |  |  |  | 1391 | my @columns = @_; | 
| 485 |  |  |  |  |  |  |  | 
| 486 | 781 |  |  |  |  | 19782 | my @inc_cols = $self->colspec_select_columns({ | 
| 487 |  |  |  |  |  |  | colspecs => $self->include_colspec->colspecs, | 
| 488 |  |  |  |  |  |  | columns => \@columns, | 
| 489 |  |  |  |  |  |  | }); | 
| 490 |  |  |  |  |  |  |  | 
| 491 | 781 |  |  |  |  | 27698 | my @rel_cols = $self->colspec_select_columns({ | 
| 492 |  |  |  |  |  |  | colspecs => $self->added_relationship_column_relspecs, | 
| 493 |  |  |  |  |  |  | columns => \@columns, | 
| 494 |  |  |  |  |  |  | }); | 
| 495 |  |  |  |  |  |  |  | 
| 496 | 781 |  |  |  |  | 2003 | my %allowed = map {$_=>1} @inc_cols,@rel_cols; | 
|  | 688 |  |  |  |  | 2086 |  | 
| 497 | 781 |  |  |  |  | 1396 | return grep { $allowed{$_} } @columns; | 
|  | 1376 |  |  |  |  | 3279 |  | 
| 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 | 1197 | my $self = shift; | 
| 503 | 784 |  |  |  |  | 1802 | my @columns = @_; | 
| 504 |  |  |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | #exclude all multi relationship columns (except new m2m multi rel columns) | 
| 506 |  |  |  |  |  |  | @columns = grep { | 
| 507 | 784 |  |  |  |  | 1435 | $self->m2m_rel_columns_indx->{$self->column_prefix . $_} || | 
| 508 | 1565 | 100 |  |  |  | 39338 | !$self->multi_rel_columns_indx->{$self->column_prefix . $_} | 
| 509 |  |  |  |  |  |  | } @columns; | 
| 510 |  |  |  |  |  |  |  | 
| 511 | 784 |  |  |  |  | 20147 | 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 | 1337 | my $self = shift; | 
| 522 | 781 |  |  |  |  | 1756 | 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 |  |  |  |  | 1568 | $self->m2m_rel_columns_indx->{$self->column_prefix . $_} || | 
| 530 | 1562 | 100 |  |  |  | 43501 | !$self->multi_rel_columns_indx->{$self->column_prefix . $_} | 
| 531 |  |  |  |  |  |  | } @columns; | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | # First filter by include_colspec: | 
| 534 | 781 |  |  |  |  | 2073 | @columns = $self->filter_include_columns(@columns); | 
| 535 |  |  |  |  |  |  |  | 
| 536 | 781 |  |  |  |  | 23255 | 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 | 1813 | my $self = shift; | 
| 548 | 1683 |  |  |  |  | 1796 | my $colspec = shift; | 
| 549 | 1683 |  |  |  |  | 1766 | my $test_spec = shift; | 
| 550 |  |  |  |  |  |  |  | 
| 551 | 1683 |  |  |  |  | 2165 | my ($match) = ($colspec =~ /^(\!)/); $colspec =~ s/^(\!)//; | 
|  | 1683 |  |  |  |  | 1921 |  | 
| 552 | 1683 | 50 |  |  |  | 2227 | my $x = $match ? -1 : 1; | 
| 553 |  |  |  |  |  |  |  | 
| 554 | 1683 |  |  |  |  | 2696 | my @parts = split(/\./,$colspec); | 
| 555 | 1683 |  |  |  |  | 2382 | my @test_parts = split(/\./,$test_spec); | 
| 556 | 1683 | 100 |  |  |  | 3555 | return undef unless(scalar @parts == scalar @test_parts); | 
| 557 |  |  |  |  |  |  |  | 
| 558 | 841 |  |  |  |  | 1228 | foreach my $part (@parts) { | 
| 559 | 1151 | 50 |  |  |  | 1807 | my $test = shift @test_parts or return undef; | 
| 560 | 1151 | 100 |  |  |  | 1702 | return undef unless (match_glob($part,$test)); | 
| 561 |  |  |  |  |  |  | } | 
| 562 |  |  |  |  |  |  |  | 
| 563 | 472 |  |  |  |  | 945 | return $x; | 
| 564 |  |  |  |  |  |  | } | 
| 565 |  |  |  |  |  |  |  | 
| 566 |  |  |  |  |  |  | sub colspecs_to_colspec_test { | 
| 567 | 354 |  |  | 354 | 0 | 446 | my $self = shift; | 
| 568 | 354 |  |  |  |  | 401 | my $colspecs = shift; | 
| 569 | 354 |  |  |  |  | 412 | my $test_spec = shift; | 
| 570 |  |  |  |  |  |  |  | 
| 571 | 354 | 50 |  |  |  | 681 | $colspecs = [ $colspecs ] unless (ref($colspecs) eq 'ARRAY'); | 
| 572 |  |  |  |  |  |  |  | 
| 573 | 354 |  |  |  |  | 423 | my $match = 0; | 
| 574 | 354 |  |  |  |  | 546 | foreach my $colspec (@$colspecs) { | 
| 575 | 1683 |  | 100 |  |  | 2353 | my $result = $self->colspec_to_colspec_test($colspec,$test_spec) || next; | 
| 576 | 472 | 50 |  |  |  | 792 | return 0 if ($result < 0); | 
| 577 | 472 | 50 |  |  |  | 852 | $match = 1 if ($result > 0); | 
| 578 |  |  |  |  |  |  | } | 
| 579 |  |  |  |  |  |  |  | 
| 580 | 354 |  |  |  |  | 857 | return $match; | 
| 581 |  |  |  |  |  |  | } | 
| 582 |  |  |  |  |  |  |  | 
| 583 |  |  |  |  |  |  |  | 
| 584 |  |  |  |  |  |  |  | 
| 585 |  |  |  |  |  |  | my %dist_cache = (); | 
| 586 |  |  |  |  |  |  | sub get_distance { | 
| 587 | 2020 |  |  | 2020 | 0 | 3263 | my ($l,$r) = @_; | 
| 588 | 2020 | 100 |  |  |  | 5374 | $dist_cache{$l}{$r} = distance($l,$r) unless (exists $dist_cache{$l}{$r}); | 
| 589 | 2020 |  |  |  |  | 337464 | 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 | 32264 |  |  | 32264 |  | 38428 | my $self = shift; | 
| 602 | 32264 |  | 50 |  |  | 47833 | my $full_colspec = shift || die "full_colspec is required"; | 
| 603 | 32264 |  | 50 |  |  | 45117 | 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 | 32264 |  |  |  |  | 47658 | my @other_colspecs = @_; | 
| 614 |  |  |  |  |  |  |  | 
| 615 |  |  |  |  |  |  |  | 
| 616 | 32264 |  |  |  |  | 34061 | my $full_colspec_orig = $full_colspec; | 
| 617 | 32264 |  |  |  |  | 43566 | my ($neg_flag) = ($full_colspec =~ /^(\!)/); $full_colspec =~ s/^(\!)//; | 
|  | 32264 |  |  |  |  | 39360 |  | 
| 618 | 32264 | 50 |  |  |  | 44271 | my $x = $neg_flag ? -1 : 1; | 
| 619 | 32264 | 50 |  |  |  | 39648 | my $match_return = $neg_flag ? 0 : 1; | 
| 620 |  |  |  |  |  |  |  | 
| 621 | 32264 |  |  |  |  | 55806 | my @parts = split(/\./,$full_colspec); | 
| 622 | 32264 |  |  |  |  | 43204 | my $colspec = pop @parts; | 
| 623 | 32264 |  |  |  |  | 44781 | my $relspec = join('.',@parts); | 
| 624 |  |  |  |  |  |  |  | 
| 625 | 32264 |  |  |  |  | 801771 | my $sep = $self->relation_sep; | 
| 626 | 32264 |  |  |  |  | 40352 | my $prefix = $relspec; | 
| 627 | 32264 |  |  |  |  | 39256 | $prefix =~ s/\./${sep}/g; | 
| 628 |  |  |  |  |  |  |  | 
| 629 | 32264 |  |  |  |  | 63268 | @parts = split(/${sep}/,$col); | 
| 630 | 32264 |  |  |  |  | 45430 | my $test_col = pop @parts; | 
| 631 | 32264 |  |  |  |  | 43447 | my $test_prefix = join($sep,@parts); | 
| 632 |  |  |  |  |  |  |  | 
| 633 |  |  |  |  |  |  | # no match: | 
| 634 | 32264 | 100 |  |  |  | 92969 | return undef unless ($prefix eq $test_prefix); | 
| 635 |  |  |  |  |  |  |  | 
| 636 |  |  |  |  |  |  | # match (return 1 or 0): | 
| 637 | 15898 | 100 |  |  |  | 24139 | if (match_glob($colspec,$test_col)) { | 
| 638 |  |  |  |  |  |  | # Calculate WagnerFischer edit distance | 
| 639 | 2020 |  |  |  |  | 3299 | 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 | 2020 |  |  |  |  | 3200 | my $value = $x * (1000 - $distance); # <-- flip | 
| 644 |  |  |  |  |  |  |  | 
| 645 | 2020 |  |  |  |  | 3074 | foreach my $spec (@other_colspecs) { | 
| 646 | 12271 | 100 |  |  |  | 20685 | 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 | 1185 | 100 |  |  |  | 2764 | return undef if (abs $other_val > abs $value); | 
| 650 |  |  |  |  |  |  | } | 
| 651 | 1958 |  |  |  |  | 7292 | return $value; | 
| 652 |  |  |  |  |  |  | }; | 
| 653 |  |  |  |  |  |  |  | 
| 654 |  |  |  |  |  |  | # no match: | 
| 655 | 13878 |  |  |  |  | 55805 | 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 |  | 40 | use B::Deparse; | 
|  | 5 |  |  |  |  | 11 |  | 
|  | 5 |  |  |  |  | 35042 |  | 
| 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 | 34582 |  |  | 34582 | 0 | 60865 | my ( $self, @args ) = @_; | 
| 673 | 34582 |  |  |  |  | 61005 | my $colspec_key = join('|',@args); | 
| 674 | 34582 |  | 100 |  |  | 101645 | 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 | 5527 | my $self = shift; | 
| 721 | 3395 | 50 |  |  |  | 8170 | my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref | 
|  | 3395 |  |  |  |  | 11116 |  | 
| 722 |  |  |  |  |  |  |  | 
| 723 |  |  |  |  |  |  | $self->{_colspec_select_columns_cache} = {} | 
| 724 | 3395 | 100 |  |  |  | 8301 | unless defined $self->{_colspec_select_columns_cache}; | 
| 725 |  |  |  |  |  |  |  | 
| 726 | 3395 | 50 |  |  |  | 6829 | my $colspecs = $opt{colspecs} or die "colspec_select_columns(): expected 'colspecs'"; | 
| 727 | 3395 | 50 |  |  |  | 6115 | my $columns = $opt{columns} or die "colspec_select_columns(): expected 'columns'"; | 
| 728 | 3395 |  |  |  |  | 4229 | $columns = [ sort { $a cmp $b } @{$columns} ]; | 
|  | 7410 |  |  |  |  | 13685 |  | 
|  | 3395 |  |  |  |  | 9641 |  | 
| 729 |  |  |  |  |  |  |  | 
| 730 |  |  |  |  |  |  | my $colspec_select_columns_key = join('_', | 
| 731 | 3395 |  |  |  |  | 14194 | md5_hex(join('_',@{$colspecs})), | 
| 732 | 3395 |  |  |  |  | 5276 | md5_hex(join('_',@{$columns})), | 
|  | 3395 |  |  |  |  | 11460 |  | 
| 733 |  |  |  |  |  |  | ); | 
| 734 |  |  |  |  |  |  |  | 
| 735 | 1296 |  |  |  |  | 4126 | return @{$self->{_colspec_select_columns_cache}{$colspec_select_columns_key}} | 
| 736 | 3395 | 100 |  |  |  | 9885 | if defined $self->{_colspec_select_columns_cache}{$colspec_select_columns_key}; | 
| 737 |  |  |  |  |  |  |  | 
| 738 | 2099 |  |  |  |  | 2560 | my $cache_key; | 
| 739 | 2099 | 100 |  |  |  | 54466 | if ($self->has_cache) { | 
| 740 | 1557 |  |  |  |  | 73939 | $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 |  |  |  |  | 33432 | my $cache_content = $self->cache->get($cache_key); | 
| 746 | 1557 | 100 |  |  |  | 343653 | return @{$self->{_colspec_select_columns_cache}{$colspec_select_columns_key} = $cache_content} | 
|  | 698 |  |  |  |  | 4210 |  | 
| 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 | 1401 |  |  |  |  | 3072 | my $best_match = $opt{best_match_look_ahead}; | 
| 755 |  |  |  |  |  |  |  | 
| 756 | 1401 | 50 |  |  |  | 3066 | $colspecs = [ $colspecs ] unless (ref $colspecs); | 
| 757 | 1401 | 50 |  |  |  | 2484 | $columns = [ $columns ] unless (ref $columns); | 
| 758 |  |  |  |  |  |  |  | 
| 759 | 1401 | 50 |  |  |  | 3911 | $opt{match_data} = {} unless ($opt{match_data}); | 
| 760 |  |  |  |  |  |  |  | 
| 761 | 1401 |  |  |  |  | 2787 | my %match = map { $_ => 0 } @$columns; | 
|  | 3740 |  |  |  |  | 7654 |  | 
| 762 | 1401 |  |  |  |  | 2406 | my @order = (); | 
| 763 | 1401 |  |  |  |  | 1782 | my $i = 0; | 
| 764 | 1401 |  |  |  |  | 2715 | for my $spec (@$colspecs) { | 
| 765 | 5635 |  |  |  |  | 14752 | my @remaining = @$colspecs[++$i .. $#$colspecs]; | 
| 766 | 5635 |  |  |  |  | 9059 | for my $col (@$columns) { | 
| 767 |  |  |  |  |  |  |  | 
| 768 | 22311 |  |  |  |  | 35553 | my @arg = ($spec,$col); | 
| 769 | 22311 | 100 |  |  |  | 42094 | push @arg, @remaining if ($best_match); # <-- push the rest of the colspecs after the current for index | 
| 770 |  |  |  |  |  |  |  | 
| 771 | 22311 | 100 |  |  |  | 35322 | my $result = $self->colspec_test(@arg) or next; | 
| 772 | 3091 | 50 |  |  |  | 6497 | push @order, $col if ($result > 0); | 
| 773 | 3091 |  |  |  |  | 4370 | $match{$col} = $result; | 
| 774 |  |  |  |  |  |  | $opt{match_data}->{$col} = { | 
| 775 |  |  |  |  |  |  | index => $i - 1, | 
| 776 |  |  |  |  |  |  | colspec => $spec | 
| 777 | 3091 | 100 |  |  |  | 11162 | } unless ($opt{match_data}->{$col}); | 
| 778 |  |  |  |  |  |  | } | 
| 779 |  |  |  |  |  |  | } | 
| 780 |  |  |  |  |  |  |  | 
| 781 | 1401 |  |  |  |  | 3410 | my $colspec_select_columns = [ uniq(grep { $match{$_} > 0 } @order) ]; | 
|  | 3091 |  |  |  |  | 6633 |  | 
| 782 | 1401 | 100 |  |  |  | 3015 | if ($cache_key) { | 
| 783 | 859 |  |  |  |  | 21263 | $self->cache->set($cache_key,$colspec_select_columns); | 
| 784 |  |  |  |  |  |  | } | 
| 785 | 1401 |  |  |  |  | 759025 | return @{$self->{_colspec_select_columns_cache}{$colspec_select_columns_key} = $colspec_select_columns}; | 
|  | 1401 |  |  |  |  | 10031 |  | 
| 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 | 202 | my $self = shift; | 
| 796 | 92 |  |  |  |  | 2604 | 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 |  |  |  | 1283 | 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 |  |  |  | 238 | @local, @{ $self->include_colspec->colspecs || [] } | 
|  | 92 |  |  |  |  | 2746 |  | 
| 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 | 210 | my $self = shift; | 
| 813 | 92 |  |  |  |  | 340 | my @colspecs = @_; | 
| 814 | 92 | 50 |  |  |  | 323 | @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 |  |  |  |  | 184 | my $need_base = 1; | 
| 820 | 92 |  | 100 |  |  | 1040 | ! /\./ and $need_base = 0 for (@colspecs); | 
| 821 | 92 | 50 |  |  |  | 292 | unshift @colspecs, '*' if ($need_base); | 
| 822 |  |  |  |  |  |  |  | 
| 823 | 92 |  |  |  |  | 368 | 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 |  |  |  |  | 713 | push @new_order, $self->updated_column_order; | 
| 833 |  |  |  |  |  |  |  | 
| 834 | 92 |  |  |  |  | 277 | my %seen = (); | 
| 835 | 92 |  |  |  |  | 203 | @{$self->column_order} = grep { !$seen{$_}++ } @new_order; | 
|  | 92 |  |  |  |  | 2018 |  | 
|  | 1548 |  |  |  |  | 2380 |  | 
| 836 | 92 |  |  |  |  | 330 | 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 | 180 | my $self = shift; | 
| 852 | 84 |  |  |  |  | 2713 | 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 |  |  |  |  | 8 | my $code = shift; | 
| 926 | 3 |  |  |  |  | 7 | my @columns = @_; | 
| 927 |  |  |  |  |  |  |  | 
| 928 | 3 |  |  |  |  | 6 | my $recurse = 0; | 
| 929 | 3 | 50 |  |  |  | 33 | $recurse = 1 if((caller(1))[3] eq __PACKAGE__ . '::walk_columns_deep'); | 
| 930 | 3 | 50 |  |  |  | 16 | local $_{return} = undef unless ($recurse); | 
| 931 | 3 | 50 |  |  |  | 13 | local $_{rel} = undef unless ($recurse); | 
| 932 | 3 | 50 |  |  |  | 13 | local $_{depth} = 0 unless ($recurse); | 
| 933 |  |  |  |  |  |  |  | 
| 934 |  |  |  |  |  |  |  | 
| 935 | 3 |  |  |  |  | 11 | my %map = (''=>[]); | 
| 936 | 3 |  |  |  |  | 9 | foreach my $col (@columns) { | 
| 937 | 3 |  | 50 |  |  | 98 | my $rel = $self->column_name_relationship_map->{$col} || ''; | 
| 938 | 3 |  |  |  |  | 10 | push @{$map{$rel}}, $col; | 
|  | 3 |  |  |  |  | 13 |  | 
| 939 |  |  |  |  |  |  | } | 
| 940 |  |  |  |  |  |  |  | 
| 941 |  |  |  |  |  |  |  | 
| 942 | 3 |  |  |  |  | 5 | my @local_cols = @{delete $map{''}}; | 
|  | 3 |  |  |  |  | 10 |  | 
| 943 |  |  |  |  |  |  |  | 
| 944 | 3 |  |  |  |  | 84 | my $pre = $self->column_prefix; | 
| 945 | 3 |  |  |  |  | 8 | my %name_map = map { my $name = $_; $name =~ s/^${pre}//; $name => $_ } @local_cols; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 24 |  | 
|  | 3 |  |  |  |  | 15 |  | 
| 946 | 3 |  |  |  |  | 12 | local $_{name_map} = \%name_map; | 
| 947 | 3 |  |  |  |  | 10 | local $_{return} = $code->($self,@local_cols); | 
| 948 | 3 |  |  |  |  | 9 | local $_{depth} = $_{depth}; $_{depth}++; | 
|  | 3 |  |  |  |  | 5 |  | 
| 949 | 3 |  |  |  |  | 19 | 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 | 179 | my $self = shift; | 
| 996 | 84 |  |  |  |  | 166 | my $rel = shift; | 
| 997 | 84 | 50 |  |  |  | 320 | 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 |  |  |  | 2393 | defined $self->related_TableSpec->{$rel} | 
| 1001 |  |  |  |  |  |  | ); | 
| 1002 |  |  |  |  |  |  |  | 
| 1003 | 84 | 50 |  |  |  | 2128 | my $info = $self->ResultClass->relationship_info($rel) or die "Relationship '$rel' not found."; | 
| 1004 | 84 |  |  |  |  | 4378 | my $relclass = $info->{class}; | 
| 1005 |  |  |  |  |  |  |  | 
| 1006 | 84 |  |  |  |  | 2352 | my $relspec_prefix = $self->relspec_prefix; | 
| 1007 | 84 | 100 | 66 |  |  | 300 | $relspec_prefix .= '.' if ($relspec_prefix and $relspec_prefix ne ''); | 
| 1008 | 84 |  |  |  |  | 200 | $relspec_prefix .= $rel; | 
| 1009 |  |  |  |  |  |  |  | 
| 1010 | 84 |  |  |  |  | 1095 | my $table = RapidApp::DBIC::Component::TableSpec::_table_name_safe($relclass->table); | 
| 1011 | 84 |  |  |  |  | 2383 | 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 |  |  | 2223 | $params{updatable_colspec} = $self->updatable_colspec->get_subspec($rel) || []; | 
| 1022 | 84 |  | 50 |  |  | 2289 | $params{creatable_colspec} = $self->creatable_colspec->get_subspec($rel) || []; | 
| 1023 | 84 |  | 100 |  |  | 2186 | $params{no_column_colspec} = $self->no_column_colspec->get_subspec($rel) || []; | 
| 1024 |  |  |  |  |  |  |  | 
| 1025 | 84 |  |  |  |  | 800 | %params = ( %params, %opt ); | 
| 1026 |  |  |  |  |  |  |  | 
| 1027 | 84 |  |  |  |  | 2129 | my $class = $self->ResultClass; | 
| 1028 | 84 | 50 | 33 |  |  | 1110 | if($class->can('TableSpec_get_conf') and $class->TableSpec_has_conf('related_column_property_transforms')) { | 
| 1029 | 84 |  |  |  |  | 298 | my $rel_transforms = $class->TableSpec_get_conf('related_column_property_transforms'); | 
| 1030 | 84 | 50 |  |  |  | 247 | $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 |  |  |  | 2278 | unless($self->no_header_transform) { | 
| 1040 | 84 | 100 | 50 | 292 |  | 739 | $params{column_property_transforms}->{header} ||= sub { $_ ? "$_ ($relspec_prefix)" : $_ }; | 
|  | 292 |  |  |  |  | 1246 |  | 
| 1041 |  |  |  |  |  |  | } | 
| 1042 |  |  |  |  |  |  | # -- | 
| 1043 |  |  |  |  |  |  |  | 
| 1044 |  |  |  |  |  |  | } | 
| 1045 |  |  |  |  |  |  |  | 
| 1046 | 84 | 50 |  |  |  | 548 | my $TableSpec = $self->new_TableSpec(%params) or die "Failed to create related TableSpec"; | 
| 1047 |  |  |  |  |  |  |  | 
| 1048 | 84 |  |  |  |  | 2476 | $self->related_TableSpec->{$rel} = $TableSpec; | 
| 1049 | 84 |  |  |  |  | 184 | push @{$self->related_TableSpec_order}, $rel; | 
|  | 84 |  |  |  |  | 2127 |  | 
| 1050 |  |  |  |  |  |  |  | 
| 1051 | 84 |  |  |  |  | 544 | 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 |  | 16548 | my $orig = shift; | 
| 1066 | 1768 |  |  |  |  | 2208 | my $self = shift; | 
| 1067 | 1768 |  |  |  |  | 2457 | my $name = $_[0]; | 
| 1068 |  |  |  |  |  |  |  | 
| 1069 | 1768 |  |  |  |  | 48322 | my $rel = $self->column_name_relationship_map->{$name}; | 
| 1070 | 1768 |  |  |  |  | 2341 | my $obj = $self; | 
| 1071 | 1768 | 100 |  |  |  | 9941 | $obj = $self->related_TableSpec->{$rel} if (defined $rel); | 
| 1072 |  |  |  |  |  |  |  | 
| 1073 | 1768 |  |  |  |  | 7865 | 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 | 114 | 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 |  |  |  |  | 121 | my ($rel,$col,$join,$cond_data) = $self->resolve_dbic_rel_alias_by_column_name($fieldName,$get_render_col); | 
| 1203 |  |  |  |  |  |  |  | 
| 1204 | 46 | 50 | 33 |  |  | 184 | %$merge_join = %{ merge($merge_join,$join) } | 
|  | 46 |  |  |  |  | 156 |  | 
| 1205 |  |  |  |  |  |  | if ($merge_join and $join); | 
| 1206 |  |  |  |  |  |  |  | 
| 1207 |  |  |  |  |  |  |  | 
| 1208 | 46 | 100 |  |  |  | 123 | if (!defined $cond_data) { | 
| 1209 |  |  |  |  |  |  | # $col is a simple column, not a relationship, we're done: | 
| 1210 | 17 |  |  |  |  | 77 | 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 |  |  | 240 | $cond_data->{function} = $cond_data->{function} || $self->multi_rel_columns_indx->{$fieldName}; | 
| 1219 |  |  |  |  |  |  |  | 
| 1220 |  |  |  |  |  |  | # Support for a custom aggregate function | 
| 1221 | 29 | 100 |  |  |  | 75 | if (ref($cond_data->{function}) eq 'CODE') { | 
| 1222 |  |  |  |  |  |  | # TODO: we should use hash-style parameters | 
| 1223 | 7 |  |  |  |  | 30 | return $cond_data->{function}->($self,$rel,$col,$join,$cond_data,$fieldName); | 
| 1224 |  |  |  |  |  |  | } | 
| 1225 |  |  |  |  |  |  | else { | 
| 1226 | 22 |  |  |  |  | 66 | my $m2m_attrs = $cond_data->{info}->{attrs}->{m2m_attrs}; | 
| 1227 | 22 | 100 |  |  |  | 52 | 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 |  |  |  |  | 18 | my $rel_info = $m2m_attrs->{rinfo}; | 
| 1248 | 7 |  |  |  |  | 15 | 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 |  |  |  |  | 208 | local *_ = $self->schema->storage->sql_maker->curry::_quote; | 
| 1278 |  |  |  |  |  |  |  | 
| 1279 | 7 |  |  |  |  | 654 | my $rel_table_raw = $self->schema->source($rel_info->{source})->name; | 
| 1280 | 7 |  |  |  |  | 628 | my $rev_rel_table_raw = $self->schema->source($rev_rel_info->{source})->name; | 
| 1281 |  |  |  |  |  |  |  | 
| 1282 | 7 |  |  |  |  | 395 | my $rel_table = _($rel_table_raw); | 
| 1283 | 7 |  |  |  |  | 335 | my $rev_rel_table = _($rev_rel_table_raw); | 
| 1284 |  |  |  |  |  |  |  | 
| 1285 | 7 |  |  |  |  | 507 | my $rel_alias = (reverse split(/\./,$rel_table_raw))[0]; | 
| 1286 | 7 |  |  |  |  | 25 | my $rev_rel_alias = (reverse split(/\./,$rev_rel_table_raw))[0]; | 
| 1287 |  |  |  |  |  |  |  | 
| 1288 | 7 |  |  |  |  | 45 | my $rel_join_col = _(join '.', $rel_alias, $rev_rel_info->{cond_info}{self}); | 
| 1289 | 7 |  |  |  |  | 216 | my $rev_rel_join_col = _(join '.', $rev_rel_alias, $rev_rel_info->{cond_info}{foreign}); | 
| 1290 |  |  |  |  |  |  |  | 
| 1291 | 7 |  |  |  |  | 204 | my $rev_rel_col = _(join '.', $rel_alias, $rel_info->{cond_info}{foreign}); | 
| 1292 | 7 |  |  |  |  | 204 | my $rel_col = _(join '.', $rel, $cond_data->{self}); | 
| 1293 |  |  |  |  |  |  |  | 
| 1294 | 7 |  |  |  |  | 220 | my $sql = do { | 
| 1295 |  |  |  |  |  |  |  | 
| 1296 | 7 |  |  |  |  | 200 | my $sqlt_type = $self->schema->storage->sqlt_type; | 
| 1297 | 7 |  |  |  |  | 571 | my $concat = do { | 
| 1298 | 7 | 50 |  |  |  | 27 | if ($sqlt_type eq 'PostgreSQL') { | 
| 1299 | 0 |  |  |  |  | 0 | "STRING_AGG($rev_rel_join_col, ',')" | 
| 1300 |  |  |  |  |  |  | } else { | 
| 1301 | 7 |  |  |  |  | 32 | "GROUP_CONCAT($rev_rel_join_col)"; | 
| 1302 |  |  |  |  |  |  | } | 
| 1303 |  |  |  |  |  |  | }; | 
| 1304 | 7 |  |  |  |  | 53 | 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 |  |  |  |  | 77 | 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 |  |  |  | 46 | unless ($cond_data->{parent_source}); | 
| 1320 |  |  |  |  |  |  |  | 
| 1321 | 15 |  |  |  |  | 413 | my $p_source = $self->schema->source($cond_data->{parent_source}); | 
| 1322 | 15 |  |  |  |  | 614 | my $rel_attrs = $p_source->relationship_info($col)->{attrs}; | 
| 1323 |  |  |  |  |  |  |  | 
| 1324 | 15 |  |  |  |  | 84 | my $rel_rs; | 
| 1325 |  |  |  |  |  |  |  | 
| 1326 | 15 | 50 |  |  |  | 146 | my $recent_dbic = $p_source->can('resolve_relationship_condition') ? 1 : 0; | 
| 1327 |  |  |  |  |  |  |  | 
| 1328 |  |  |  |  |  |  | # Github Issue #95 | 
| 1329 | 15 | 50 |  |  |  | 43 | if(!$rel_attrs->{where}) { | 
| 1330 |  |  |  |  |  |  | # correlate logic works as-is unless the relationship has a 'where' | 
| 1331 | 15 |  |  |  |  | 50 | $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 |  |  |  | 11902 | 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 |  |  |  |  | 411 | 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 |  | 7702 | my ($self, $Rs, $rel) = @_; | 
| 1423 | 15 |  |  |  |  | 63 | DBIx::Class::Helper::ResultSet::Util::correlate( $Rs, $rel ) | 
| 1424 |  |  |  |  |  |  | } | 
| 1425 |  |  |  |  |  |  |  | 
| 1426 |  |  |  |  |  |  | sub resolve_dbic_rel_alias_by_column_name  { | 
| 1427 | 46 |  |  | 46 | 0 | 70 | my $self = shift; | 
| 1428 | 46 |  |  |  |  | 70 | my $fieldName = shift; | 
| 1429 | 46 |  | 50 |  |  | 133 | 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 |  |  |  | 89 | 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 |  |  |  |  | 1237 | my $rel = $self->column_name_relationship_map->{$fieldName}; | 
| 1440 | 46 | 50 |  |  |  | 99 | unless ($rel) { | 
| 1441 |  |  |  |  |  |  |  | 
| 1442 | 46 |  |  |  |  | 1127 | my $join = $self->needed_join; | 
| 1443 | 46 |  |  |  |  | 1410 | my $pre = $self->column_prefix; | 
| 1444 | 46 |  |  |  |  | 187 | $fieldName =~ s/^${pre}//; | 
| 1445 |  |  |  |  |  |  |  | 
| 1446 |  |  |  |  |  |  | # Special case for "multi" relationships... they return the related row count | 
| 1447 | 46 |  |  |  |  | 1172 | my $cond_data = $self->multi_rel_columns_indx->{$fieldName}; | 
| 1448 | 46 | 100 |  |  |  | 109 | 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 |  |  |  |  | 71 | 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 |  |  |  | 581 | if ($self->ResultClass->has_virtual_column($fieldName)) { | 
|  |  | 50 |  |  |  |  |  | 
| 1479 | 7 |  | 50 |  |  | 455 | my $info = $self->ResultClass->column_info($fieldName) || {}; | 
| 1480 |  |  |  |  |  |  | my $function = $info->{function} || sub { | 
| 1481 | 7 |  |  | 7 |  | 46 | my ($self,$rel,$col,$join,$cond_data2,$name2) = @_; | 
| 1482 | 7 |  |  |  |  | 30 | my $sql = $info->{sql} || 'SELECT(NULL)'; | 
| 1483 |  |  |  |  |  |  | # also see RapidApp::DBIC::Component::VirtualColumnsExt | 
| 1484 | 7 |  |  |  |  | 22 | $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 |  |  |  |  | 19 | $sql =~ s/self\./${rel}\./g; | 
| 1491 | 7 |  |  |  |  | 20 | $sql =~ s/\`self\`\./\`${rel}\`\./g; #<-- also support backtic quoted form (quote_sep) | 
| 1492 |  |  |  |  |  |  | # ** | 
| 1493 |  |  |  |  |  |  |  | 
| 1494 | 7 |  |  |  |  | 87 | return { '' => \"($sql)", -as => $col }; | 
| 1495 | 7 |  | 50 |  |  | 724 | }; | 
| 1496 | 7 |  |  |  |  | 25 | $cond_data = { function => $function }; | 
| 1497 |  |  |  |  |  |  |  | 
| 1498 | 7 | 50 |  |  |  | 25 | 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 |  |  |  |  | 30 | 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 |  |  |  |  | 728 | 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 | 383 | my $self = shift; | 
| 1575 | 184 |  |  |  |  | 383 | my $rel = shift; | 
| 1576 | 184 | 50 |  |  |  | 630 | my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref | 
|  | 184 |  |  |  |  | 963 |  | 
| 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 |  |  |  | 670 | if ($opt{profiles}) { | 
| 1581 | 102 |  |  |  |  | 890 | my $o = RapidApp::TableSpec::Column::Profile->_apply_profiles_soft(\%opt); | 
| 1582 | 102 |  |  |  |  | 1062 | %opt = %$o; | 
| 1583 |  |  |  |  |  |  | } | 
| 1584 |  |  |  |  |  |  |  | 
| 1585 | 184 | 50 |  |  |  | 637 | return $self->get_virtual_relationship_column_cnf($rel,\%opt) if ($opt{virtualized_single_rel}); | 
| 1586 | 184 | 100 |  |  |  | 5681 | return $self->get_multi_relationship_column_cnf($rel,\%opt) if ($self->multi_rel_columns_indx->{$rel}); | 
| 1587 |  |  |  |  |  |  |  | 
| 1588 | 82 |  |  |  |  | 188 | my $conf = \%opt; | 
| 1589 | 82 | 50 |  |  |  | 258 | my $info = $conf->{relationship_info} or die "relationship_info is required"; | 
| 1590 |  |  |  |  |  |  |  | 
| 1591 | 82 |  |  |  |  | 2103 | my $table = RapidApp::DBIC::Component::TableSpec::_table_name_safe($self->ResultClass->table); | 
| 1592 | 82 |  |  |  |  | 619 | my $err_info = "rel col: " . $table . ".$rel - " . Dumper($conf); | 
| 1593 |  |  |  |  |  |  |  | 
| 1594 | 82 | 50 |  |  |  | 21452 | die "displayField is required ($err_info)" unless (defined $conf->{displayField}); | 
| 1595 | 82 | 50 |  |  |  | 303 | die "valueField is required ($err_info)" unless (defined $conf->{valueField}); | 
| 1596 | 82 | 50 |  |  |  | 245 | die "keyField is required ($err_info)" unless (defined $conf->{keyField}); | 
| 1597 |  |  |  |  |  |  |  | 
| 1598 | 82 |  |  | 82 |  | 6955 | 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 |  |  |  | 789 | } 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 |  | 12781 | } if (try{$self->ResultSource->related_class($rel)->has_virtual_column($conf->{displayField})}); | 
|  | 82 |  |  |  |  | 3932 |  | 
| 1615 |  |  |  |  |  |  | # | 
| 1616 |  |  |  |  |  |  | # --- | 
| 1617 |  |  |  |  |  |  |  | 
| 1618 | 82 |  |  |  |  | 7447 | my $render_col = $self->column_prefix . $rel . $self->relation_sep . $conf->{displayField}; | 
| 1619 | 82 |  |  |  |  | 2007 | my $key_col = $self->column_prefix . $rel . $self->relation_sep . $conf->{valueField}; | 
| 1620 | 82 |  |  |  |  | 2003 | my $upd_key_col = $self->column_prefix . $conf->{keyField}; | 
| 1621 |  |  |  |  |  |  |  | 
| 1622 |  |  |  |  |  |  | # -- Assume the the column profiles of the display column: | 
| 1623 | 82 |  |  |  |  | 2059 | my $relTS = $self->related_TableSpec->{$rel}; | 
| 1624 | 82 | 50 |  |  |  | 245 | if($relTS) { | 
| 1625 | 82 |  |  |  |  | 2068 | my $relconf = $relTS->Cnf_columns->{$conf->{displayField}}; | 
| 1626 | 82 |  | 33 |  |  | 334 | $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 |  |  |  |  | 319 | @{$conf->{profiles}} = grep { $_ ne 'autoinc' } @{$conf->{profiles}} | 
|  | 672 |  |  |  |  | 1070 |  | 
|  | 82 |  |  |  |  | 254 |  | 
| 1634 | 82 | 50 |  |  |  | 265 | if($conf->{profiles}); | 
| 1635 |  |  |  |  |  |  | } | 
| 1636 |  |  |  |  |  |  | # -- | 
| 1637 |  |  |  |  |  |  |  | 
| 1638 | 82 |  |  |  |  | 2074 | 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 |  |  |  |  | 2467 | $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 |  |  |  |  | 203 | $conf->{render_column} = $render_col; | 
| 1646 |  |  |  |  |  |  | # -- | 
| 1647 |  |  |  |  |  |  |  | 
| 1648 | 82 |  |  |  |  | 153 | 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 |  |  |  |  | 407 | }; | 
| 1656 |  |  |  |  |  |  |  | 
| 1657 | 82 |  |  |  |  | 221 | my $required_fetch_columns = [ | 
| 1658 |  |  |  |  |  |  | $render_col, | 
| 1659 |  |  |  |  |  |  | $key_col, | 
| 1660 |  |  |  |  |  |  | $upd_key_col | 
| 1661 |  |  |  |  |  |  | ]; | 
| 1662 |  |  |  |  |  |  |  | 
| 1663 | 82 | 50 |  |  |  | 312 | $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 |  |  |  | 2164 | my $is_also_local_col = $self->ResultSource->has_column($rel) ? 1 : 0; | 
| 1669 | 82 | 100 |  |  |  | 886 | $conf->{no_fetch} = 1 unless ($is_also_local_col); | 
| 1670 |  |  |  |  |  |  | # --- | 
| 1671 |  |  |  |  |  |  |  | 
| 1672 |  |  |  |  |  |  |  | 
| 1673 | 82 |  |  |  |  | 903 | $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 |  |  |  |  | 1389 | my $cur_renderer = $conf->{renderer}; | 
| 1690 |  |  |  |  |  |  |  | 
| 1691 | 82 |  |  |  |  | 169 | 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 |  |  |  |  | 144 | my $use_rest = 1; #<-- simple toggle var | 
| 1696 | 82 |  |  | 82 |  | 539 | my $cond_data = try{$self->ResultClass->parse_relationship_cond($info->{cond})}; | 
|  | 82 |  |  |  |  | 4105 |  | 
| 1697 | 82 |  |  | 82 |  | 1268 | my $rel_rest_key = try{$self->ResultSource->related_class($rel)->getRestKey}; | 
|  | 82 |  |  |  |  | 3848 |  | 
| 1698 | 82 | 100 | 33 |  |  | 1628 | 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 |  |  |  | 269 | 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 |  |  |  | 751 | '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 |  |  |  | 21 | ( $conf->{open_url} ? ",open_url: '" . $conf->{open_url} . "'" : '' ) . | 
| 1722 |  |  |  |  |  |  | '});' . | 
| 1723 |  |  |  |  |  |  | '}', $cur_renderer | 
| 1724 |  |  |  |  |  |  | ); | 
| 1725 |  |  |  |  |  |  | } | 
| 1726 |  |  |  |  |  |  |  | 
| 1727 |  |  |  |  |  |  |  | 
| 1728 |  |  |  |  |  |  | ############# --- | 
| 1729 | 82 |  | 50 |  |  | 389 | $conf->{editor} = $conf->{editor} || {}; | 
| 1730 | 82 |  | 50 |  |  | 253 | $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 |  |  |  | 2307 | my $cinfo = exists $conf->{keyField} ? $self->ResultSource->column_info($conf->{keyField}) : undef; | 
| 1737 | 82 | 50 | 33 |  |  | 1588 | 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 |  |  |  | 285 | $conf->{editor}->{allowBlank} = \0 if($cinfo->{is_nullable} == 0); | 
| 1741 | 82 | 100 |  |  |  | 237 | if($cinfo->{is_nullable} == 1) { | 
| 1742 | 38 |  |  |  |  | 98 | $conf->{editor}->{allowBlank} = \1; | 
| 1743 |  |  |  |  |  |  | # This setting will only have an effect if the editor is AppCombo2 based: | 
| 1744 | 38 |  |  |  |  | 108 | $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 |  |  | 380 | $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 |  |  | 242 | $conf->{auto_editor_params} = $conf->{auto_editor_params} || {}; | 
| 1754 |  |  |  |  |  |  |  | 
| 1755 |  |  |  |  |  |  |  | 
| 1756 | 82 |  |  |  |  | 155 | my $aet = $conf->{auto_editor_type}; | 
| 1757 | 82 | 100 | 66 |  |  | 582 | 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 |  |  |  | 70 | }; | 
|  |  | 50 |  |  |  |  |  | 
| 1769 |  |  |  |  |  |  |  | 
| 1770 | 10 | 50 |  |  |  | 3880 | $params->{type_filter} = 1 if ($aet eq 'combo'); | 
| 1771 |  |  |  |  |  |  |  | 
| 1772 | 10 |  |  |  |  | 290 | my $table = RapidApp::DBIC::Component::TableSpec::_table_name_safe($self->ResultClass->table); | 
| 1773 | 10 |  |  |  |  | 35 | my $module_name = 'combo_' . $table . '_' . $colname; | 
| 1774 |  |  |  |  |  |  | my $Module = $self->get_or_create_rapidapp_module( $module_name, | 
| 1775 |  |  |  |  |  |  | class	  => 'RapidApp::Module::DbicCombo', | 
| 1776 | 10 |  |  |  |  | 44 | params  => { %$params, %{ $conf->{auto_editor_params} } } | 
|  | 10 |  |  |  |  | 94 |  | 
| 1777 |  |  |  |  |  |  | ); | 
| 1778 |  |  |  |  |  |  |  | 
| 1779 | 10 | 50 |  |  |  | 61 | if($conf->{editor}) { | 
| 1780 | 10 | 50 |  |  |  | 42 | 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 |  |  |  | 19 | $Module->apply_extconfig(%{$conf->{editor}}) if (keys %{$conf->{editor}} > 0); | 
|  | 10 |  |  |  |  | 317 |  | 
|  | 10 |  |  |  |  | 52 |  | 
| 1785 |  |  |  |  |  |  | } | 
| 1786 |  |  |  |  |  |  |  | 
| 1787 | 10 |  |  |  |  | 122 | $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 |  |  |  | 313 | 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 |  |  |  |  | 217 | %{$conf->{auto_editor_params}}, | 
| 1854 | 72 |  |  |  |  | 246 | %{$conf->{editor}}, | 
|  | 72 |  |  |  |  | 539 |  | 
| 1855 |  |  |  |  |  |  | }; | 
| 1856 |  |  |  |  |  |  | } | 
| 1857 |  |  |  |  |  |  | ############# --- | 
| 1858 |  |  |  |  |  |  |  | 
| 1859 | 82 |  |  |  |  | 1688 | return (name => $colname, %$conf); | 
| 1860 |  |  |  |  |  |  | } | 
| 1861 |  |  |  |  |  |  |  | 
| 1862 |  |  |  |  |  |  |  | 
| 1863 |  |  |  |  |  |  | sub get_multi_relationship_column_cnf { | 
| 1864 | 102 |  |  | 102 | 0 | 233 | my $self = shift; | 
| 1865 | 102 |  |  |  |  | 221 | my $rel = shift; | 
| 1866 | 102 | 50 |  |  |  | 381 | my %opt = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref | 
|  | 102 |  |  |  |  | 698 |  | 
| 1867 |  |  |  |  |  |  |  | 
| 1868 |  |  |  |  |  |  | return $self->get_m2m_multi_relationship_column_cnf($rel,\%opt) | 
| 1869 | 102 | 100 |  |  |  | 491 | if ($opt{relationship_cond_data}->{attrs}->{m2m_attrs}); | 
| 1870 |  |  |  |  |  |  |  | 
| 1871 | 101 |  |  |  |  | 247 | my $conf = \%opt; | 
| 1872 |  |  |  |  |  |  |  | 
| 1873 | 101 |  |  |  |  | 2223 | my $rel_data = clone($conf->{relationship_cond_data}); | 
| 1874 |  |  |  |  |  |  |  | 
| 1875 |  |  |  |  |  |  | ## -- allow override of the associated TabsleSpec cnfs from the relationship attrs: | 
| 1876 | 101 | 50 |  |  |  | 436 | $conf->{title_multi} = delete $rel_data->{attrs}->{title_multi} if ($rel_data->{attrs}->{title_multi}); | 
| 1877 | 101 | 50 |  |  |  | 329 | $conf->{multiIconCls} = delete $rel_data->{attrs}->{multiIconCls} if ($rel_data->{attrs}->{multiIconCls}); | 
| 1878 | 101 | 50 |  |  |  | 294 | $conf->{open_url_multi} = delete $rel_data->{attrs}->{open_url_multi} if ($rel_data->{attrs}->{open_url_multi}); | 
| 1879 | 101 | 50 |  |  |  | 312 | $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 |  |  |  |  | 216 | delete $rel_data->{attrs}->{cascade_copy}; | 
| 1881 | 101 |  |  |  |  | 178 | delete $rel_data->{attrs}->{cascade_delete}; | 
| 1882 | 101 |  |  |  |  | 208 | delete $rel_data->{attrs}->{join_type}; | 
| 1883 | 101 |  |  |  |  | 196 | 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 |  |  | 398 | ref($rel_data->{attrs}->{join}) ne 'ARRAY' | 
| 1888 |  |  |  |  |  |  | ); | 
| 1889 |  |  |  |  |  |  |  | 
| 1890 | 101 | 50 |  |  |  | 290 | 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 |  |  |  | 338 | 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 |  |  |  |  | 748 | params => {} | 
| 1904 |  |  |  |  |  |  | } | 
| 1905 |  |  |  |  |  |  | }; | 
| 1906 |  |  |  |  |  |  |  | 
| 1907 |  |  |  |  |  |  | my $div_open = | 
| 1908 |  |  |  |  |  |  | '<div' . | 
| 1909 | 101 | 100 |  |  |  | 613 | ( $conf->{multiIconCls} ? ' class="with-inline-icon ' . $conf->{multiIconCls} . '"' : '' ) . '><span>' . | 
| 1910 |  |  |  |  |  |  | $title . | 
| 1911 |  |  |  |  |  |  | ' <span class="superscript-navy">'; | 
| 1912 |  |  |  |  |  |  |  | 
| 1913 | 101 |  |  |  |  | 246 | my $cur_renderer = $conf->{renderer}; | 
| 1914 |  |  |  |  |  |  |  | 
| 1915 | 101 |  |  |  |  | 2979 | my $open_url = $self->ResultClass->TableSpec_get_conf('open_url'); | 
| 1916 | 101 |  |  | 101 |  | 785 | my $rel_rest_key = try{$self->ResultClass->getRestKey}; | 
|  | 101 |  |  |  |  | 5625 |  | 
| 1917 | 101 | 50 |  |  |  | 4243 | my $orgnCol = $rel_rest_key ? join('',$self->column_prefix,$rel_rest_key) : undef; | 
| 1918 |  |  |  |  |  |  |  | 
| 1919 | 101 |  | 50 |  |  | 689 | $conf->{required_fetch_columns} ||= []; | 
| 1920 | 101 | 50 |  |  |  | 314 | push @{$conf->{required_fetch_columns}}, $orgnCol if ($orgnCol); | 
|  | 101 |  |  |  |  | 313 |  | 
| 1921 |  |  |  |  |  |  |  | 
| 1922 | 101 | 50 |  |  |  | 2728 | my $rSelfCol = $rel_data->{self} ? join('',$self->column_prefix,$rel_data->{self}) : undef; | 
| 1923 | 101 | 100 | 50 |  |  | 630 | push @{$conf->{required_fetch_columns}}, $rSelfCol if ($rSelfCol && $rSelfCol ne ($orgnCol || '')); | 
|  | 3 |  | 66 |  |  | 10 |  | 
| 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 |  | 686 | // try{$rel_data->{class}->TableSpec_get_conf('allow_rel_rest_origin')}; | 
|  | 101 |  |  |  |  | 2973 |  | 
| 1930 |  |  |  |  |  |  |  | 
| 1931 | 101 | 50 |  |  |  | 1468 | $use_rest = 1 unless (defined $use_rest); | 
| 1932 | 101 | 100 | 33 |  |  | 658 | if($use_rest && $orgnCol && $open_url) { | 
|  |  |  | 66 |  |  |  |  | 
| 1933 | 96 |  |  |  |  | 857 | $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 |  |  |  |  | 12 | my $join_name = $conf->{open_url_multi_rs_join_name}; | 
| 1963 | 5 |  |  |  |  | 8 | my $personality = $join_name; | 
| 1964 | 5 |  |  |  |  | 9 | my $attr_json = do { | 
| 1965 | 5 |  |  |  |  | 34 | my $attr = clone($rel_data->{attrs}); | 
| 1966 | 5 |  | 50 |  |  | 37 | $attr->{join} ||= []; | 
| 1967 | 5 |  |  |  |  | 7 | push @{$attr->{join}}, $join_name; | 
|  | 5 |  |  |  |  | 14 |  | 
| 1968 | 5 |  |  |  |  | 9 | @{$attr->{join}} = grep { $_ ne 'me' } @{$attr->{join}}; | 
|  | 5 |  |  |  |  | 12 |  | 
|  | 5 |  |  |  |  | 14 |  | 
|  | 5 |  |  |  |  | 10 |  | 
| 1969 |  |  |  |  |  |  |  | 
| 1970 | 5 | 50 | 33 |  |  | 15 | $personality = $attr->{join}[0] if $attr->{join}[0] && $join_name eq 'me'; | 
| 1971 |  |  |  |  |  |  |  | 
| 1972 | 5 | 50 |  |  |  | 10 | if(scalar(@{$attr->{join}}) == 0)   { delete $attr->{join}; } | 
|  | 5 | 0 |  |  |  | 15 |  | 
|  | 5 |  |  |  |  | 9 |  | 
| 1973 | 0 |  |  |  |  | 0 | elsif(scalar(@{$attr->{join}}) == 1) { $attr->{join} = $attr->{join}[0]; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 1974 |  |  |  |  |  |  |  | 
| 1975 | 5 |  |  |  |  | 27 | my $json = encode_json_utf8($attr); | 
| 1976 |  |  |  |  |  |  |  | 
| 1977 | 5 |  |  |  |  | 318 | $json =~ s/\{\[/\{ \[/g; | 
| 1978 | 5 |  |  |  |  | 12 | $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 |  |  |  | 54 | '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 += " " + 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 |  |  |  |  | 2705 | $conf->{name} = join('',$self->column_prefix,$rel); | 
| 2050 |  |  |  |  |  |  |  | 
| 2051 | 101 |  |  |  |  | 1911 | 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 |  |  |  | 5 | 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 |  |  |  |  | 4 | $conf->{no_summary} = \1; | 
| 2065 |  |  |  |  |  |  |  | 
| 2066 | 1 |  |  |  |  | 5 | $conf->{renderer} = jsfunc 'Ext.ux.RapidApp.prettyCsvRenderer'; | 
| 2067 |  |  |  |  |  |  |  | 
| 2068 | 1 |  |  |  |  | 3 | 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 |  |  |  |  | 26 | my $colname = $self->column_prefix . $rel; | 
| 2073 | 1 |  |  |  |  | 3 | $conf->{name} = $colname; | 
| 2074 |  |  |  |  |  |  |  | 
| 2075 | 1 |  |  |  |  | 26 | $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 |  |  |  |  | 26 | my $schema = $self->ResultSource->schema; | 
| 2090 | 1 |  |  |  |  | 15 | my $Source = $schema->source($rrinfo->{source}); | 
| 2091 |  |  |  |  |  |  |  | 
| 2092 | 1 |  |  |  |  | 98 | 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 |  |  |  | 7 | ); | 
|  |  | 50 |  |  |  |  |  | 
| 2108 | 1 |  |  |  |  | 40 | $Module->apply_extconfig( xtype => 'multi-check-combo' ); | 
| 2109 |  |  |  |  |  |  |  | 
| 2110 | 1 |  | 50 |  |  | 22 | $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 |  |  |  | 2 | $Module->apply_extconfig(%{$conf->{editor}}) if (keys %{$conf->{editor}} > 0); | 
|  | 1 |  |  |  |  | 60 |  | 
|  | 1 |  |  |  |  | 7 |  | 
| 2121 |  |  |  |  |  |  |  | 
| 2122 | 1 |  |  |  |  | 10 | $conf->{editor} =  $Module->content; | 
| 2123 |  |  |  |  |  |  |  | 
| 2124 | 1 |  |  |  |  | 34 | 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 | 381 | my $self = shift; | 
| 2168 | 11 | 50 |  |  |  | 35 | my $name = shift or die "get_or_create_rapidapp_module(): Missing module name"; | 
| 2169 | 11 | 50 |  |  |  | 65 | 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 |  |  |  | 380 | $rootModule->apply_init_modules( tablespec => 'RapidApp::Module' ) | 
| 2174 |  |  |  |  |  |  | unless ( $rootModule->has_module('tablespec') ); | 
| 2175 |  |  |  |  |  |  |  | 
| 2176 | 11 |  |  |  |  | 65 | my $TMod = $rootModule->Module('tablespec'); | 
| 2177 |  |  |  |  |  |  |  | 
| 2178 | 11 | 100 |  |  |  | 299 | $TMod->apply_init_modules( $name => \%opt ) unless ( $TMod->has_module($name) ); | 
| 2179 |  |  |  |  |  |  |  | 
| 2180 | 11 |  |  |  |  | 46 | my $Module = $TMod->Module($name); | 
| 2181 | 11 |  |  |  |  | 62 | $Module->call_ONREQUEST_handlers; | 
| 2182 | 11 |  |  |  |  | 371 | $Module->DataStore->call_ONREQUEST_handlers; | 
| 2183 |  |  |  |  |  |  |  | 
| 2184 | 11 |  |  |  |  | 43 | return $Module; | 
| 2185 |  |  |  |  |  |  | } | 
| 2186 |  |  |  |  |  |  |  | 
| 2187 |  |  |  |  |  |  | 1; |