File Coverage

blib/lib/EntityModel/Support.pm
Criterion Covered Total %
statement 6 35 17.1
branch 0 8 0.0
condition n/a
subroutine 2 4 50.0
pod 2 2 100.0
total 10 49 20.4


line stmt bran cond sub pod time code
1             package EntityModel::Support;
2             {
3             $EntityModel::Support::VERSION = '0.102';
4             }
5             use EntityModel::Class {
6 14     14   9421 };
  14         29  
  14         98  
7 14     14   5750 no if $] >= 5.017011, warnings => "experimental::smartmatch";
  14         78  
  14         118  
8              
9             =head1 NAME
10              
11             EntityModel::Support - language support for L
12              
13             =head1 VERSION
14              
15             version 0.102
16              
17             =head1 SYNOPSIS
18              
19             See L.
20              
21             =head1 DESCRIPTION
22              
23             See L.
24              
25             =head1 METHODS
26              
27             =cut
28              
29             =head2 register
30              
31             Register with L so that callbacks trigger when further definitions are loaded/processed.
32              
33             =cut
34              
35             sub register {
36 0     0 1   my $class = shift;
37             }
38              
39             =head2 apply_model
40              
41             Apply the given model.
42              
43             =cut
44              
45             sub apply_model {
46 0     0 1   my $self = shift;
47 0           my $model = shift;
48              
49 0           my @pending = $model->entity->list;
50 0           my @pendingNames = map { $_->name } @pending;
  0            
51 0           my @existing;
52             ITEM:
53 0           while(@pending) {
54 0           my $entity = shift(@pending);
55 0           shift(@pendingNames);
56              
57 0           my @deps = $entity->dependencies;
58              
59             # Include current entity in list of available entries, so that we can allow self-reference
60             DEP:
61 0           foreach my $dep (@deps) {
62 0 0         next DEP if $dep->name ~~ $entity->name;
63 0 0         next DEP if grep { $dep->name ~~ $_ } @pendingNames;
  0            
64 0 0         unless(grep { $dep->name ~~ $_->name } @existing) {
  0            
65 0           logError("%s unresolved (pending %s, deps %s for %s)", $dep->name, join(',', @pendingNames), join(',', @deps), $entity->name);
66 0           die "Dependency error";
67             }
68             }
69              
70 0           my @unsatisfied = grep { $_->name ~~ \@pendingNames } @deps;
  0            
71 0 0         if(@unsatisfied) {
72 0           logInfo("%s has %d unsatisfied deps, postponing: %s", $entity->name, scalar @unsatisfied, join(',',@unsatisfied));
73 0           push @pending, $entity;
74 0           push @pendingNames, $entity->name;
75 0           next ITEM;
76             }
77              
78 0           $self->apply_entity($entity);
79 0           push @existing, $entity;
80             }
81 0           return $self;
82             }
83              
84             1;
85              
86             __END__