t/lib/DBIC/Test.pm

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