t/prefetch/multiple_hasmany.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6 use lib qw(t/lib);
   7 use DBICTest;
   8 use IO::File;
   9
  10 plan tests => 10;
  11
  12 my $schema = DBICTest->init_schema();
  13 my $sdebug = $schema->storage->debug;
  14
  15 # once the following TODO is complete, remove the 2 warning tests immediately
  16 # after the TODO block
  17 # (the TODO block itself contains tests ensuring that the warns are removed)
  18 TODO: {
  19     local $TODO = 'Prefetch of multiple has_many rels at the same level (currently warn to protect the clueless git)';
  20
  21     #( 1 -> M + M )
  22     my $cd_rs = $schema->resultset('CD')->search ({ 'me.title' => 'Forkful of bees' });
  23     my $pr_cd_rs = $cd_rs->search ({}, {
  24         prefetch => [qw/tracks tags/],
  25     });
  26
  27     my $tracks_rs = $cd_rs->first->tracks;
  28     my $tracks_count = $tracks_rs->count;
  29
  30     my ($pr_tracks_rs, $pr_tracks_count);
  31
  32     my $queries = 0;
  33     $schema->storage->debugcb(sub { $queries++ });
  34     $schema->storage->debug(1);
  35
  36     my $o_mm_warn;
  37     {
  38         local $SIG{__WARN__} = sub { $o_mm_warn = shift };
  39         $pr_tracks_rs = $pr_cd_rs->first->tracks;
  40     };
  41     $pr_tracks_count = $pr_tracks_rs->count;
  42
  43     ok(! $o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (1 -> M + M)');
  44
  45     is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query');
  46     $schema->storage->debugcb (undef);
  47     $schema->storage->debug ($sdebug);
  48
  49     is($pr_tracks_count, $tracks_count, 'equal count of prefetched relations over several same level has_many\'s (1 -> M + M)');
  50     is ($pr_tracks_rs->all, $tracks_rs->all, 'equal amount of objects returned with and without prefetch over several same level has_many\'s (1 -> M + M)');
  51
  52     #( M -> 1 -> M + M )
  53     my $note_rs = $schema->resultset('LinerNotes')->search ({ notes => 'Buy Whiskey!' });
  54     my $pr_note_rs = $note_rs->search ({}, {
  55         prefetch => {
  56             cd => [qw/tracks tags/]
  57         },
  58     });
  59
  60     my $tags_rs = $note_rs->first->cd->tags;
  61     my $tags_count = $tags_rs->count;
  62
  63     my ($pr_tags_rs, $pr_tags_count);
  64
  65     $queries = 0;
  66     $schema->storage->debugcb(sub { $queries++ });
  67     $schema->storage->debug(1);
  68
  69     my $m_o_mm_warn;
  70     {
  71         local $SIG{__WARN__} = sub { $m_o_mm_warn = shift };
  72         $pr_tags_rs = $pr_note_rs->first->cd->tags;
  73     };
  74     $pr_tags_count = $pr_tags_rs->count;
  75
  76     ok(! $m_o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (M -> 1 -> M + M)');
  77
  78     is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query');
  79     $schema->storage->debugcb (undef);
  80     $schema->storage->debug ($sdebug);
  81
  82     is($pr_tags_count, $tags_count, 'equal count of prefetched relations over several same level has_many\'s (M -> 1 -> M + M)');
  83     is($pr_tags_rs->all, $tags_rs->all, 'equal amount of objects with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)');
  84 }
  85
  86 # remove this closure once the TODO above is working
  87 {
  88     my $warn_re = qr/will explode the number of row objects retrievable via/;
  89
  90     my (@w, @dummy);
  91     local $SIG{__WARN__} = sub { $_[0] =~ $warn_re ? push @w, @_ : warn @_ };
  92
  93     my $rs = $schema->resultset('CD')->search ({ 'me.title' => 'Forkful of bees' }, { prefetch => [qw/tracks tags/] });
  94     @w = ();
  95     @dummy = $rs->first;
  96     is (@w, 1, 'warning on attempt prefetching several same level has_manys (1 -> M + M)');
  97
  98     my $rs2 = $schema->resultset('LinerNotes')->search ({ notes => 'Buy Whiskey!' }, { prefetch => { cd => [qw/tags tracks/] } });
  99     @w = ();
 100     @dummy = $rs2->first;
 101     is (@w, 1, 'warning on attempt prefetching several same level has_manys (M -> 1 -> M + M)');
 102 }
 103
 104
 105 # Illustration purposes only
 106
 107 {
 108   package Inf::Dump;
 109   sub inflate_result {
 110     return [ @_[2,3] ];
 111   }
 112 }
 113
 114 my $cd = $schema->resultset ('CD')->create ({
 115   artist => 1,
 116   title => 'bad cd',
 117   year => 1313,
 118   tags => [ map { { tag => "bad tag $_" } } (1 .. 3) ],
 119   tracks => [
 120     { title => 'bad track 1', cd_single => {
 121       artist => 1,
 122       title => 'bad_single',
 123       year => 1313,
 124     }},
 125     map { { title => "bad track $_" } } (2 .. 3),
 126   ],
 127 });
 128
 129 my $rs = $schema->resultset ('CD')->search (
 130   { 'me.cdid' => $cd->id },
 131   { prefetch => [ 'tags', { tracks => 'cd_single' } ], result_class => 'Inf::Dump' },
 132 );
 133
 134 use Text::Table;
 135 my $query = ${$rs->as_query}->[0];
 136 my ($cols) = ( $query =~ /SELECT (.+) FROM/);
 137 my $tb = Text::Table->new (map { $_ => \ ' | ' } (split /,\s*/, $cols) );
 138
 139 my $c = $rs->cursor;
 140 while (my @stuff = $c->next) {
 141   $tb->add (map { defined $_ ? $_ : 'NULL' } (@stuff) );
 142 }
 143
 144 $rs->reset;
 145 use Data::Dumper;
 146 note Dumper [
 147   "\n$query",
 148   "\n$tb",
 149   $rs->next
 150 ];
 151
 152
 153
 154
 155 __END__
 156 The solution is to rewrite ResultSet->_collapse_result() and
 157 ResultSource->resolve_prefetch() to focus on the final results from the collapse
 158 of the data. Right now, the code doesn't treat the columns from the various
 159 tables as grouped entities. While there is a concept of hierarchy (so that
 160 prefetching down relationships does work as expected), there is no idea of what
 161 the final product should look like and how the various columns in the row would
 162 play together. So, the actual prefetch datastructure from the search would be
 163 very useful in working through this problem. We already have access to the PKs
 164 and sundry for those. So, when collapsing the search result, we know we are
 165 looking for 1 cd object. We also know we're looking for tracks and tags records
 166 -independently- of each other. So, we can grab the data for tracks and data for
 167 tags separately, uniqueing on the PK as appropriate. Then, when we're done with
 168 the given cd object's datastream, we know we're good. This should work for all
 169 the various scenarios.
 170
 171 My reccommendation is the row's data is preprocessed first, breaking it up into
 172 the data for each of the component tables. (This could be done in the single
 173 table case, too, but probably isn't necessary.) So, starting with something
 174 like:
 175   my $row = {
 176     t1.col1 => 1,
 177     t1.col2 => 2,
 178     t2.col1 => 3,
 179     t2.col2 => 4,
 180     t3.col1 => 5,
 181     t3.col2 => 6,
 182   };
 183 it is massaged to look something like:
 184   my $row_massaged = {
 185     t1 => { col1 => 1, col2 => 2 },
 186     t2 => { col1 => 3, col2 => 4 },
 187     t3 => { col1 => 5, col2 => 6 },
 188   };
 189 At this point, find the stuff that's different is easy enough to do and slotting
 190 things into the right spot is, likewise, pretty straightforward. Instead of
 191 storing things in a AoH, store them in a HoH keyed on the PKs of the the table,
 192 then convert to an AoH after all collapsing is done.
 193
 194 This implies that the collapse attribute can probably disappear or, at the
 195 least, be turned into a boolean (which is how it's used in every other place).