t/lib/DBIC/Test.pm

   1 package #
   2     DBIC::Test;
   3
   4 use strict;
   5 use warnings;
   6
   7 BEGIN {
   8     # little trick by Ovid to pretend to subclass+exporter Test::More
   9     use base qw/Test::Builder::Module Class::Accessor::Grouped/;
  10     use Test::More;
  11     use File::Spec::Functions qw/catfile catdir/;
  12
  13     @DBIC::Test::EXPORT = @Test::More::EXPORT;
  14
  15     __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/);
  16 };
  17
  18 __PACKAGE__->db_dir(catdir('t', 'var'));
  19 __PACKAGE__->db_file('test.db');
  20
  21 sub init_schema {
  22     my ( $self, %args ) = @_;
  23
  24     my $db_dir  = $args{'db_dir'}  || $self->db_dir;
  25     my $db_file = $args{'db_file'} || $self->db_file;
  26
  27     my $namespace = $args{'namespace'} || 'DBIC::TestSchema';
  28     my $db = catfile($db_dir, $db_file);
  29
  30     eval 'use DBD::SQLite';
  31     if ( $@ ) {
  32         BAIL_OUT('DBD::SQLite not installed');
  33         return;
  34     }
  35
  36     eval 'use DBIC::Test::Schema';
  37     if ( $@ ) {
  38         BAIL_OUT("Could not load test schema DBIC::Test::Schema: $@");
  39         return;
  40     }
  41
  42     unlink($db) if -e $db;
  43     unlink($db . '-journal') if -e $db . '-journal';
  44     mkdir($db_dir) unless -d $db_dir;
  45
  46     my $dsn = 'dbi:SQLite:' . $db;
  47     my $schema = DBIC::Test::Schema
  48         ->compose_namespace($namespace)->connect($dsn);
  49     $schema->storage->on_connect_do([
  50         'PRAGMA synchronous = OFF',
  51         'PRAGMA temp_store = MEMORY'
  52     ]);
  53
  54     __PACKAGE__->deploy_schema($schema, %args);
  55     __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'};
  56
  57     return $schema;
  58 }
  59
  60 sub deploy_schema {
  61     my ( $self, $schema, %options ) = @_;
  62     my $eval = $options{'eval_deploy'};
  63
  64     eval 'use SQL::Translator';
  65
  66     if ( !$@ && !$options{'no_deploy'} ) {
  67         eval {
  68             $schema->deploy();
  69         };
  70         if ( $@ && !$eval ) {
  71             die $@;
  72         }
  73     } else {
  74         unless ( open(IN, catfile('t', 'sql', 'test.sqlite.sql') ) ) {
  75             BAIL_OUT("Can't load schema, sorry: $!");
  76             return;
  77         }
  78         my $sql;
  79         { local $/ = undef; $sql = <IN>; }
  80         close IN;
  81         eval {
  82             ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n")
  83                 for split(/;\n/, $sql);
  84         };
  85         if ( $@ && !$eval ) {
  86             die $@;
  87         }
  88     }
  89
  90 }
  91
  92 sub clear_schema {
  93     my ( $self, $schema, %options ) = @_;
  94
  95     foreach my $source ( $schema->sources ) {
  96         $schema->resultset($source)->delete_all;
  97     }
  98 }
  99
 100 sub populate_schema {
 101     my ( $self, $schema, %options ) = @_;
 102
 103     if ( $options{'clear'} ) {
 104         $self->clear_schema($schema, %options);
 105     }
 106     # We don't need any data, but if we did, put it here.
 107 }
 108
 109 1;