lib/System/Introspector/Report/Updater.pm

   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;