dump_test_schema.pl 5.17 KB
Newer Older
1 2
#!/usr/bin/env perl

Magali Ruffier's avatar
Magali Ruffier committed
3
# Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
premanand17's avatar
premanand17 committed
4
# Copyright [2016-2018] EMBL-European Bioinformatics Institute
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

package Bio::EnsEMBL::App::DumpTestSchema;

use 5.010;

use MooseX::App::Simple qw(Color);

24 25 26
use File::Slurp;
use File::Spec;

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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
use Bio::EnsEMBL::Test::MultiTestDB;
use DBIx::Class::Schema::Loader qw(make_schema_at);

option 'test_dir' => (
    is            => 'ro',
    isa           => 'Str',
    default       => sub { $ENV{PWD} },
    cmd_aliases   => [qw/test-dir testdir/],
    documentation => q[Directory containing MultiTestDB.conf],
    );

option 'species' => (
    is            => 'ro',
    isa           => 'Str',
    default       => 'homo_sapiens',
    documentation => q[Species],
    );

option 'db_type' => (
    is            => 'ro',
    isa           => 'Str',
    default       => 'core',
    cmd_aliases   => [qw/db-type dbtype/],
    documentation => q[Database type],
    );

option 'dump_schema' => (
    is            => 'ro',
    isa           => 'Bool',
    cmd_aliases   => [qw/dump-schema dumpschema/],
    documentation => q[Dump DBIC schema],
    );

option 'schema_class' => (
    is            => 'ro',
    isa           => 'Str',
    default       => 'Bio::EnsEMBL::Test::Schema',
    cmd_aliases   => [qw/schema-class schemaclass/],
    documentation => q[Generated schema class],
    );

option 'schema_dir' => (
    is            => 'ro',
    isa           => 'Str',
    default       => sub { $ENV{PWD} },
    cmd_aliases   => [qw/schema-dir schemadir/],
    documentation => q[Directory for schema class dump],
    );

option 'ddl_dir' => (
    is            => 'ro',
    isa           => 'Str',
    default       => sub { $ENV{PWD} },
    cmd_aliases   => [qw/ddl-dir ddldir/],
    documentation => q[Directory for ddl output],
    );

84 85 86 87 88 89 90
option 'version' => (
    is            => 'ro',
    isa           => 'Str',
    default       => '0.1',
    documentation => q[Generated schema version],
    );

91 92 93 94 95
option 'check_driver' => (
    is            => 'ro',
    isa           => 'Str',
    default       => 'mysql',
    cmd_aliases   => [qw/check-driver checkdriver/],
96 97 98 99 100 101 102 103 104
    documentation => q[Expected source DBD driver type],
    );

option 'dump_driver' => (
    is            => 'ro',
    isa           => 'Str',
    default       => 'SQLite',
    cmd_aliases   => [qw/dump-driver dumpdriver/],
    documentation => q[Destination DBD driver type],
105 106 107 108 109 110 111
    );

has 'dbc' => (
    is   => 'rw',
    isa  => 'Bio::EnsEMBL::DBSQL::DBConnection',
    );

112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
has ddl_file => (
    is            => 'ro',
    isa           => 'Str',
    builder       => '_build_ddl_file',
    lazy          => 1,
    );

sub _build_ddl_file {
    my ($self)  = @_;

    my $class_file = $self->schema_class;
    $class_file =~ s/::/-/g;

    my $filename = join('-', $class_file, $self->version, $self->dump_driver);
    $filename .= '.sql';

    return File::Spec->catfile($self->ddl_dir, $filename);
}

131 132 133 134 135 136 137 138 139 140 141 142
sub run {
    my ($self)  = @_;

    my $mdb = $self->get_MultiTestDB;
    my $dbc = $self->dbc($mdb->get_DBAdaptor($self->db_type)->dbc);

    my $driver = $dbc->driver;
    my $check_driver = $self->check_driver;
    die "Driver is '$driver' but expected '$check_driver'" unless $driver eq $check_driver;

    $self->make_schema;
    $self->create_ddl;
143
    $self->patch_ddl;
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158

    return;
}

sub get_MultiTestDB {
    my ($self)  = @_;
    my $mdb = Bio::EnsEMBL::Test::MultiTestDB->new($self->species, $self->test_dir, 1);
    $mdb->load_database($self->db_type);
    $mdb->create_adaptor($self->db_type);
    return $mdb;
}

sub make_schema {
    my ($self) = @_;

159 160 161 162 163
    my $loader_options = {
        naming => 'current',
        col_collision_map => 'column_%s',
    };

164 165 166 167 168 169 170 171
    $loader_options->{dump_directory} = $self->schema_dir if $self->dump_schema;

    make_schema_at($self->schema_class, $loader_options, [ sub { $self->dbc->db_handle } ]);
}

sub create_ddl {
    my ($self) = @_;
    my $schema = $self->connected_schema;
172
    $schema->create_ddl_dir([$self->dump_driver],
173 174 175 176 177 178 179
                            '0.1',
                            $self->ddl_dir,
                            undef,  # pre-version
                            { add_drop_table => 0 },
        );
}

180 181 182 183 184 185 186 187 188
sub patch_ddl {
    my ($self) = @_;
    my $ddl_file = $self->ddl_file;
    my $file = read_file($ddl_file);
    $file =~ s/INTEGER PRIMARY KEY/INTEGER PRIMARY KEY AUTOINCREMENT/g;
    write_file($ddl_file, $file);
    return;
}

189 190
sub connected_schema {
    my ($self) = @_;
Tiago Grego's avatar
Tiago Grego committed
191
    return $self->schema_class->connect;
192 193 194 195 196 197 198 199 200 201 202 203
}

no Moose;

# End of module

package main;

my $result = Bio::EnsEMBL::App::DumpTestSchema->new_with_options->run;
exit ($result ? $result : 0);

# EOF