1 package DX::DependencyMap;
3 use DX::Utils qw(CONTENTS_OF INDICES_OF);
6 # { x => [ { y => [ ...
7 # my $targ = $root; $targ = $targ->[0]{$_[0]} for @path
8 # my $deps = $targ->[$${$dep_type}];
10 has deps => (is => 'ro', isa => DependencyTree, required => 1);
12 has revdeps => (is => 'ro', required => 1);
16 $class->new(deps => {}, revdeps => {});
20 my ($self, $for_id, $deps_for) = @_;
21 my @expanded = $self->_expand_deps($deps_for);
24 $for_id => \@expanded,
26 my $new_deps = $self->_merge_deps_for(
27 $self->deps, $for_id, map @{$_}[1..$#$_], @expanded
31 revdeps => $new_revdeps
35 sub without_entries_for {
36 my ($self, @for_ids) = @_;
37 my %new_revdeps = %{$self->revdeps};
38 my $new_deps = $self->deps;
39 $new_deps = $self->_unmerge_deps_for(
40 $new_deps, $_, map @{$_}[1..$#$_], @{$new_revdeps{$_}}
42 delete @new_revdeps{@for_ids};
45 revdeps => \%new_revdeps
50 my ($self, $deps, $for_id, @merge_these) = @_;
51 $self->_mangle_deps($deps, sub {
52 +{ %{$_[0]}, $for_id => 1 };
56 sub _unmerge_deps_for {
57 my ($self, $deps, $for_id, @unmerge_these) = @_;
58 $self->_mangle_deps($deps, sub {
59 my %for_ids = %{$_[0]};
60 delete $for_ids{$for_id};
66 my ($self, $deps, $mangler, @to_mangle) = @_;
68 foreach my $mangle_this (@to_mangle) {
69 assert_DependencySpec $mangle_this;
70 my ($type, @path) = @$mangle_this;
72 foreach my $part (@path) {
73 my $sub = $targ->[0] = { %{$targ->[0]||{}} };
74 $targ = $sub->{$part} = [ @{$sub->{$part}||[]} ];
76 $targ->[$$$type] = $mangler->($targ->[$$$type]||{});
82 my ($self, $dep_groups) = @_;
84 assert_DependencyGroupList $dep_groups;
86 my ($on, @deps) = @$_;
88 DEP: foreach my $dep (@deps) {
89 my ($type, @path) = @$dep;
92 map { ref() ? @{$_->identity_path or next DEP} : $_ } @path
95 (@exp ? [ $on, @exp ] : ());
100 my ($self, $event) = @_;
101 my ($type, @path) = @$event;
102 my $root = [ $self->deps ];
104 my $last = pop @path;
106 foreach my $part (@path) {
107 $targ = $targ->[0]{$part};
108 # set/add/remove x.y or x.y.z affects contents of x
109 push @dep_sets, $targ->[$${+CONTENTS_OF}];
112 # add/remove x.y affects indices of x
113 push @dep_sets, $targ->[$${+INDICES_OF}];
115 $targ = $targ->[0]{$last};
117 # add/remove x affects existence of x
118 # set/add/remove x affects everything else too
119 push @dep_sets, @{$targ}[map $$$_, @$$type];
121 # set/add/remove x affects all dependencies on x.y, x.y.z etc.
122 my @q = values %{$targ->[0]};
123 while (my $el = shift @q) {
124 my ($el_kids, @el_deps) = @$el;
125 push @dep_sets, @el_deps;
126 push @q, values %{$el_kids||{}};
129 map +($_ => 1), map keys %$_, grep defined, @dep_sets
133 sub but_expire_dependents_of {
134 my ($self, @events) = @_;
135 my @expired = keys %{{
136 map +($_ => 1), map $self->_dependents_of($_), @events
138 # Didn't expire anything? Don't clone self
139 return $self unless @expired;
140 ($self->without_entries_for(@expired), @expired);
143 sub dependencies_for { $_[0]->revdeps->{$_[1]} }