2nd Pass

[dbsrgits/DBIx-Class.git] / t / 86ss_dbm.t

use strict;
use warnings;

use Test::More;
use Test::Exception;

use lib qw(t/lib);
use DBICTest;
use DBIC::SqlMakerTest;
use DBIx::Class::Optional::Dependencies ();

use Path::Class;

plan skip_all =>
   'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ss_dbm')
   unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ss_dbm');

my $db_dir = dir(qw/t var/, "ss_dbm-$$");
$db_dir->mkpath unless -d $db_dir;

my ($dsn, $opts) = ('dbi:DBM:', {
   f_dir      => "$db_dir",
   f_lockfile => '.lock',

   dbm_type   => 'BerkeleyDB',
   dbm_mldbm  => 'Storable',
   dbm_store_metadata => 1,
});

my $schema = DBICTest::Schema->connect($dsn, '', '', $opts);
is ($schema->storage->sqlt_type, 'DBM', 'sqlt_type correct pre-connection');
isa_ok($schema->storage->sql_maker, 'DBIx::Class::SQLMaker::SQLStatement');

# Custom deployment
my $dbh = $schema->storage->dbh;
my @cmds = split /\s*\;\s*/, scalar file(qw/t lib dbdfile.sql/)->slurp;
$dbh->do($_) for @cmds;

### S:S doesn't have any sort of AUTOINCREMENT support, so IDs will have to be generated by hand ###

# test primary key handling
my $new = $schema->resultset('Artist')->create({
   artistid => 1,
   name => 'foo'
});
ok($new->artistid, "Create worked");

# test LIMIT support
for (1..6) {
   $schema->resultset('Artist')->create({
      artistid => $_+1,
      name     => 'Artist '.$_,
   });
}
my $it = $schema->resultset('Artist')->search( {}, {
   rows   => 3,
   offset => 2,
   order_by => 'artistid'
});
is( $it->count, 3, "LIMIT count ok" );  # ask for 3 rows out of 7 artists
is( $it->next->name, "Artist 2", "iterator->next ok" );
$it->next;
$it->next;
is( $it->next, undef, "next past end of resultset ok" );

# Limit with select-lock (which is silently thrown away)
lives_ok {
   isa_ok (
      $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}),
      'DBICTest::Schema::Artist',
   );
} 'Limited FOR UPDATE select works';

# shared-lock (which is silently thrown away)
lives_ok {
   isa_ok (
      $schema->resultset('Artist')->find({artistid => 1}, {for => 'shared'}),
      'DBICTest::Schema::Artist',
   );
} 'LOCK IN SHARE MODE select works';

# (No nullables with DBD::DBM)
my $test_type_info = {
   'artistid' => {
      'data_type' => 'VARCHAR',
      'is_nullable' => 0,
      'size' => 0,
   },
   'name' => {
      'data_type' => 'VARCHAR',
      'is_nullable' => 0,
      'size' => 100,
   },
   'rank' => {
      'data_type' => 'VARCHAR',
      'is_nullable' => 0,
      'size' => 0,
   },
   'charfield' => {
      'data_type' => 'VARCHAR',
      'is_nullable' => 0,
      'size' => 10,
   },
};

$ENV{DBIC_DBDFILE_TXN_NOWARN} = 1;

$schema->populate ('Owners', [
   [qw/id  name  /],
   [qw/1   wiggle/],
   [qw/2   woggle/],
   [qw/3   boggle/],
]);

$schema->populate ('BooksInLibrary', [
   [qw/id source  owner title   /],
   [qw/1  Library 1     secrets1/],
   [qw/2  Eatery  1     secrets2/],
   [qw/3  Library 2     secrets3/],
]);

{
   # try a ->has_many direction (due to a 'multi' accessor the select/group_by group is collapsed)
   my $owners = $schema->resultset('Owners')->search(
      { 'books.id' => { '!=', undef }},
      { prefetch => 'books', cache => 1 }
   );
   is($owners->all, 2, 'Prefetched grouped search returns correct number of rows');

   # only works here because of the full cache
   # S:S would croak on a subselect otherwise
   is($owners->count, 2, 'Prefetched grouped search returns correct count');

   # try a ->belongs_to direction (no select collapse)
   my $books = $schema->resultset('BooksInLibrary')->search (
      { 'owner.name' => 'wiggle' },
      { prefetch => 'owner', distinct => 1 }
   );

   {
      local $TODO = 'populate does not subtract the non-Library INSERTs here...';
      is($owners->all, 1, 'Prefetched grouped search returns correct number of rows');
      is($owners->count, 1, 'Prefetched grouped search returns correct count');
   }
}

my $type_info = $schema->storage->columns_info_for('artist');
is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');

my $cd = $schema->resultset('CD')->create({ cdid => 1 });
my $producer = $schema->resultset('Producer')->create({ producerid => 1 });
lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';

{
   my $artist = $schema->resultset('Artist')->next;
   my $cd = $schema->resultset('CD')->next;
   $cd->set_from_related('artist', $artist);
   $cd->update;

   my $rs = $schema->resultset('CD')->search ({}, { prefetch => 'artist' });

   lives_ok sub {
      my $cd = $rs->next;
      is ($cd->artist->name, $artist->name, 'Prefetched artist');
   }, 'join does not throw';

   local $schema->storage->sql_maker->{_default_jointype} = 'inner';
   is_same_sql_bind (
      $rs->as_query,
      '(
         SELECT
            me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
            artist.artistid, artist.name, artist.rank, artist.charfield
         FROM cd me
         INNER JOIN artist artist ON artist.artistid = me.artist
      )',
      [],
      'overriden default join type works',
   );
}

{
   # Test support for straight joins
   my $cdsrc = $schema->source('CD');
   my $artrel_info = $cdsrc->relationship_info ('artist');
   $cdsrc->add_relationship(
      'straight_artist',
      $artrel_info->{class},
      $artrel_info->{cond},
      { %{$artrel_info->{attrs}}, join_type => 'straight' },
   );
   is_same_sql_bind (
      $cdsrc->resultset->search({}, { prefetch => 'straight_artist' })->as_query,
      '(
         SELECT
            me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
            straight_artist.artistid, straight_artist.name, straight_artist.rank, straight_artist.charfield
         FROM cd me
         STRAIGHT JOIN artist straight_artist ON straight_artist.artistid = me.artist
      )',
      [],
      'straight joins correctly supported'
   );
}

# Can we properly deal with the null search problem?
{
   $schema->resultset('Artist')->create({ artistid => 2222, name => 'last created artist' });

   ok my $artist1_rs = $schema->resultset('Artist')->search({artistid=>6666})
     => 'Created an artist resultset of 6666';

   is $artist1_rs->count, 0
     => 'Got no returned rows';

   ok my $artist2_rs = $schema->resultset('Artist')->search({artistid=>undef})
     => 'Created an artist resultset of undef';

   is $artist2_rs->count, 0
     => 'got no rows';

   my $artist = $artist2_rs->single;

   is $artist => undef
     => 'Nothing Found!';
}

{
   my $cds_per_year = {
      2001 => 2,
      2002 => 1,
      2005 => 3,
   };

   # kill the scalar ref here
   $schema->source('CD')->name('cd');

   my $rs = $schema->resultset('CD');
   $rs->delete;
   my $cdid = 1;
   foreach my $y (keys %$cds_per_year) {
      foreach my $c (1 .. $cds_per_year->{$y} ) {
         $rs->create({ cdid => $cdid++, title => "CD $y-$c", artist => 1, year => "$y-01-01" });
      }
   }

   is ($rs->count, 6, 'CDs created successfully');
}

done_testing;