Commit | Line | Data |
21e7cc98 |
1 | package System::Introspector::Report::Updater; |
2 | use Moo; |
3 | |
4 | my $_flatten_id = sub { |
5 | my $value = $_[0]; |
6 | return ref($value) ? join("\0", @$value) : $value; |
7 | }; |
8 | |
9 | sub merge { |
10 | my ($self, $original, $update) = @_; |
11 | my $old = $self->_map_reports_by_id($original); |
12 | my $new = $self->_map_reports_by_id($update); |
13 | my %add = map { ($_ => $new->{$_}) } grep { not($old->{$_}) } keys %$new; |
14 | return $self->_weave_additional([ map { |
15 | (ref($_) eq 'HASH') ? do { |
16 | my $report = $_; |
17 | my $id = $report->{id}->$_flatten_id; |
18 | $new->{$id} |
19 | ? $self->_merge_reports($report, $new->{$id}) |
20 | : $report; |
21 | } : $_; |
22 | } @$original ], \%add, $self->_calc_sequence($update)); |
23 | } |
24 | |
25 | sub _weave_additional { |
26 | my ($self, $stream, $additional, $sequence) = @_; |
27 | my @items = @$stream; |
28 | if (my $begin = $sequence->{''}) { |
29 | if (my $item = delete $additional->{$begin}) { |
30 | unshift @items, $item; |
31 | } |
32 | } |
33 | my @done; |
34 | while (defined( my $item = shift @items )) { |
35 | if (ref($item) eq 'HASH') { |
36 | my $item_id = $item->{id}->$_flatten_id; |
37 | if (my $after = $sequence->{$item_id}) { |
38 | if (my $insert = $additional->{$after}) { |
39 | unshift @items, $insert; |
40 | } |
41 | } |
42 | } |
43 | push @done, $item; |
44 | } |
45 | return \@done; |
46 | } |
47 | |
48 | sub _calc_sequence { |
49 | my ($self, $stream) = @_; |
50 | my @ids = map { |
51 | $_->{id}->$_flatten_id; |
52 | } grep { |
53 | ref($_) eq 'HASH'; |
54 | } @$stream; |
55 | my %sequence; |
56 | for my $index (0 .. $#ids) { |
57 | $sequence{ $index ? $ids[$index - 1] : '' } = $ids[$index]; |
58 | } |
59 | return \%sequence; |
60 | } |
61 | |
62 | sub _merge_reports { |
63 | my ($self, $original, $update) = @_; |
64 | my $rowid = $update->{rowid}; |
65 | my $ident = sub { |
66 | my $row = shift; |
67 | join "\0", map $row->{$_}, @$rowid; |
68 | }; |
69 | my %current; |
70 | $current{$_->$ident} = $_ |
71 | for @{$original->{rows}}; |
72 | return { |
73 | title => $update->{title}, |
74 | id => $update->{id}, |
75 | rowid => $update->{rowid}, |
76 | meta => $update->{meta} || {}, |
77 | columns => [ |
78 | @{$update->{columns}}, |
79 | (grep { |
80 | $_->{key} =~ m{^__}; |
81 | } @{$original->{columns}}), |
82 | ], |
83 | rows => [ map { |
84 | my $row = $_; |
85 | my $id = $row->$ident; |
86 | +{ %{$current{$id}||{}}, %$row }; |
87 | } @{$update->{rows}} ], |
88 | }; |
89 | } |
90 | |
91 | sub _map_reports_by_id { |
92 | my ($self, $stream) = @_; |
93 | return { |
94 | map { |
95 | ($_->{id}->$_flatten_id, $_); |
96 | } grep { |
97 | ref($_) eq 'HASH'; |
98 | } @$stream, |
99 | }; |
100 | } |
101 | |
102 | 1; |