t/86ss_dbm.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6
   7 use lib qw(t/lib);
   8 use DBICTest;
   9 use DBIC::SqlMakerTest;
  10 use DBIx::Class::Optional::Dependencies ();
  11
  12 use Path::Class;
  13
  14 plan skip_all =>
  15    'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ss_dbm')
  16    unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ss_dbm');
  17
  18 my $db_dir = dir(qw/t var/, "ss_dbm-$$");
  19 $db_dir->mkpath unless -d $db_dir;
  20
  21 my ($dsn, $opts) = ('dbi:DBM:', {
  22    f_dir      => "$db_dir",
  23    f_lockfile => '.lock',
  24
  25    dbm_type   => 'BerkeleyDB',
  26    dbm_mldbm  => 'Storable',
  27    dbm_store_metadata => 1,
  28 });
  29
  30 my $schema = DBICTest::Schema->connect($dsn, '', '', $opts);
  31 is ($schema->storage->sqlt_type, 'DBM', 'sqlt_type correct pre-connection');
  32 isa_ok($schema->storage->sql_maker, 'DBIx::Class::SQLMaker::SQLStatement');
  33
  34 # Custom deployment
  35 my $dbh = $schema->storage->dbh;
  36 my @cmds = split /\s*\;\s*/, scalar file(qw/t lib test_deploy DBICTest-Schema-1.x-SQL-Statement.sql/)->slurp;
  37 $dbh->do($_) for @cmds;
  38
  39 ### S:S doesn't have any sort of AUTOINCREMENT support, so IDs will have to be generated by hand ###
  40
  41 # test primary key handling
  42 my $new = $schema->resultset('Artist')->create({
  43    artistid => 1,
  44    name => 'foo'
  45 });
  46 ok($new->artistid, "Create worked");
  47
  48 # test LIMIT support
  49 for (1..6) {
  50    $schema->resultset('Artist')->create({
  51       artistid => $_+1,
  52       name     => 'Artist '.$_,
  53    });
  54 }
  55 my $it = $schema->resultset('Artist')->search( {}, {
  56    rows   => 3,
  57    offset => 2,
  58    order_by => 'artistid'
  59 });
  60 is( $it->count, 3, "LIMIT count ok" );  # ask for 3 rows out of 7 artists
  61 is( $it->next->name, "Artist 2", "iterator->next ok" );
  62 $it->next;
  63 $it->next;
  64 is( $it->next, undef, "next past end of resultset ok" );
  65
  66 # Limit with select-lock (which is silently thrown away)
  67 lives_ok {
  68    isa_ok (
  69       $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}),
  70       'DBICTest::Schema::Artist',
  71    );
  72 } 'Limited FOR UPDATE select works';
  73
  74 # shared-lock (which is silently thrown away)
  75 lives_ok {
  76    isa_ok (
  77       $schema->resultset('Artist')->find({artistid => 1}, {for => 'shared'}),
  78       'DBICTest::Schema::Artist',
  79    );
  80 } 'LOCK IN SHARE MODE select works';
  81
  82 # (No nullables with DBD::DBM)
  83 my $test_type_info = {
  84    'artistid' => {
  85       'data_type' => 'VARCHAR',
  86       'is_nullable' => 0,
  87       'size' => 0,
  88    },
  89    'name' => {
  90       'data_type' => 'VARCHAR',
  91       'is_nullable' => 0,
  92       'size' => 100,
  93    },
  94    'rank' => {
  95       'data_type' => 'VARCHAR',
  96       'is_nullable' => 0,
  97       'size' => 0,
  98    },
  99    'charfield' => {
 100       'data_type' => 'VARCHAR',
 101       'is_nullable' => 0,
 102       'size' => 10,
 103    },
 104 };
 105
 106 $schema->populate ('Owners', [
 107    [qw/id  name  /],
 108    [qw/1   wiggle/],
 109    [qw/2   woggle/],
 110    [qw/3   boggle/],
 111 ]);
 112
 113 $schema->populate ('BooksInLibrary', [
 114    [qw/id source  owner title   /],
 115    [qw/1  Library 1     secrets1/],
 116    [qw/2  Eatery  1     secrets2/],
 117    [qw/3  Library 2     secrets3/],
 118 ]);
 119
 120 {
 121    # try a ->has_many direction (due to a 'multi' accessor the select/group_by group is collapsed)
 122    my $owners = $schema->resultset('Owners')->search(
 123       { 'books.id' => { '!=', undef }},
 124       { prefetch => 'books', cache => 1 }
 125    );
 126    is($owners->all, 2, 'Prefetched grouped search returns correct number of rows');
 127
 128    # only works here because of the full cache
 129    # S:S would croak on a subselect otherwise
 130    is($owners->count, 2, 'Prefetched grouped search returns correct count');
 131
 132    # try a ->belongs_to direction (no select collapse)
 133    my $books = $schema->resultset('BooksInLibrary')->search (
 134       { 'owner.name' => 'wiggle' },
 135       { prefetch => 'owner', distinct => 1 }
 136    );
 137
 138    {
 139       local $TODO = 'populate does not subtract the non-Library INSERTs here...';
 140       is($owners->all, 1, 'Prefetched grouped search returns correct number of rows');
 141       is($owners->count, 1, 'Prefetched grouped search returns correct count');
 142    }
 143 }
 144
 145 my $type_info = $schema->storage->columns_info_for('artist');
 146 is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
 147
 148 my $cd = $schema->resultset('CD')->create({ cdid => 1 });
 149 my $producer = $schema->resultset('Producer')->create({ producerid => 1 });
 150 lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';
 151
 152 {
 153    my $artist = $schema->resultset('Artist')->next;
 154    my $cd = $schema->resultset('CD')->next;
 155    $cd->set_from_related('artist', $artist);
 156    $cd->update;
 157
 158    my $rs = $schema->resultset('CD')->search ({}, { prefetch => 'artist' });
 159
 160    lives_ok sub {
 161       my $cd = $rs->next;
 162       is ($cd->artist->name, $artist->name, 'Prefetched artist');
 163    }, 'join does not throw';
 164
 165    local $schema->storage->sql_maker->{_default_jointype} = 'inner';
 166    is_same_sql_bind (
 167       $rs->as_query,
 168       '(
 169          SELECT
 170             me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
 171             artist.artistid, artist.name, artist.rank, artist.charfield
 172          FROM cd me
 173          INNER JOIN artist artist ON artist.artistid = me.artist
 174       )',
 175       [],
 176       'overriden default join type works',
 177    );
 178 }
 179
 180 {
 181    # Test support for straight joins
 182    my $cdsrc = $schema->source('CD');
 183    my $artrel_info = $cdsrc->relationship_info ('artist');
 184    $cdsrc->add_relationship(
 185       'straight_artist',
 186       $artrel_info->{class},
 187       $artrel_info->{cond},
 188       { %{$artrel_info->{attrs}}, join_type => 'straight' },
 189    );
 190    is_same_sql_bind (
 191       $cdsrc->resultset->search({}, { prefetch => 'straight_artist' })->as_query,
 192       '(
 193          SELECT
 194             me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
 195             straight_artist.artistid, straight_artist.name, straight_artist.rank, straight_artist.charfield
 196          FROM cd me
 197          STRAIGHT JOIN artist straight_artist ON straight_artist.artistid = me.artist
 198       )',
 199       [],
 200       'straight joins correctly supported'
 201    );
 202 }
 203
 204 # Can we properly deal with the null search problem?
 205 {
 206    $schema->resultset('Artist')->create({ artistid => 2222, name => 'last created artist' });
 207
 208    ok my $artist1_rs = $schema->resultset('Artist')->search({artistid=>6666})
 209      => 'Created an artist resultset of 6666';
 210
 211    is $artist1_rs->count, 0
 212      => 'Got no returned rows';
 213
 214    ok my $artist2_rs = $schema->resultset('Artist')->search({artistid=>undef})
 215      => 'Created an artist resultset of undef';
 216
 217    is $artist2_rs->count, 0
 218      => 'got no rows';
 219
 220    my $artist = $artist2_rs->single;
 221
 222    is $artist => undef
 223      => 'Nothing Found!';
 224 }
 225
 226 {
 227    my $cds_per_year = {
 228       2001 => 2,
 229       2002 => 1,
 230       2005 => 3,
 231    };
 232
 233    # kill the scalar ref here
 234    $schema->source('CD')->name('cd');
 235
 236    my $rs = $schema->resultset('CD');
 237    $rs->delete;
 238    my $cdid = 1;
 239    foreach my $y (keys %$cds_per_year) {
 240       foreach my $c (1 .. $cds_per_year->{$y} ) {
 241          $rs->create({ cdid => $cdid++, title => "CD $y-$c", artist => 1, year => "$y-01-01" });
 242       }
 243    }
 244
 245    is ($rs->count, 6, 'CDs created successfully');
 246 }
 247
 248 done_testing;