[Bast-commits] r9359 - DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Wed May 12 14:17:14 GMT 2010


Author: ribasushi
Date: 2010-05-12 15:17:14 +0100 (Wed, 12 May 2010)
New Revision: 9359

Added:
   DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib/DBICTest.pm
   DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib/sqlite.sql
Log:
Changes from former trunk (oops)

Added: DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib/DBICTest.pm	                        (rev 0)
+++ DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib/DBICTest.pm	2010-05-12 14:17:14 UTC (rev 9359)
@@ -0,0 +1,71 @@
+package    # hide from PAUSE
+    DBICTest;
+
+use strict;
+use warnings;
+use TestSchema;
+
+=head1 NAME
+
+DBICTest - Minimal version of DBICTest from the DBIx::Class dist 
+
+=head1 SYNOPSIS
+
+  use lib qw(t/lib);
+  use DBICTest;
+  use Test::More;
+  
+  my $schema = DBICTest->init_schema();
+
+=head1 DESCRIPTION
+
+This module provides the basic utilities to write tests against 
+DBIx::Class.
+
+=head1 METHODS
+
+=head2 init_schema
+
+  my $schema = DBICTest->init_schema;
+
+=cut
+
+sub _connect_info {
+    my $self    = shift;
+    my $db_file = ':memory:';
+
+    my $dsn    = "dbi:SQLite:${db_file}";
+    my $dbuser = '';
+    my $dbpass = '';
+
+    my @connect_info = ( $dsn, $dbuser, $dbpass );
+
+    return @connect_info;
+}
+
+sub init_schema {
+    my $self = shift;
+
+    my $schema = TestSchema->connect( $self->_connect_info );
+    $self->deploy_schema($schema);
+    return $schema;
+}
+
+sub deploy_schema {
+    my $self   = shift;
+    my $schema = shift;
+
+    open IN, "t/lib/sqlite.sql";
+    my $sql;
+    { local $/ = undef; $sql = <IN>; }
+    close IN;
+    for my $chunk ( split( /;\s*\n+/, $sql ) ) {
+        if ( $chunk =~ / ^ (?! --\s* ) \S /xm )
+        { # there is some real sql in the chunk - a non-space at the start of the string which is not a comment
+            $schema->storage->dbh_do( sub { $_[1]->do($chunk) } ) || warn "Error executing SQL. chunk: $chunk";
+        }
+    }
+    return;
+}
+
+1;

Added: DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib/sqlite.sql
===================================================================
--- DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib/sqlite.sql	                        (rev 0)
+++ DBIx-Class-DynamicDefault/1.000/branches/post-03_gshank_no_sqlt_dep/t/lib/sqlite.sql	2010-05-12 14:17:14 UTC (rev 9359)
@@ -0,0 +1,31 @@
+-- 
+-- Created by SQL::Translator::Producer::SQLite
+-- Created on Wed Nov 11 12:27:59 2009
+-- 
+
+
+BEGIN TRANSACTION;
+
+--
+-- Table: affe
+--
+
+CREATE TABLE affe (
+  moo INTEGER PRIMARY KEY NOT NULL,
+  kooh text NOT NULL,
+  baz integer NOT NULL,
+  bar integer NOT NULL
+);
+
+--
+-- Table: fubar
+--
+
+CREATE TABLE fubar (
+  quux INTEGER PRIMARY KEY NOT NULL,
+  garply integer,
+  foo integer NOT NULL,
+  fred text NOT NULL
+);
+
+COMMIT;




More information about the Bast-commits mailing list