view release on metacpan or  search on metacpan

lib/App/DBCritic.pm  view on Meta::CPAN

package App::DBCritic;

# ABSTRACT: Critique a database schema for best practices

#pod =head1 SYNOPSIS
#pod
#pod     use App::DBCritic;
#pod
#pod     my $critic = App::DBCritic->new(
#pod         dsn => 'dbi:Oracle:HR', username => 'scott', password => 'tiger');
#pod     $critic->critique();
#pod
#pod =head1 DESCRIPTION
#pod
#pod This package is used to scan a database schema and catalog any violations
#pod of best practices as defined by a set of policy plugins.  It takes conceptual
#pod and API inspiration from L<Perl::Critic|Perl::Critic>.
#pod
#pod B<dbcritic> is the command line interface.
#pod
#pod This is a work in progress - please see the L</SUPPORT> section below for
#pod information on how to contribute.  It especially needs ideas (and
#pod implementations!) of new policies!
#pod
#pod =cut

use strict;
use utf8;
use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)

our $VERSION = '0.023';     # VERSION
use Carp;
use English '-no_match_vars';
use List::Util 1.33 'any';
use Module::Pluggable
    search_path => [ __PACKAGE__ . '::Policy' ],
    sub_name    => 'policies',
    instantiate => 'new';

#pod =method policies
#pod
#pod Returns an array of loaded policy names that will be applied during
#pod L</critique>.  By default all modules under the
#pod C<App::DBCritic::Policy> namespace are loaded.
#pod
#pod =cut

use Moo;
use Scalar::Util 'blessed';
use App::DBCritic::Loader;

for (qw(username password class_name)) { has $_ => ( is => 'ro' ) }

#pod =attr username
#pod
#pod The optional username used to connect to the database.
#pod
#pod =attr password
#pod
#pod The optional password used to connect to the database.
#pod
#pod =attr class_name
#pod
#pod The name of a L<DBIx::Class::Schema|DBIx::Class::Schema> class you wish to
#pod L</critique>.
#pod Only settable at construction time.
#pod
#pod =cut

has dsn => ( is => 'ro', lazy => 1, default => \&_build_dsn );

sub _build_dsn {
    my $self = shift;

    ## no critic (ErrorHandling::RequireUseOfExceptions)
    croak 'No schema defined' if not $self->has_schema;
    my $dbh = $self->schema->storage->dbh;

    ## no critic (ValuesAndExpressions::ProhibitAccessOfPrivateData)
    return join q{:} => 'dbi', $dbh->{Driver}{Name}, $dbh->{Name};
}

#pod =attr dsn
#pod
#pod The L<DBI|DBI> data source name (required) used to connect to the database.
#pod If no L</class_name> or L</schema> is provided, L<DBIx::Class::Schema::Loader|DBIx::Class::Schema::Loader> will then
#pod construct schema classes dynamically to be critiqued.
#pod
#pod =cut