File Coverage

blib/lib/DBIx/Skinny/Schema/Loader.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package DBIx::Skinny::Schema::Loader;
use strict;
use warnings;

our $VERSION = '0.25';

use Carp;
use DBI;
use DBIx::Skinny::Schema;

sub import {
    my ($class, @args) = @_;
    my $caller = caller;

    my @functions = qw(
    make_schema_at
    );

    for my $func ( @args ) {
        if ( grep { $func } @functions ) {
            no strict 'refs';
            *{"$caller\::$func"} = \&$func;
        }
    }
}

sub new {
    my ($class) = @_;
    bless {}, $class;
}

sub supported_drivers {
    qw(
        SQLite
        mysql
        Pg
    );
}

sub connect {
    my $self = shift;
    return if defined $self->{ impl };

    my $opts;
    if (@_ == 1) {
        $opts = +{
            dsn             => $_[0]->{dsn}             || '',
            user            => $_[0]->{username}        || '',
            pass            => $_[0]->{password}        || '',
            connect_options => $_[0]->{connect_options} || {},
        };
    } else {
        my ($dsn, $user, $pass, $connect_options) = @_;
        $opts = {
            dsn             => $dsn             || '',
            user            => $user            || '',
            pass            => $pass            || '',
            connect_options => $connect_options || {},
        };
    }
    $opts->{dsn} =~ /^dbi:([^:]+):/i;
    my $driver = $1 or croak "Could not parse DSN";
    croak "$driver is not supported by DBIx::Skinny::Schema::Loader yet"
        unless grep { /^$driver$/ } $self->supported_drivers;
    my $impl = __PACKAGE__ . "::DBI::$driver";
    eval "use $impl"; ## no critic
    die $@ if $@;
    $self->{ impl } = $impl->new($opts);
}

sub load_schema {
    my ($class, $connect_info) = @_;
    my $self = $class->new;
    $connect_info ||= $class->_get_skinny_connect_info;
    $self->connect(
        $connect_info->{ dsn },
        $connect_info->{ username },
        $connect_info->{ password },
        $connect_info->{ connect_options },
    );

    my $schema = $class->schema_info;
    for my $table ( @{ $self->{ impl }->tables } ) {
        my $pk = $self->{ impl }->table_pk($table);
        $schema->{ $table }->{ pk } = $pk if $pk;
        $schema->{ $table }->{ columns } = $self->{ impl }->table_columns($table);
        $schema->{ $table }->{ row_class } = DBIx::Skinny::Util::mk_row_class($class, $table);
    }
    return $self;
}

sub _get_skinny_connect_info {
    my $class = shift;
    $class = ref $class || $class;
    (my $skinny_class = $class) =~ s/::Schema//;
    return $skinny_class->connect_info;
}

sub make_schema_at {
    my $self = (ref $_[0] eq 'DBIx::Skinny::Schema::Loader') ? shift : __PACKAGE__->new;
    my ($schema_class, $options, $connect_info) = @_;

    $self->connect(ref $connect_info eq 'HASH' ? $connect_info : @{ $connect_info });

    my $schema = $self->_insert_header;
    $schema .= "package $schema_class;\nuse DBIx::Skinny::Schema;\n\n";

    $schema .= $self->_insert_template($options->{ before_template });
    $schema .= $self->_insert_template($options->{ template });

    for my $table ( @{ $self->_get_tables($options->{ ignore_rules }) } ) {
        my $pk = $self->{ impl }->table_pk($table);
        $schema .= $self->_make_install_table_text(
            {
                table   => $table,
                pk      => ref $pk ? $pk : [ $pk ],
                columns => $self->{ impl }->table_columns($table),
            },
            $options->{ table_template }
        );
    }

    $schema .= $self->_insert_template($options->{ after_template });

    $schema .= "1;";
    return $schema;
}

sub _insert_header {
    "# THIS FILE IS AUTOGENERATED BY DBIx::Skinny::Schema::Loader $VERSION, DO NOT EDIT DIRECTLY.\n\n";
}

sub _insert_template {
    my ($self, $template) = @_;
    return '' unless $template;
    chomp $template;

    "# ---- beginning of custom template ----\n" .
    $template . "\n" .
    "# ---- end of custom template ----\n\n";
}

sub _make_install_table_text {
    my ($self, $params, $template) = @_;
    my $table   = $params->{ table };
    my $pk      = join " ", @{ $params->{ pk    }   };
    my $columns = join " ", @{ $params->{ columns } };
    unless ($template) {
        $template  = "install_table [% table %] => schema {\n";
        $template .= "    pk qw/[% pk %]/;\n" if $pk;
        $template .= "    columns qw/[% columns %]/;\n};\n\n";
    }

    $template =~ s/\[% table %\]/$table/g;
    $template =~ s/\[% pk %\]/$pk/g;
    $template =~ s/\[% columns %\]/$columns/g;
    return $template;
}

sub _get_tables {
    my ($self, $ignore_rules) = @_;
    my @tables;
    for my $table ( @{ $self->{ impl }->tables } ) {
        my $ignore;
        for my $rule ( @$ignore_rules ) {
            $ignore++ and last if $table =~ $rule;
        }
        push @tables, $table unless $ignore;
    }
    return \@tables;
}

1;
__END__