diff --git a/bin/dbcritic b/bin/dbcritic index 9bcb01d..5a9639c 100755 --- a/bin/dbcritic +++ b/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 diff --git a/dist.ini b/dist.ini index 31113f5..7465ce2 100644 --- a/dist.ini +++ b/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 diff --git a/lib/App/DBCritic.pm b/lib/App/DBCritic.pm index 368cceb..406e660 100644 --- a/lib/App/DBCritic.pm +++ b/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 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 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 data source name (required) used to connect to the database. If no L or L is provided, L 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 object you wish to L. +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 object you wish to L. -Only settable at construction time. - -=attr has_schema +=method violations -An attribute predicates that is true or false, depending on whether L -has been defined. +Returns an array of all +Ls +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 to C. =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 -Ls -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; diff --git a/lib/App/DBCritic/Loader.pm b/lib/App/DBCritic/Loader.pm index cf9e484..3261061 100644 --- a/lib/App/DBCritic/Loader.pm +++ b/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; diff --git a/lib/App/DBCritic/Policy.pm b/lib/App/DBCritic/Policy.pm index dd2411e..b60819e 100644 --- a/lib/App/DBCritic/Policy.pm +++ b/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'; diff --git a/lib/App/DBCritic/Policy/BidirectionalRelationship.pm b/lib/App/DBCritic/Policy/BidirectionalRelationship.pm index fd85aba..6f9e16c 100644 --- a/lib/App/DBCritic/Policy/BidirectionalRelationship.pm +++ b/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'; diff --git a/lib/App/DBCritic/Policy/DuplicateRelationships.pm b/lib/App/DBCritic/Policy/DuplicateRelationships.pm index 25fa912..20101f1 100644 --- a/lib/App/DBCritic/Policy/DuplicateRelationships.pm +++ b/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'; diff --git a/lib/App/DBCritic/Policy/NoPrimaryKey.pm b/lib/App/DBCritic/Policy/NoPrimaryKey.pm index c07cb68..6fc882e 100644 --- a/lib/App/DBCritic/Policy/NoPrimaryKey.pm +++ b/lib/App/DBCritic/Policy/NoPrimaryKey.pm @@ -19,7 +19,7 @@ L has zero primary columns. use strict; use utf8; -use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion) +use Modern::Perl '2011'; # VERSION use Moo; diff --git a/lib/App/DBCritic/Policy/NullableTextColumn.pm b/lib/App/DBCritic/Policy/NullableTextColumn.pm index aac0b08..a27446a 100644 --- a/lib/App/DBCritic/Policy/NullableTextColumn.pm +++ b/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', diff --git a/lib/App/DBCritic/PolicyType.pm b/lib/App/DBCritic/PolicyType.pm index e9fee71..f6b8d21 100644 --- a/lib/App/DBCritic/PolicyType.pm +++ b/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), diff --git a/lib/App/DBCritic/PolicyType/ResultSet.pm b/lib/App/DBCritic/PolicyType/ResultSet.pm index 85fa185..e306d61 100644 --- a/lib/App/DBCritic/PolicyType/ResultSet.pm +++ b/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; diff --git a/lib/App/DBCritic/PolicyType/ResultSource.pm b/lib/App/DBCritic/PolicyType/ResultSource.pm index b824f2b..a9fd907 100644 --- a/lib/App/DBCritic/PolicyType/ResultSource.pm +++ b/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; diff --git a/lib/App/DBCritic/PolicyType/Schema.pm b/lib/App/DBCritic/PolicyType/Schema.pm index 073dd39..4d59ca5 100644 --- a/lib/App/DBCritic/PolicyType/Schema.pm +++ b/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; diff --git a/lib/App/DBCritic/Violation.pm b/lib/App/DBCritic/Violation.pm index 6fcb5ca..dfc7f3e 100644 --- a/lib/App/DBCritic/Violation.pm +++ b/lib/App/DBCritic/Violation.pm @@ -22,7 +22,7 @@ violations flagged by L. use strict; use utf8; -use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion) +use Modern::Perl '2011'; # VERSION use Const::Fast; diff --git a/t/loader.t b/t/loader.t index 0aed08b..fe64fb5 100644 --- a/t/loader.t +++ b/t/loader.t @@ -1,6 +1,6 @@ #!/usr/bin/env perl -use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion) +use Modern::Perl '2011'; use Test::Most tests => 1; use Path::Class; use FindBin; diff --git a/t/policy/bidirectional_relationship.t b/t/policy/bidirectional_relationship.t index 5030d5e..71b8b09 100644 --- a/t/policy/bidirectional_relationship.t +++ b/t/policy/bidirectional_relationship.t @@ -1,6 +1,6 @@ #!/usr/bin/env perl -use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion) +use Modern::Perl '2011'; use Test::Most tests => 1; use English '-no_match_vars'; use Path::Class; diff --git a/t/policy/duplicate_relationships.t b/t/policy/duplicate_relationships.t index f9ad2e1..6e0a074 100644 --- a/t/policy/duplicate_relationships.t +++ b/t/policy/duplicate_relationships.t @@ -1,6 +1,6 @@ #!/usr/bin/env perl -use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion) +use Modern::Perl '2011'; use Test::Most tests => 1; use English '-no_match_vars'; use Path::Class; diff --git a/t/policy/no_primary_key.t b/t/policy/no_primary_key.t index 28f7b97..4f2062b 100644 --- a/t/policy/no_primary_key.t +++ b/t/policy/no_primary_key.t @@ -1,6 +1,6 @@ #!/usr/bin/env perl -use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion) +use Modern::Perl '2011'; use Test::Most tests => 1; use English '-no_match_vars'; use Path::Class; diff --git a/t/policy/nullable_text_column.t b/t/policy/nullable_text_column.t index a24e1e3..e86208e 100644 --- a/t/policy/nullable_text_column.t +++ b/t/policy/nullable_text_column.t @@ -1,6 +1,6 @@ #!/usr/bin/env perl -use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion) +use Modern::Perl '2011'; use Test::Most tests => 1; use English '-no_match_vars'; use Path::Class; diff --git a/t/schema.t b/t/schema.t index dfa8108..5768043 100644 --- a/t/schema.t +++ b/t/schema.t @@ -1,6 +1,6 @@ #!/usr/bin/env perl -use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion) +use Modern::Perl '2011'; use Test::Most tests => 1; use Path::Class; use FindBin; diff --git a/xt/author/perlcritic.rc b/xt/author/perlcritic.rc deleted file mode 100644 index c44e957..0000000 --- a/xt/author/perlcritic.rc +++ /dev/null @@ -1,41 +0,0 @@ -severity = brutal -verbose = 8 -exclude = CodeLayout::ProhibitHashBarewords Documentation::RequirePODUseEncodingUTF8 Editor::RequireEmacsFileVariables Miscellanea::RequireRcsKeywords Modules::RequireExplicitInclusion Modules::RequireExplicitPackage Modules::RequirePerlVersion Tics::ProhibitLongLines BuiltInFunctions::ProhibitStringyEval - -[CodeLayout::RequireTidyCode] -perltidyrc = xt/author/perltidy.rc - -[Lax::RequireExplicitPackage::ExceptForPragmata] -allowed_pragmata = diagnostics feature perlversion strict warnings utf8 Modern::Perl - -# since we're using Modern::Perl -[Compatibility::PerlMinimumVersionAndWhy] -above_version = 5.012 -[Compatibility::PodMinimumVersion] -above_version = 5.012 - -[ControlStructures::ProhibitPostfixControls] -flowcontrol = carp cluck confess croak die exit goto warn exit - -[Documentation::PodSpelling] -stop_words = Perldoc perldoc annonations PASSed DBIx accessor schemas DBICType TypeConstraints ResultSources namespace stringify DSN DBI dsn username plugins API configfile LoadingSchema nullable SQL ResultSet ResultSets ResultSource dbcritic - -[Documentation::RequirePodSections] -lib_sections = NAME | VERSION | SYNOPSIS | DESCRIPTION | SUPPORT | AUTHOR | COPYRIGHT AND LICENSE -script_sections = NAME | USAGE | DESCRIPTION | CONFIGURATION | SUPPORT | AUTHOR | COPYRIGHT AND LICENSE - -[InputOutput::RequireCheckedSyscalls] -functions = :builtins -exclude_functions = print say - -[Subroutines::ProhibitCallsToUndeclaredSubs] -exempt_subs = Carp::croak Const::Fast::const Data::Compare::Compare Getopt::Long::Descriptive::describe_options Moo::extends Moo::has Moo::with Moo::Role::around Moo::Role::has Moo::Role::requires Moo::Role::with Sub::Quote::quote_sub - -[TestingAndDebugging::RequireUseStrict] -equivalent_modules = Modern::Perl - -[TestingAndDebugging::RequireUseWarnings] -equivalent_modules = Modern::Perl - -[Bangs::ProhibitCommentedOutCode] -commentedcoderegex = (?= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" # Break before all operators -