view release on metacpan or  search on metacpan

t/resultset/rowparser_internals.t  view on Meta::CPAN

      # cache expensive set of ops in a non-existent rowid slot
      $cur_row_ids{10} = (
        ( ( defined $cur_row_data->[0] ) && (join "\xFF", q{}, $cur_row_data->[0], q{} ))
          or
        ( ( defined $cur_row_data->[2] ) && (join "\xFF", q{}, $cur_row_data->[2], q{} ))
          or
        "\0$rows_pos\0"
      );

      # a present cref in $_[1] implies lazy prefetch, implies a supplied stash in $_[2]
      $_[1] and $result_pos and ! $collapse_idx[0]{$cur_row_ids{10}} and (unshift @{$_[2]}, $cur_row_data) and last;

      $collapse_idx[0]{$cur_row_ids{10}} //= $_[0][$result_pos++] = { year => $$cur_row_data[1] };

      (! defined $cur_row_data->[0] ) ? $collapse_idx[0]{$cur_row_ids{10}}{single_track} = undef : do {

        $collapse_idx[0]{$cur_row_ids{10}}{single_track} //= ($collapse_idx[1]{$cur_row_ids{0}} = { trackid => $$cur_row_data[0] });

        $collapse_idx[1]{$cur_row_ids{0}}{cd} //= $collapse_idx[2]{$cur_row_ids{0}};

        $collapse_idx[2]{$cur_row_ids{0}}{artist} //= ($collapse_idx[3]{$cur_row_ids{0}} = { artistid => $$cur_row_data[6] });

        (! defined $cur_row_data->[4] ) ? $collapse_idx[3]{$cur_row_ids{0}}{cds} = [] : do {

          (! $collapse_idx[4]{$cur_row_ids{0}}{$cur_row_ids{4}} )
            and
          push @{$collapse_idx[3]{$cur_row_ids{0}}{cds}}, (
              $collapse_idx[4]{$cur_row_ids{0}}{$cur_row_ids{4}} = { cdid => $$cur_row_data[4], genreid => $$cur_row_data[7], year => $$cur_row_data[5] }
          );

          (! defined $cur_row_data->[8] ) ? $collapse_idx[4]{$cur_row_ids{0}}{$cur_row_ids{4}}{tracks} = [] : do {

            (! $collapse_idx[5]{$cur_row_ids{0}}{$cur_row_ids{4}}{$cur_row_ids{8}} )
              and
            push @{$collapse_idx[4]{$cur_row_ids{0}}{$cur_row_ids{4}}{tracks}}, (
                $collapse_idx[5]{$cur_row_ids{0}}{$cur_row_ids{4}}{$cur_row_ids{8}} = { title => $$cur_row_data[8] }
            );
          };
        };
      };

      (! defined $cur_row_data->[2] ) ? $collapse_idx[0]{$cur_row_ids{10}}{tracks} = [] : do {
        (! $collapse_idx[6]{$cur_row_ids{2}}{$cur_row_ids{3}} )
          and
        push @{$collapse_idx[0]{$cur_row_ids{10}}{tracks}}, (
            $collapse_idx[6]{$cur_row_ids{2}}{$cur_row_ids{3}} = { cd => $$cur_row_data[2], title => $$cur_row_data[3] }
        );
      };
    }

    $#{$_[0]} = $result_pos - 1;
  ',
  'Multiple has_many on multiple branches with underdefined root, HRI-direct torture test',
);

done_testing;

my $deparser;
sub is_same_src { SKIP: {

  skip "Skipping comparison of unicode-posioned source", 1
    if DBIx::Class::_ENV_::STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE;

  $deparser ||= B::Deparse->new;
  local $Test::Builder::Level = $Test::Builder::Level + 1;

  my ($got, $expect) = @_;

  skip "Not testing equality of source containing defined-or operator on this perl $]", 1
    if ($] < 5.010 and$expect =~ m!\Q//=!);

  $expect =~ s/__NBC__/perlstring($DBIx::Class::ResultSource::RowParser::Util::null_branch_class)/ge;

  $expect = "  { use strict; use warnings FATAL => 'uninitialized';\n$expect\n  }";

  my @normalized = map {
    my $cref = eval "sub { $_ }" or do {
      fail "Coderef does not compile!\n\n$@\n\n$_";
      return undef;
    };
    $deparser->coderef2text($cref);
  } ($got, $expect);

  &is (@normalized, $_[2]||() ) or do {
    eval { require Test::Differences }
      ? &Test::Differences::eq_or_diff( @normalized, $_[2]||() )
      : note ("Original sources:\n\n$got\n\n$expect\n")
    ;
    exit 1;
  };
} }