-# $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
+# $Id$
+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');
+
+## cribbed and modified from DBICTest in DBIx::Class tests
+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 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 {
+ open IN, catfile('t', 'sql', 'test.sqlite.sql');
+ 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);
+ };
+};
+
+sub is_uuid {
+ my $value = defined $_[0] ? shift : '';
+
+ return ($value =~ m/ ^[0-9a-f]{8}-
+ [0-9a-f]{4}-
+ [0-9a-f]{4}-
+ [0-9a-f]{4}-
+ [0-9a-f]{12}$
+ /ix);
+};
+
+1;
projects / dbsrgits/DBIx-Class-UUIDColumns.git / blobdiff