use strict;
use warnings;
no warnings 'redefine';

# currently only really usable as repl-bound functions
# hence the redefine warnings disabled for iterative dev/debugging

# tree($source) provides a rel tree on the source that tries to follow
# dependencies only - i.e. stops when it hits a belongs_to rel

# emit($obj) uses tree() to dump an object to a datastructure that can
# be re-created via create() (with 0.08+)

use vars qw($seen);

sub tree {
  local $seen = { %{$seen||{}} };
  my $s = shift;
  my $r = {};
  foreach my $name ($s->relationships) {
    my $info = $s->relationship_info($name);
    if ($info->{attrs}{cascade_delete}) {
      my $r_source = $s->related_source($name);
      next if $seen->{$r_source}++;
      $r->{$name} = tree($r_source);
    }
  }
  return $r;
}

sub emit {
  my ($o, $tree) = @_;
  my $info = emit_inner($o, $tree);
  # re-add pk
  foreach my $kcol ($o->primary_columns) {
    next if $o->column_info($kcol)->{is_auto_increment};
    $info->{$kcol} = $o->get_column($kcol);
  }
  return $info;
}

sub emit_inner {
  my ($o, $tree, $skip_ref) = @_;
  $tree ||= tree($o->result_source);
  my $info;
  my $cols = { $o->get_columns };
  my @skip = @{$skip_ref||[]};
  delete @{$cols}{@skip};
  @{$info}{keys %$cols} = @{$cols}{keys %$cols};
  foreach my $r (keys %$tree) {
    my $r_info = $o->result_source->relationship_info($r);
    my @skip_r = keys %{$o->result_source
                          ->resolve_condition($r_info->{cond})};
    if ($r_info->{attrs}{accessor} eq 'multi') {
      $info->{$r} = [
        map { emit_inner($_, $tree->{$r}, \@skip_r) }
          grep { defined($_) } $o->search_related($r)->all
      ];
    } else {
      if (my $f = $o->search_related($r)->first) {
        $info->{$r} = emit_inner($f, $tree->{$r}, \@skip_r);
      }
    }
  }
  return $info;
}