File Coverage

blib/lib/Mojolicious/Plugin/Form/Base.pm
Criterion Covered Total %
statement 6 142 4.2
branch 0 56 0.0
condition 0 11 0.0
subroutine 2 11 18.1
pod 0 9 0.0
total 8 229 3.4


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::Form::Base;
2 3     3   270419 use Mojo::Base -base;
  3         7  
  3         18  
3              
4 3     3   431 use Data::Dumper;
  3         3  
  3         5068  
5              
6             has 'elements';
7             has 'ordered_elements';
8              
9             has 'element_info' => sub {
10             my ($self, $element) = @_;
11             return $self->elements->{$element};
12             };
13              
14             has 'id_field';
15              
16             has 'name_field';
17              
18             has 'order_by';
19              
20             has 'form_debug' => 0;
21              
22             sub add_elements {
23 0     0 0   my ($self, @elems) = @_;
24              
25 0           my @added;
26 0           my $elements = $self->elements;
27 0           while (my $el = shift @elems) {
28 0           my $element_info = {};
29 0 0         if ($el =~ s/^\+//) {
30 0           $element_info = $self->element_info($el);
31             }
32              
33             # If next entry is { ... } use that for the info, if not
34             # use an empty hashref
35 0 0         if (ref $elems[0]) {
36 0           my $new_info = shift(@elems);
37 0           %$element_info = (%$element_info, %$new_info);
38             }
39 0 0         push(@added, $el) unless exists $elements->{$el};
40 0           $elements->{$el} = $element_info;
41             }
42 0           push @{$self->ordered_elements}, @added;
  0            
43 0           return $self;
44             }
45              
46             sub from_schema {
47 0     0 0   my $self = shift;
48 0           my $schema = shift;
49 0   0       my $source = shift || $self->name;
50              
51 0 0         $self->order_by || $self->order_by($self->order_field($schema, $source));
52              
53 0           my $columns = [$schema->source($source)->columns];
54              
55             #my $result = $schema->resultset($source)->single({$order => $id});
56              
57 0           my $columns_info = $schema->source($source)->columns_info($columns);
58              
59             # TODO: smarter
60             #my $primary_columns = [$schema->source($source)->primary_columns];
61             #$self->id_field($primary_columns->[0]);
62            
63 0           my ($id_field, $name_field) = $self->id_and_name($schema, $source);
64 0 0         $self->id_field || $self->id_field($id_field);
65 0 0         $self->name_field || $self->name_field($name_field);
66              
67 0           my $relationships = [ $schema->source($source)->relationships ];
68              
69 0 0         print STDERR '$relationships: ', Dumper($relationships), "\n" if $self->form_debug;
70              
71 0           my $rel_elements;
72 0           for my $relation (@$relationships) {
73 0           my $relationship = $self->related($schema, $source, $relation);
74 0 0         $rel_elements->{$relation} = $relationship if $relationship;
75             }
76            
77 0           my $rel_multi;
78 0           for my $relation (@$relationships) {
79 0           my $relationship = $self->multi_related($schema, $source, $relation);
80 0 0         $rel_multi->{$relation} = $relationship if $relationship;
81             }
82            
83 0 0         $self->elements || $self->elements({});
84 0 0         $self->ordered_elements || $self->ordered_elements([]);
85            
86 0           for my $column (@$columns) {
87 0           my $element;
88              
89 0 0         if (my $rel_element = $self->exchanges_field($rel_elements, $column)) {
90 0           $element = $rel_elements->{$rel_element};
91             }
92             else {
93 0           my $type = $self->type($columns_info->{$column}->{data_type});
94 0 0         my $required = $columns_info->{$column}->{is_nullable} ? '' : 'required';
95            
96 0           $element = {
97             'type' => $type,
98             'name' => $column,
99             'required' => $required,
100             };
101 0 0 0       if (exists $columns_info->{$column}->{default_value} && $columns_info->{$column}->{default_value}) {
102 0           $element->{'default'} = $columns_info->{$column}->{default_value};
103             }
104             }
105              
106 0 0         if ($column eq $self->id_field) { $element->{'hidden'} = 1; }
  0            
107              
108 0           $self->elements->{$column} = $element;
109 0           push @{$self->ordered_elements}, $column;
  0            
110             }
111            
112 0           for my $multi (keys %$rel_multi) {
113 0           $self->elements->{$multi} = $rel_multi->{$multi};
114 0           push @{$self->ordered_elements}, $multi;
  0            
115             }
116            
117 0 0         print STDERR 'id_field: ',$self->id_field,' name_field: ',$self->name_field,"\n" if $self->form_debug;
118 0 0         print STDERR 'elements: ',Dumper($self->elements),"\n" if $self->form_debug;
119 0           return $self;
120             }
121              
122             sub exchanges_field {
123 0     0 0   my ($self, $rel_elements, $column) = @_;
124 0           for my $rel_element (keys %$rel_elements) {
125 0 0 0       if (exists $rel_elements->{$rel_element}->{'exchanges_field'}
126             && $rel_elements->{$rel_element}->{'exchanges_field'} eq $column)
127             {
128 0           return $rel_element;
129             }
130             }
131 0           return;
132             }
133              
134             sub related {
135 0     0 0   my ($self, $schema, $source, $relation) = @_;
136 0 0         return undef unless $source;
137              
138             #'cond' => { 'foreign.group_id' => 'self.global_role_id' },
139              
140 0           my $rel_info = $schema->source($source)->relationship_info($relation);
141              
142             # print STDERR '$rel_info: ', Dumper($rel_info), "\n";
143              
144             # TODO: accessor 'multi' (???)
145 0 0         return undef unless ($rel_info->{attrs}->{accessor} eq 'single');
146              
147 0           my $rel_source =
148             $schema->source($source)->related_source($relation)->{'source_name'};
149              
150 0           my @rel_fields = $self->id_and_name($schema, $rel_source);
151              
152 0           my @conditions = %{$rel_info->{cond}};
  0            
153              
154 0           my @self_fields = map { /(\w+)$/; $1 } grep {/^(self\.|)(\w+)$/} @conditions;
  0            
  0            
  0            
155 0           my @foreign_fields =
156 0           map { /(\w+)$/; $1 } grep {/^(foreign\.|)(\w+)$/} @conditions;
  0            
  0            
157              
158 0           my $field_to_exchange = $self_fields[0];
159 0           my $rel_key = $foreign_fields[0];
160              
161 0           my ($name_field) = grep { $_ !~ /^$rel_key$/ } @rel_fields;
  0            
162              
163 0           my $related_element = {
164             'type' => 'Block',
165             'nested_name' => $relation,
166             'exchanges_field' => $field_to_exchange,
167             'key' => $rel_key,
168             'elements' => [
169             {
170             'type' => 'Text',
171             'name' => $name_field,
172             },
173             ],
174             };
175 0           return $related_element;
176             }
177              
178             sub multi_related {
179 0     0 0   my ($self, $schema, $source, $relation) = @_;
180 0 0         return undef unless $source;
181              
182             #'cond' => { 'foreign.group_id' => 'self.global_role_id' },
183              
184 0           my $rel_info = $schema->source($source)->relationship_info($relation);
185              
186             # print STDERR '$rel_info: ', Dumper($rel_info), "\n";
187              
188             # TODO: accessor 'multi' (???)
189 0 0         return undef unless ($rel_info->{attrs}->{accessor} eq 'multi');
190              
191 0           my $rel_source =
192             $schema->source($source)->related_source($relation)->{'source_name'};
193              
194 0           my @rel_fields = $self->id_and_name($schema, $rel_source);
195              
196 0           my @conditions = %{$rel_info->{cond}};
  0            
197              
198 0           my @self_fields = map { /(\w+)$/; $1 } grep {/^(self\.|)(\w+)$/} @conditions;
  0            
  0            
  0            
199 0           my @foreign_fields =
200 0           map { /(\w+)$/; $1 } grep {/^(foreign\.|)(\w+)$/} @conditions;
  0            
  0            
201              
202 0           my $field_to_exchange = $self_fields[0];
203 0           my $rel_key = $foreign_fields[0];
204              
205 0           my ($name_field) = grep { $_ !~ /^$rel_key$/ } @rel_fields;
  0            
206              
207 0           my $related_element = {
208             'type' => 'Multi',
209             'nested_name' => $relation,
210             'exchanges_field' => $field_to_exchange,
211             'key' => $rel_key,
212             'elements' => [
213             {
214             'type' => 'Text',
215             'name' => $name_field,
216             },
217             ],
218             };
219 0           return $related_element;
220             }
221              
222             sub order_field {
223 0     0 0   my ($self, $schema, $source) = @_;
224 0 0         return undef unless $source;
225              
226 0           my @columns = $schema->source($source)->columns;
227 0           my @source_ids = grep {/name/} @columns;
  0            
228              
229 0           my @primary_columns = $schema->source($source)->primary_columns;
230 0           push @source_ids, @primary_columns;
231              
232             #my $table_name = $schema->class($source)->table;
233 0           my $table_name = lc $source;
234 0           push @source_ids, grep {/${table_name}_id/} @columns;
  0            
235              
236 0 0         return $source_ids[0] if (scalar @source_ids);
237 0 0         return $columns[0] if (scalar @columns);
238             }
239              
240             sub id_and_name {
241 0     0 0   my ($self, $schema, $source) = @_;
242 0 0         return undef unless $source;
243 0           my @columns = $schema->source($source)->columns;
244              
245 0           my @source_ids;
246 0           my @primary_columns = $schema->source($source)->primary_columns;
247 0           push @source_ids, $primary_columns[0];
248 0           push @source_ids, grep {/name/} @columns;
  0            
249              
250             #push @source_ids, $primary_columns[1] unless (scalar @source_ids >= 2);
251 0 0         push @source_ids, $columns[1] unless (scalar @source_ids >= 2);
252              
253 0           return @source_ids;
254             }
255              
256             sub name {
257 0     0 0   my $self = shift;
258 0           my $class_name = ref $self;
259 0           $class_name =~ s/^.*::(\w+)$/$1/;
260 0           return $class_name;
261             }
262              
263             sub type {
264 0     0 0   my $self = shift;
265 0   0       my $data_type = shift || 'text';
266              
267 0           my $data2elem = {
268             'integer' => 'number',
269             'varchar' => 'text',
270             'tinyint' => 'checkbox',
271             'enum' => 'enum',
272             };
273 0 0         return $data2elem->{$data_type} ? $data2elem->{$data_type} : 'text';
274             }
275              
276             1;