File Coverage

blib/lib/EntityModel/Definition.pm
Criterion Covered Total %
statement 42 65 64.6
branch 9 30 30.0
condition 5 27 18.5
subroutine 6 10 60.0
pod 8 8 100.0
total 70 140 50.0


line stmt bran cond sub pod time code
1             package EntityModel::Definition;
2             {
3             $EntityModel::Definition::VERSION = '0.102';
4             }
5             use EntityModel::Class {
6 7         61 model => { type => 'EntityModel::Model' },
7 7     7   5214 };
  7         18  
8 7     7   3958 no if $] >= 5.017011, warnings => "experimental::smartmatch";
  7         15  
  7         62  
9              
10             =head1 NAME
11              
12             EntityModel::Definition - definition support for L
13              
14             =head1 VERSION
15              
16             version 0.102
17              
18             =head1 SYNOPSIS
19              
20             See L.
21              
22             =head1 DESCRIPTION
23              
24             See L.
25              
26             =head1 METHODS
27              
28             =cut
29              
30             =head2 load
31              
32             Generic load method, passing file or string to the appropriate L or L methods.
33              
34             =cut
35              
36             sub load {
37 2     2 1 75 my $self = shift;
38 2         10 my %args = @_;
39              
40 2         7 my $src = delete $args{source};
41 2         6 my ($k, $v);
42 2 50       15 if(ref $src ~~ 'HASH') {
    0          
43 2         10 ($k, $v) = %$src;
44             } elsif(ref $src ~~ 'ARRAY') {
45 0         0 ($k, $v) = @$src;
46             } else {
47 0         0 $k = $src;
48             }
49 2         27 logDebug("Trying [%s] as [%s] => [%s]", $self, $k, $v);
50 2 50       92 die 'Nothing passed' unless defined $k;
51              
52 2         4 my $structure;
53 2 50 0     11 $structure ||= $self->load_file($v) if $k eq 'file' && defined $v;
      33        
54 2 50 33     29 $structure ||= $self->load_string($v) if $k eq 'string' && defined $v;
      33        
55              
56             # Support older interface - single parameter, scalarref for string, plain scalar for XML filename
57 2 50 0     14 $structure ||= $self->load_file($k) if !ref($k) && !$v;
      33        
58 2 50 0     10 $structure ||= $self->load_string($$k) if ref($k) && !$v;
      33        
59 2 50       10 die 'Unable to load ' . $self . " from [$k] and [$v]" unless $structure;
60 2         17 return $self->apply_model_from_structure(
61             model => $args{model},
62             structure => $structure
63             );
64             }
65              
66             =head2 save
67              
68             Generic save method, passing file or string to the appropriate L or L methods.
69              
70             =cut
71              
72             sub save {
73 0     0 1 0 my $self = shift;
74 0         0 my %args = @_;
75              
76 0         0 my $target = delete $args{target};
77 0         0 my ($k, $v);
78 0 0       0 if(ref $target ~~ 'HASH') {
    0          
79 0         0 ($k, $v) = %$target;
80             } elsif(ref $target ~~ 'ARRAY') {
81 0         0 ($k, $v) = @$target;
82             } else {
83 0         0 $k = shift;
84             }
85 0         0 logDebug("Trying [%s] as [%s] => [%s]", $self, $k, $v);
86 0 0       0 die 'Nothing passed' unless defined $k;
87              
88 0         0 my %data = (
89             model => $self->model,
90             );
91 0 0 0     0 return $self->save_file(
92             target => $v,
93             %data
94             ) if $k eq 'file' && defined $v;
95 0 0       0 return $self->save_string(
96             output => 'string',
97             %data
98             ) if $k eq 'string';
99              
100 0         0 die 'Unable to save ' . $self . " from [$k] and [$v]";
101 0         0 return $self;
102             }
103              
104             =head2 field_structure
105              
106             =cut
107              
108             sub field_structure {
109 0     0 1 0 my ($self, $field) = @_;
110             return {
111 0         0 name => $field->name,
112             type => $field->type,
113             };
114             }
115              
116             =head2 entity_structure
117              
118             =cut
119              
120             sub entity_structure {
121 0     0 1 0 my ($self, $entity) = @_;
122             return {
123 0         0 name => $entity->name,
124             primary => $entity->primary,
125             field => [ map $self->field_structure($_), $entity->field->list ],
126             }
127             }
128              
129             =head2 structure_from_model
130              
131             Return a hashref representing the given model.
132              
133             =cut
134              
135             sub structure_from_model {
136 0     0 1 0 my ($self, $model) = @_;
137             return {
138 0         0 name => $model->name,
139             entity => [
140             map $self->entity_structure($_), $model->entity->list
141             ],
142             };
143             }
144              
145             =head2 apply_model_from_structure
146              
147             Applies a definition (given as a hashref) to generate or update a model.
148              
149             =cut
150              
151             sub apply_model_from_structure {
152 6     6 1 14 my $self = shift;
153 6         20 my %args = @_;
154 6         15 my $model = delete $args{model};
155 6         13 my $definition = delete $args{structure};
156              
157 6 50       30 if(my $name = delete $definition->{name}) {
158 6         37 $model->name($name);
159             }
160              
161 6 50       152 if(my $entity = delete $definition->{entity}) {
162 6         16 my @entity_list = @$entity;
163             $self->add_entity_to_model(
164             model => $model,
165             definition => $_
166 6         56 ) foreach @$entity;
167             }
168 6         29 foreach my $k (sort keys %$definition) {
169 1         9 $model->handle_item(
170             item => $k,
171             data => $definition->{$k}
172             );
173             }
174 6         53 $model->resolve_entity_dependencies;
175 6         28 return $self;
176             }
177              
178             =head2 add_entity_to_model
179              
180             Create a new entity and add it to the given model.
181              
182             =cut
183              
184             sub add_entity_to_model {
185 13     13 1 21 my $self = shift;
186 13         40 my %args = @_;
187              
188 13         28 my $model = delete $args{model};
189 13         29 my $def = delete $args{definition};
190 13         75 my $entity = EntityModel::Entity->create_from_definition($def);
191 13         83 $model->add_entity($entity);
192 13         46 return $self;
193             }
194              
195             =head2 register
196              
197             Empty default method, implemented by subclasses to register themselves with the model.
198              
199             =cut
200              
201 6     6 1 17 sub register { }
202              
203             1;
204              
205             __END__