File Coverage

blib/lib/RapidApp/Module/DbicPropPage.pm
Criterion Covered Total %
statement 27 135 20.0
branch 3 44 6.8
condition 2 29 6.9
subroutine 7 14 50.0
pod 0 9 0.0
total 39 231 16.8


line stmt bran cond sub pod time code
1             package RapidApp::Module::DbicPropPage;
2              
3 4     4   2483 use strict;
  4         9  
  4         123  
4 4     4   19 use warnings;
  4         9  
  4         134  
5              
6 4     4   19 use Moose;
  4         9  
  4         62  
7             extends 'RapidApp::Module::StorCmp';
8             with 'RapidApp::Module::StorCmp::Role::DbicLnk';
9             with 'RapidApp::Module::StorCmp::Role::DbicLnk::RowPg';
10              
11 4     4   24285 use RapidApp::DBIC::Component::TableSpec;
  4         10  
  4         212  
12              
13 4     4   24 use RapidApp::Util qw(:all);
  4         7  
  4         7872  
14              
15             has 'ResultSource' => ( is => 'ro', required => 1 );
16              
17             # -- these aren't working... why ?
18             has '+single_record_fetch', default => 1;
19             has '+max_pagesize', default => 1;
20             # --
21              
22             has 'exclude_grids_relationships', is => 'ro', isa => 'ArrayRef', default => sub {[]};
23             has 'exclude_grids_relationships_map', is => 'ro', lazy => 1, isa => 'HashRef', default => sub {
24             my $self = shift;
25             return { map {$_=>1} @{$self->exclude_grids_relationships} };
26             };
27              
28             has 'setup_multi_grids', is => 'ro', isa => 'Bool', default => 1;
29              
30             has '+allow_restful_queries', default => 1;
31              
32             #has '+DataStore_build_params' => ( default => sub {{
33             # store_autoLoad => 1,
34             # reload_on_save => 0,
35             #}});
36              
37              
38             our $ONLY_MULTI_GRIDS = 0;
39              
40             sub BUILD {
41             my $self = shift;
42            
43             $self->apply_extconfig(
44             xtype => 'panel',
45             layout => 'anchor',
46             autoScroll => \1,
47             frame => \1,
48             );
49            
50             $self->set_default_tab_icon;
51            
52             $self->init_multi_rel_modules;
53            
54             $self->add_ONCONTENT_calls('apply_items_config');
55             }
56              
57              
58              
59              
60             sub set_default_tab_icon {
61 45     45 0 101 my $self = shift;
62 45 50       1261 my $class = $self->ResultClass or return;
63 45 50       427 my $iconCls = $class->TableSpec_get_conf('iconCls') or return;
64 45         1463 $self->apply_extconfig( tabIconCls => $iconCls );
65             }
66              
67              
68             # Adds sub Modules for each included multi relationship. These are then used later on
69             # each request/when the page is rendered
70             sub init_multi_rel_modules {
71 87     87 0 164 my $self = shift;
72 87   66     1404 my $TableSpec = shift || $self->TableSpec;
73            
74             #print STDERR RED . 'init_multi_rel_modules: ' . $TableSpec->relspec_prefix . CLEAR . "\n\n";
75            
76 87         137 foreach my $rel (@{$TableSpec->related_TableSpec_order}) {
  87         2369  
77            
78 42         1072 my $RelTS = $TableSpec->related_TableSpec->{$rel};
79            
80             # Recursive:
81 42         153 $self->init_multi_rel_modules($RelTS);
82            
83 42         1066 my $info = $TableSpec->ResultSource->relationship_info($rel);
84 42 50       382 next unless ($info->{attrs}->{accessor} eq 'multi');
85            
86 0           my $cond_data = RapidApp::DBIC::Component::TableSpec->parse_relationship_cond($info->{cond});
87            
88 0           my $Source = $TableSpec->ResultSource->related_source($rel);
89            
90 0           my $mod_name = 'rel_' . $RelTS->column_prefix . $rel;
91            
92 0           my $mod_params = {
93             include_colspec => $RelTS->include_colspec->init_colspecs,
94             updatable_colspec => $RelTS->updatable_colspec->init_colspecs
95             };
96            
97 0           my $colname = $TableSpec->column_prefix . $rel;
98            
99              
100             # If this rel/colname is updatable in the top TableSpec, then that translates
101             # into these multi rel rows being addable/deletable
102 0 0         if ($self->TableSpec->colspec_matches_columns($self->TableSpec->updatable_colspec->colspecs,$colname)){
103 0           $mod_params->{creatable_colspec} = [ @{$RelTS->updatable_colspec->colspecs} ];
  0            
104 0           $mod_params->{destroyable_relspec} = ['*'];
105 0 0         delete $mod_params->{creatable_colspec} unless (@{$mod_params->{creatable_colspec}} > 0);
  0            
106            
107             # We *must* be able to create on the forein col name to be able to create the link/relationship:
108 0 0         if($mod_params->{creatable_colspec}) {
109 0           push @{$mod_params->{creatable_colspec}}, $cond_data->{foreign};
  0            
110 0           push @{$mod_params->{include_colspec}}, $cond_data->{foreign};
  0            
111            
112             # We can't change the key/link field:
113 0           push @{$mod_params->{updatable_colspec}}, '!' . $cond_data->{foreign};
  0            
114             }
115             }
116              
117 0           $mod_params->{ResultSource} = $Source;
118            
119 0           $self->apply_init_modules( $mod_name => {
120             class => 'RapidApp::Module::DbicGrid',
121             params => $mod_params
122             });
123             }
124             }
125              
126              
127              
128             sub apply_items_config {
129 0     0 0   my $self = shift;
130 0 0         my $Row = $self->req_Row or return;
131 0           $self->apply_extconfig( items => [ $self->full_property_grid ] );
132            
133             # 'tabPath' - unfinished feature
134             #my $path = try{$Row->getRestPath} or return;
135             #$self->apply_extconfig( tabPath => $path );
136             }
137              
138             sub multi_grids {
139 0     0 0   my $self = shift;
140 0           return $self->full_property_grid(1);
141             }
142              
143             sub full_property_grid {
144 0     0 0   my $self = shift;
145 0   0       my $multi_only = shift || 0;
146            
147 0 0         local $ONLY_MULTI_GRIDS = 1 if ($multi_only);
148            
149 0           my $real_columns = [];
150 0           my @items = $self->TableSpec_property_grids($self->TableSpec,$self->req_Row,$real_columns);
151 0           shift @items;
152            
153             # -- for performance, delete all the remaining columns that don't exist for
154             # this row (such as relationships that don't exist for this row)
155             #my %real_indx = map {$_=>1} @$real_columns;
156             #my @delete_columns = grep { !$real_indx{$_} } keys %{$self->columns};
157             #$self->delete_columns(@delete_columns);
158             # --
159              
160 0           return @items;
161             }
162              
163              
164             sub TS_title {
165 0     0 0   my $self = shift;
166 0           my $TableSpec = shift;
167 0   0       my $parm = shift || 'title';
168            
169 0           my $title = $TableSpec->relspec_prefix;
170 0 0         $title = $self->TableSpec->name . '.' . $title unless ($title eq '');
171 0 0         $title = $self->TableSpec->name if ($title eq '');
172            
173 0           my $cnftitle = $TableSpec->get_Cnf($parm);
174 0 0         $title = $cnftitle . ' (' . $title . ')' unless ($TableSpec->name eq $cnftitle);
175            
176 0           return $title;
177             }
178              
179              
180             our $property_grid_nest_level = 0;
181              
182             sub TableSpec_property_grids {
183 0     0 0   my $self = shift;
184 0           my $TableSpec = shift;
185 0   0       my $Row = shift || $self->req_Row;
186 0   0       my $real_columns = shift || [];
187            
188 0           local $property_grid_nest_level = $property_grid_nest_level + 1;
189            
190 0 0         return $self->not_found_content unless ($Row);
191            
192 0           my %cols = map { $_->{name} => $_ } @{ $self->column_list };
  0            
  0            
193            
194 0           my @colnames = $TableSpec->local_column_names;
195            
196             # New: attemp to honor the column order
197 0           my %s = map {$_=>1} @colnames;
  0            
198 0           @colnames = grep { $s{$_} } uniq(@{ $self->column_order }, @colnames);
  0            
  0            
199            
200 0           push @$real_columns, @colnames;
201              
202              
203             ## -- Filter out non-existant relationship columns:
204             #@colnames = grep {
205             # exists $TableSpec->related_TableSpec->{$_} ?
206             # $Row->can($_) ? $Row->$_ ? 1 : 0
207             # : 0
208             # : 1;
209             #} @colnames;
210             ## --
211              
212            
213            
214 0           my @columns = map { $cols{$_} } @colnames;
  0            
215 0           my $fields = \@columns;
216            
217              
218 0           my $icon = $TableSpec->get_Cnf('singleIconCls');
219            
220 0           my @items = ();
221 0           my @multi_items = ();
222 0           my $visible = scalar grep { ! jstrue $_->{no_column} } @$fields;
  0            
223            
224 0 0 0       push @items, { xtype => 'spacer', height => 5 }, $self->property_grid($TableSpec,$icon,$fields)
225             if ($visible && ! $ONLY_MULTI_GRIDS);
226            
227 0           my @TableSpecs = ();
228            
229 0           foreach my $rel (@{$TableSpec->related_TableSpec_order}) {
  0            
230            
231 0 0         next if ($self->exclude_grids_relationships_map->{$rel});
232            
233             # This is fundamentally flawed if a related record doesn't exist initially, but then
234             # gets created, it will never be available!!
235 0           my $relRow = $Row->$rel;# or next;
236             # New: consider 'update_create_rels' (note that update_create_rels API is subject to change)
237 0           my %ucrls = map {$_=>1} @{$self->update_create_rels};
  0            
  0            
238             my $setup_grid = (
239             ($relRow && $relRow->isa('DBIx::Class::Row')) or
240 0 0 0       ($property_grid_nest_level == 1 && $ucrls{$rel})
241             ) ? 1 : 0;
242 0 0 0       if($setup_grid) {
    0 0        
    0          
243             push @items, $self->TableSpec_property_grids(
244 0           $TableSpec->related_TableSpec->{$rel},
245             $relRow,
246             $real_columns
247             );
248             }
249             elsif(!$relRow) {
250 0           next;
251             }
252             elsif($relRow->isa('DBIx::Class::ResultSet') and ($self->setup_multi_grids || $ONLY_MULTI_GRIDS)) {
253            
254 0           my $RelTS = $TableSpec->related_TableSpec->{$rel};
255            
256 0           my $info = $Row->result_source->relationship_info($rel);
257 0 0         next unless ($info->{attrs}->{accessor} eq 'multi'); #<-- should be redundant
258 0           my $cond_data = RapidApp::DBIC::Component::TableSpec->parse_relationship_cond($info->{cond});
259            
260 0           my $mod_name = 'rel_' . $RelTS->column_prefix . $rel;
261            
262 0           my $cur = $self->Module($mod_name)->content;
263 0           push @{$cur->{plugins}}, 'grid-autoheight', 'titlecollapseplus';
  0            
264            
265 0           push @multi_items, { xtype => 'spacer', height => 5 };
266             push @multi_items, {
267             %$cur,
268             autoWidth => \1,
269             titleCountLocal => \1,
270             collapsible => \1,
271             collapseFirst => \1,
272             titleCollapse => \1,
273             title => $self->TS_title($RelTS,'title_multi'),
274             #title => $RelTS->get_Cnf('title_multi') . ' (' . $rel . ')',
275             iconCls => $RelTS->get_Cnf('multiIconCls'),
276             gridsearch => undef,
277             pageSize => undef,
278             use_multifilters => \0,
279             viewConfig => { emptyText => '<span style="color:darkgrey;">(No&nbsp;' . $RelTS->get_Cnf('title_multi') . ')</span>' },
280             # Why do I have to set this manually?
281             bodyStyle => 'border: 1px solid #D0D0D0;',
282             baseParams => {
283             resultset_condition => $self->json->encode({ 'me.' . $cond_data->{foreign} => $Row->get_column($cond_data->{self}) })
284             },
285             store_add_initData => {
286             $cond_data->{foreign} => $Row->get_column($cond_data->{self})
287 0           }
288             };
289             }
290             }
291            
292 0 0         unshift @multi_items, { xtype => 'spacer', height => 5 } if (@multi_items > 0);
293              
294 0           return @items,@multi_items;
295             }
296              
297              
298              
299             sub property_grid {
300 0     0 0   my $self = shift;
301 0           my $TableSpec = shift;
302 0           my $icon = shift;
303 0           my $fields = shift;
304 0   0       my $opt = shift || {};
305            
306 0           my $title = $self->TS_title($TableSpec);
307            
308             # -- Programatically remove the automatically appened relspec from the header
309             # (Search for 'column_property_transforms' in RapidApp::TableSpec::Role::DBIC for details)
310             # We are just doing this so the column headers are shorter/cleaner and it is redundant in
311             # this context (same info is in the title of the property grid).
312 0           my $pre = $TableSpec->relspec_prefix;
313 0           foreach my $column (@$fields) {
314 0 0         $column->{header} or next;
315 0           $column->{header} =~ s/\s+\(${pre}\)$//;
316             }
317             # --
318            
319 0           my $conf = {
320            
321             autoWidth => \1,
322             #bodyCssClass => 'sbl-panel-body-noborder',
323             bodyStyle => 'border: 1px solid #D0D0D0;',
324             collapsible => \1,
325             collapseFirst => \0,
326             titleCollapse => \1,
327             autoHeight => \1,
328             title => $title,
329             iconCls => $icon,
330             xtype => 'apppropertygrid',
331             hideHeaders => \1,
332             autoHeight => \1,
333             editable => \1,
334             fields => $fields,
335             store => $self->getStore_func,
336             nameWidth => 250,
337            
338             sm => RapidApp::JSONFunc->new( func => 'new Ext.grid.RowSelectionModel', parm => {
339             listeners => {
340             # Disable row selection (note that disableSelection doesn't work in propertygrid with 'source')
341             beforerowselect => RapidApp::JSONFunc->new( raw => 1, func => 'function() { return false; }' )
342             }
343             }),
344             plugins => [ 'titlecollapseplus' ]
345             };
346            
347             $self->has_extconfig_param($_) and $conf->{$_} =
348 0   0       $self->get_extconfig_param($_) for qw/loadMask store_autoLoad/;
349            
350 0           return merge($conf,$opt);
351             }
352              
353             sub not_found_content {
354 0     0 0   my $self = shift;
355            
356 0           my $msg = 'Record not found';
357 0           my $id = $self->supplied_id;
358 0 0         $msg = "Record ($id) not found" if ($id);
359            
360 0           return { html => '<pre>' . $msg . '</pre>' };
361             }
362              
363              
364             1;
365              
366