ported main App::DBCritic class to Object::Pad

bin/dbcritic

@@ -1,7 +1,6 @@
 #!/usr/bin/env perl
 
-package main;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 use utf8;
 
 # VERSION

dist.ini

@@ -13,21 +13,21 @@ options = test_one_dot = 0
 perl                        = 5.012
 DBIx::Class                 = 0.08125
 DBIx::Class::Schema::Loader = 0.07007
+DBD::SQLite                 = 0
 [Prereqs / DevelopRequires]
 perl = 5.014
 [AutoPrereqs]
 [NextRelease]
 [OurPkgVersion]
 [@TestingMania]
-critic_config = xt/author/perlcritic.rc
+disable = Test::Perl::Critic
 disable = Test::Portability
+disable = Test::UnusedVars
 max_target_perl = 5.012
 [Test::ChangesHasContent]
 [PodWeaver]
 replacer           = replace_with_comment
 post_code_replacer = replace_with_nothing
-[PerlTidy]
-perltidyrc = xt/author/perltidy.rc
 [ReportVersions]
 [ReadmeAnyFromPod]
 [ReadmeAnyFromPod / ReadmePodInRoot]
@@ -51,15 +51,3 @@ repo = dbcritic
 [Repository]
 [CPANFile]
 [InstallRelease]
-
-;authordep Perl::Critic::Bangs
-;authordep Perl::Critic::Itch
-;authordep Perl::Critic::Lax
-;authordep Perl::Critic::More
-;authordep Perl::Critic::Nits
-;authordep Perl::Critic::Pulp
-;authordep Perl::Critic::StricterSubs
-;authordep Perl::Critic::Swift
-;authordep Pod::Weaver::Plugin::StopWords
-;authordep Pod::Weaver::Section::Support
-;authordep Test::Pod::Coverage

lib/App/DBCritic.pm

@@ -1,4 +1,8 @@
+use v5.12;
+use Object::Pad 0.47;
+
 package App::DBCritic;
+class App::DBCritic;
 
 # ABSTRACT: Critique a database schema for best practices
 
@@ -24,19 +28,17 @@ implementations!) of new policies!
 
 =cut
 
-use strict;
-use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
-
 # VERSION
+use utf8;
 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';
 
+=for Pod::Coverage DOES META new
+
 =method policies
 
 Returns an array of loaded policy names that will be applied during
@@ -45,20 +47,27 @@ C<App::DBCritic::Policy> namespace are loaded.
 
 =cut
 
-use Moo;
 use Scalar::Util 'blessed';
 use App::DBCritic::Loader;
 
-for (qw(username password class_name)) { has $_ => ( is => 'ro' ) }
+has $username :reader :param = undef;
 
 =attr username
 
 The optional username used to connect to the database.
 
+=cut
+
+has $password :reader :param = undef;
+
 =attr password
 
 The optional password used to connect to the database.
 
+=cut
+
+has $class_name :reader :param = undef;
+
 =attr class_name
 
 The name of a L<DBIx::Class::Schema|DBIx::Class::Schema> class you wish to
@@ -67,17 +76,25 @@ Only settable at construction time.
 
 =cut
 
-has dsn => ( is => 'ro', lazy => 1, default => \&_build_dsn );
+has $dsn    :reader :param = 'dbi:SQLite::memory:';
+has $schema :reader :param = undef;
 
-sub _build_dsn {
-    my $self = shift;
+ADJUST {
+    my @connect_info = ( $dsn, $username, $password );
 
-    ## no critic (ErrorHandling::RequireUseOfExceptions)
-    croak 'No schema defined' if not $self->has_schema;
-    my $dbh = $self->schema->storage->dbh;
+    if ($class_name and eval "require $class_name") {
+        $schema = $class_name->connect(@connect_info);
+    }
+    elsif ( not ( blessed($schema) and $schema->isa('DBIx::Class::Schema') ) ) {
+        local $SIG{__WARN__} = sub {
+            if ( $_[0] !~ / has no primary key at /ms ) {
+                print {*STDERR} $_[0];
+            }
+        };
+        $schema = App::DBCritic::Loader->connect(@connect_info);
+    }
 
-    ## no critic (ValuesAndExpressions::ProhibitAccessOfPrivateData)
-    return join q{:} => 'dbi', $dbh->{Driver}{Name}, $dbh->{Name};
+    croak 'No schema defined' if not $schema;
 }
 
 =attr dsn
@@ -86,72 +103,42 @@ The L<DBI|DBI> data source name (required) used to connect to the database.
 If no L</class_name> or L</schema> is provided, L<DBIx::Class::Schema::Loader|DBIx::Class::Schema::Loader> will then
 construct schema classes dynamically to be critiqued.
 
-=cut
-
-has schema => (
-    is        => 'ro',
-    coerce    => 1,
-    lazy      => 1,
-    default   => \&_build_schema,
-    coerce    => \&_coerce_schema,
-    predicate => 1,
-);
+=attr schema
 
-sub _build_schema {
-    my $self = shift;
+A L<DBIx::Class::Schema|DBIx::Class::Schema> object you wish to L</critique>.
+Only settable at construction time.
 
-    my @connect_info = map { $self->$_ } qw(dsn username password);
+=cut
 
-    if ( my $class_name = $self->class_name ) {
-        return $class_name->connect(@connect_info)
-            if eval "require $class_name";
-    }
+has %elements;
 
-    return _coerce_schema( \@connect_info );
+ADJUST {
+    %elements = (
+        Schema       => [$schema],
+        ResultSource => [ map { $schema->source($_) } $schema->sources ],
+        ResultSet    => [ map { $schema->resultset($_) } $schema->sources ],
+    );
 }
 
-sub _coerce_schema {
-    my $schema = shift;
-
-    return $schema if blessed $schema and $schema->isa('DBIx::Class::Schema');
+has @violations;
 
-    local $SIG{__WARN__} = sub {
-        if ( $_[0] !~ / has no primary key at /ms ) {
-            print {*STDERR} $_[0];
-        }
-    };
-    return App::DBCritic::Loader->connect( @{$schema} )
-        if 'ARRAY' eq ref $schema;
-    ## no critic (ErrorHandling::RequireUseOfExceptions)
-    croak q{don't know how to make a schema from a } . ref $schema;
+ADJUST {
+    @violations = map { $self->_policy_loop( $_, $elements{$_} ) }
+        keys %elements;
 }
 
-=attr schema
+method violations { wantarray ? @violations : \@violations }
 
-A L<DBIx::Class::Schema|DBIx::Class::Schema> object you wish to L</critique>.
-Only settable at construction time.
-
-=attr has_schema
+=method violations
 
-An attribute predicates that is true or false, depending on whether L</schema>
-has been defined.
+Returns an array of all
+L<App::DBCritic::Violation|App::DBCritic::Violation>s
+picked up by the various policies.
 
 =cut
 
-has _elements => ( is => 'ro', lazy => 1, default => \&_build__elements );
-
-sub _build__elements {
-    my $self   = shift;
-    my $schema = $self->schema;
-    return {
-        Schema       => [$schema],
-        ResultSource => [ map { $schema->source($_) } $schema->sources ],
-        ResultSet    => [ map { $schema->resultset($_) } $schema->sources ],
-    };
-}
-
-sub critique {
-    for ( @{ shift->violations } ) {say}
+method critique {
+    say for @violations;
     return;
 }
 
@@ -163,40 +150,19 @@ L</violations> to C<STDOUT>.
 
 =cut
 
-has violations => (
-    is      => 'ro',
-    lazy    => 1,
-    default => sub {
-        my $self = shift;
-        [   map { $self->_policy_loop( $_, $self->_elements->{$_} ) }
-                keys %{ $self->_elements },
-        ];
-    },
-);
-
-=method violations
-
-Returns an array reference of all
-L<App::DBCritic::Violation|App::DBCritic::Violation>s
-picked up by the various policies.
-
-=cut
+sub _policy_applies_to ( $policy, $type ) {
+    return any { $_ eq $type } @{ $policy->applies_to };
+}
 
-sub _policy_loop {
-    my ( $self, $policy_type, $elements_ref ) = @_;
-    my @violations;
+method _policy_loop ($policy_type, $elements_ref) {
+    my @_violations;
     for my $policy ( grep { _policy_applies_to( $_, $policy_type ) }
         $self->policies )
     {
-        push @violations, grep {$_}
-            map { $policy->violates( $_, $self->schema ) } @{$elements_ref};
+        push @_violations, grep {$_}
+            map { $policy->violates( $_, $schema ) } @{$elements_ref};
     }
-    return @violations;
-}
-
-sub _policy_applies_to {
-    my ( $policy, $type ) = @_;
-    return any { $_ eq $type } @{ $policy->applies_to };
+    return @_violations;
 }
 
 1;

lib/App/DBCritic/Loader.pm

@@ -18,7 +18,7 @@ generate a schema based on a database connection.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use Moo;

lib/App/DBCritic/Policy.pm

@@ -23,7 +23,7 @@ policy plugins.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use English '-no_match_vars';

lib/App/DBCritic/Policy/BidirectionalRelationship.pm

@@ -20,7 +20,7 @@ have a corresponding reverse relationship in the other class.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use English '-no_match_vars';

lib/App/DBCritic/Policy/DuplicateRelationships.pm

@@ -20,7 +20,7 @@ other tables that are identical in everything but name.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use Algorithm::Combinatorics 'combinations';

lib/App/DBCritic/Policy/NoPrimaryKey.pm

@@ -19,7 +19,7 @@ L<DBIx::Class::ResultSource|DBIx::Class::ResultSource> has zero primary columns.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use Moo;

lib/App/DBCritic/Policy/NullableTextColumn.pm

@@ -20,7 +20,7 @@ columns.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use DBI ':sql_types';
@@ -56,7 +56,6 @@ has explanation => (
 sub violates {
     my $source = shift->element;
 
-    ## no critic (ProhibitAccessOfPrivateData,ProhibitCallsToUndeclaredSubs)
     my @text_types = (
         qw(TEXT NTEXT CLOB NCLOB CHARACTER CHAR NCHAR VARCHAR VARCHAR2 NVARCHAR2),
         'CHARACTER VARYING',

lib/App/DBCritic/PolicyType.pm

@@ -18,7 +18,7 @@ policy types.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 require Devel::Symdump;
@@ -31,7 +31,6 @@ with 'App::DBCritic::Policy';
 has applies_to => (
     is   => 'ro',
     lazy => 1,
-    ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
     default => quote_sub( <<'END_SUB' => { '$package' => \__PACKAGE__ } ),
         [   List::MoreUtils::apply {s/\A .+ :://xms}
             grep { shift->does($_) } Devel::Symdump->packages($package),

lib/App/DBCritic/PolicyType/ResultSet.pm

@@ -24,7 +24,7 @@ for you.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use Moo::Role;

lib/App/DBCritic/PolicyType/ResultSource.pm

@@ -24,7 +24,7 @@ for you.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use Moo::Role;

lib/App/DBCritic/PolicyType/Schema.pm

@@ -24,7 +24,7 @@ for you.
 
 use strict;
 use utf8;
-use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)
+use Modern::Perl '2011';
 
 # VERSION
 use Moo::Role;