view release on metacpan or  search on metacpan

t/01-dbix-simple-class-schema-sqlite.t  view on Meta::CPAN

#!perl
use 5.10.1;
use strict;
use warnings;
use utf8;
use Test::More;

BEGIN {
  eval { require DBD::SQLite; 1 }
    or plan skip_all => 'DBD::SQLite required';
  eval { DBD::SQLite->VERSION >= 1 }
    or plan skip_all => 'DBD::SQLite >= 1.00 required';
  use File::Basename 'dirname';
  use Cwd;
  use lib (Cwd::abs_path(dirname(__FILE__) . '/..') . '/examples/lib');
}


use DBI::Const::GetInfoType;
use Data::Dumper;

#Suppress some warnings from DBIx::Simple::Class during tests.
local $SIG{__WARN__} = sub {
  if (
    $_[0] =~ /(Will\sdump\sschema\sat
         |exists
         |avoid\snamespace\scollisions
         |\w+\.pm|make\spath
         |Overwriting)/x
    )
  {
    my ($package, $filename, $line, $subroutine) = caller(2);
    ok($_[0], ($subroutine || '') . " warns '$1' OK");
  }
  else {
    warn $_[0];
  }
};

use DBIx::Simple::Class::Schema;

my $DSCS = 'DBIx::Simple::Class::Schema';
my $dbix = DBIx::Simple->connect('dbi:SQLite:dbname=:memory:', {sqlite_unicode => 1});
$dbix->dbh->do('PRAGMA foreign_keys = ON');
isa_ok(ref($DSCS->dbix($dbix)), 'DBIx::Simple');
can_ok($DSCS, qw(load_schema dump_schema_at));


$dbix->query(<<'TAB');
CREATE TABLE groups(
  id INTEGER PRIMARY KEY AUTOINCREMENT,
  group_name VARCHAR(12),
  "is blocked" INT,
  data TEXT
  )
TAB

#=pod
#create some tables
$dbix->query(<<'TAB');
CREATE TABLE IF NOT EXISTS users (
  id INTEGER PRIMARY KEY AUTOINCREMENT,
  group_id int(11) NOT NULL, -- COMMENT 'Primary group for this user'
  login_name varchar(100) NOT NULL,
  login_password varchar(100) NOT NULL, -- COMMENT 'Mojo::Util::md5_sum($login_name.$login_password)'
  name varchar(255) NOT NULL DEFAULT '',
  email varchar(255) NOT NULL DEFAULT 'email@domain.com',
  disabled tinyint(1) NOT NULL DEFAULT '0',
  balance DECIMAL(8,2) NOT NULL DEFAULT '0.00',
  dummy_dec DECIMAL(8,0) NOT NULL DEFAULT '0',
  nullable_column TEXT DEFAULT NULL,
  UNIQUE(login_name) ON CONFLICT ROLLBACK,
  UNIQUE(email) ON CONFLICT ROLLBACK,
  FOREIGN KEY(group_id) REFERENCES groups(id)

)
TAB

#=cut

#BARE DEFAULTS
like(
  (eval { $DSCS->dump_schema_at() }, $@),
  qr/Please first call/,
  'dump_schema_at() croaks OK'
);
require File::Path;
File::Path::remove_tree($INC[0] . '/DSCS/Memory');
unlink($INC[0] . '/DSCS/Memory.pm');
File::Path::remove_tree($INC[0] . '/Your');

ok(my $code = $DSCS->load_schema(), 'scalar context OK');
ok(my @code = $DSCS->load_schema(), 'list context OK');

my $tables = $DSCS->_schemas('DSCS::Memory')->{tables};

#warn Dumper($tables);

ok((grep { $_->{TABLE_NAME} eq 'users' || $_->{TABLE_NAME} eq 'groups' } @$tables),
  '_get_table_info works');
my @column_infos;
foreach (@$tables) {
  push @column_infos, @{$_->{column_info}};