File: OLTest.pm

package info (click to toggle)
libdbix-class-optimisticlocking-perl 0.02-6
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 220 kB
  • sloc: perl: 270; sql: 51; makefile: 2
file content (55 lines) | stat: -rw-r--r-- 1,354 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
package # hide from PAUSE
	OLTest;

use strict;
use warnings;

use File::Spec;
use Cwd qw(abs_path);

my ($vol, $dir, $file) = File::Spec->splitpath(abs_path(__FILE__));

# much of this is ripped directly from DBIx::Class::VirtualColumns (thanks for the jumpstart!)
sub init_schema {
    my $self = shift;
    my %args = @_;

    my $schema;

    if ( $args{compose_connection} ) {
        $schema =
          OLTest::Schema->compose_connection( 'OLTest',
            "dbi:SQLite:$dir/../var/oltest.db", "", "", { AutoCommit => 1 } );
    }
    else {
        $schema = OLTest::Schema->compose_namespace('OLTest');
    }
    if ( !$args{no_connect} ) {
        $schema =
          $schema->connect( "dbi:SQLite:$dir/../var/oltest.db", "", "", { AutoCommit => 1 } );
        $schema->storage->on_connect_do( ['PRAGMA synchronous = OFF'] );
    }
    unless ( $args{no_deploy} ) {
        __PACKAGE__->deploy_schema($schema);
    }
    return $schema;
}

sub deploy_schema {
    my $self   = shift;
    my $schema = shift;

    if ( $ENV{"OLTEST_SQLT_DEPLOY"} ) {
        return $schema->deploy();
    }
    else {
        open IN, "$dir/../var/oltest.sql";
        my $sql;
        { local $/ = undef; $sql = <IN>; }
        close IN;
        ( $schema->storage->dbh->do($_) || print "Error on SQL: $_\n" )
          for split( /;\n/, $sql );
    }
}

1;