RT#22364 (ASH) hopefully fixed with updated prereq

[dbsrgits/DBIx-Class-UUIDColumns.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..6f254a3
--- /dev/null
+++ b/t/lib/DBIC/Test.pm
@@ -0,0 +1,112 @@
+# $Id: Test.pm 3236 2007-05-05 16:24:35Z claco $\r
+package DBIC::Test;\r
+use strict;\r
+use warnings;\r
+\r
+BEGIN {\r
+    # little trick by Ovid to pretend to subclass+exporter Test::More\r
+    use base qw/Test::Builder::Module Class::Accessor::Grouped/;\r
+    use Test::More;\r
+    use File::Spec::Functions qw/catfile catdir/;\r
+\r
+    @DBIC::Test::EXPORT = @Test::More::EXPORT;\r
+\r
+    __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/);\r
+};\r
+\r
+__PACKAGE__->db_dir(catdir('t', 'var'));\r
+__PACKAGE__->db_file('test.db');\r
+\r
+## cribbed and modified from DBICTest in DBIx::Class tests\r
+sub init_schema {\r
+    my ($self, %args) = @_;\r
+    my $db_dir  = $args{'db_dir'}  || $self->db_dir;\r
+    my $db_file = $args{'db_file'} || $self->db_file;\r
+    my $namespace = $args{'namespace'} || 'DBIC::TestSchema';\r
+    my $db = catfile($db_dir, $db_file);\r
+\r
+    eval 'use DBD::SQLite';\r
+    if ($@) {\r
+       BAIL_OUT('DBD::SQLite not installed');\r
+\r
+        return;\r
+    };\r
+\r
+    eval 'use DBIC::Test::Schema';\r
+    if ($@) {\r
+        BAIL_OUT("Could not load DBIC::Test::Schema: $@");\r
+\r
+        return;\r
+    };\r
+\r
+    unlink($db) if -e $db;\r
+    unlink($db . '-journal') if -e $db . '-journal';\r
+    mkdir($db_dir) unless -d $db_dir;\r
+\r
+    my $dsn = 'dbi:SQLite:' . $db;\r
+    my $schema = DBIC::Test::Schema->compose_namespace($namespace)->connect($dsn);\r
+    $schema->storage->on_connect_do([\r
+        'PRAGMA synchronous = OFF',\r
+        'PRAGMA temp_store = MEMORY'\r
+    ]);\r
+\r
+    __PACKAGE__->deploy_schema($schema, %args);\r
+    __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'};\r
+\r
+    return $schema;\r
+};\r
+\r
+sub deploy_schema {\r
+    my ($self, $schema, %options) = @_;\r
+    my $eval = $options{'eval_deploy'};\r
+\r
+    eval 'use SQL::Translator';\r
+    if (!$@ && !$options{'no_deploy'}) {\r
+        eval {\r
+            $schema->deploy();\r
+        };\r
+        if ($@ && !$eval) {\r
+            die $@;\r
+        };\r
+    } else {\r
+        open IN, catfile('t', 'sql', 'test.sqlite.sql');\r
+        my $sql;\r
+        { local $/ = undef; $sql = <IN>; }\r
+        close IN;\r
+        eval {\r
+            ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n") for split(/;\n/, $sql);\r
+        };\r
+        if ($@ && !$eval) {\r
+            die $@;\r
+        };\r
+    };\r
+};\r
+\r
+sub clear_schema {\r
+    my ($self, $schema, %options) = @_;\r
+\r
+    foreach my $source ($schema->sources) {\r
+        $schema->resultset($source)->delete_all;\r
+    };\r
+};\r
+\r
+sub populate_schema {\r
+    my ($self, $schema, %options) = @_;\r
+    \r
+    if ($options{'clear'}) {\r
+        $self->clear_schema($schema, %options);\r
+    };\r
+};\r
+\r
+sub is_uuid {\r
+    my $value = defined $_[0] ? shift : '';\r
+\r
+    return ($value =~ m/  ^[0-9a-f]{8}-\r
+                           [0-9a-f]{4}-\r
+                           [0-9a-f]{4}-\r
+                           [0-9a-f]{4}-\r
+                           [0-9a-f]{12}$\r
+                      /ix);\r
+};\r
+\r
+1;\r