initial checkin for UserStamp

[dbsrgits/DBIx-Class-UserStamp.git] / t / lib / DBIC / Test.pm

diff --git a/t/lib/DBIC/Test.pm b/t/lib/DBIC/Test.pm
new file mode 100644 (file)
index 0000000..b568643
--- /dev/null
+++ b/t/lib/DBIC/Test.pm
@@ -0,0 +1,109 @@
+package #
+    DBIC::Test;
+
+use strict;
+use warnings;
+
+BEGIN {
+    # little trick by Ovid to pretend to subclass+exporter Test::More
+    use base qw/Test::Builder::Module Class::Accessor::Grouped/;
+    use Test::More;
+    use File::Spec::Functions qw/catfile catdir/;
+    
+    @DBIC::Test::EXPORT = @Test::More::EXPORT;
+   
+    __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/);
+};
+
+__PACKAGE__->db_dir(catdir('t', 'var'));
+__PACKAGE__->db_file('test.db');
+
+sub init_schema {
+    my ( $self, %args ) = @_;
+
+    my $db_dir  = $args{'db_dir'}  || $self->db_dir;
+    my $db_file = $args{'db_file'} || $self->db_file;
+
+    my $namespace = $args{'namespace'} || 'DBIC::TestSchema';
+    my $db = catfile($db_dir, $db_file);
+
+    eval 'use DBD::SQLite';
+    if ( $@ ) {
+        BAIL_OUT('DBD::SQLite not installed');
+        return;
+    }
+
+    eval 'use DBIC::Test::Schema';
+    if ( $@ ) {
+        BAIL_OUT("Could not load test schema DBIC::Test::Schema: $@");
+        return;
+    }
+    
+    unlink($db) if -e $db;
+    unlink($db . '-journal') if -e $db . '-journal';
+    mkdir($db_dir) unless -d $db_dir;
+
+    my $dsn = 'dbi:SQLite:' . $db;
+    my $schema = DBIC::Test::Schema
+        ->compose_namespace($namespace)->connect($dsn);
+    $schema->storage->on_connect_do([
+        'PRAGMA synchronous = OFF',
+        'PRAGMA temp_store = MEMORY'
+    ]);
+
+    __PACKAGE__->deploy_schema($schema, %args);
+    __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'};
+
+    return $schema;
+}
+
+sub deploy_schema {
+    my ( $self, $schema, %options ) = @_;
+    my $eval = $options{'eval_deploy'};
+
+    eval 'use SQL::Translator';
+
+    if ( !$@ && !$options{'no_deploy'} ) {
+        eval {
+            $schema->deploy();
+        };
+        if ( $@ && !$eval ) {
+            die $@;
+        }
+    } else {
+        unless ( open(IN, catfile('t', 'sql', 'test.sqlite.sql') ) ) {
+            BAIL_OUT("Can't load schema, sorry: $!");
+            return;
+        }
+        my $sql;
+        { local $/ = undef; $sql = <IN>; }
+        close IN;
+        eval {
+            ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n")
+                for split(/;\n/, $sql);
+        };
+        if ( $@ && !$eval ) {
+            die $@;
+        }
+    }
+
+}
+
+sub clear_schema {
+    my ( $self, $schema, %options ) = @_;
+
+    foreach my $source ( $schema->sources ) {
+        $schema->resultset($source)->delete_all;
+    }
+}
+
+sub populate_schema {
+    my ( $self, $schema, %options ) = @_;
+
+    if ( $options{'clear'} ) {
+        $self->clear_schema($schema, %options);
+    }
+    # We don't need any data, but if we did, put it here.
+}
+
+1;