Uploaded byjoshua.mcadams
ODP, PDF1,523 views

YAPC::NA 2007 - Customizing And Extending Perl Critic

The document discusses the process of extending Perl Critic by creating a custom policy module called 'builtinfunctions::requireblockgrepandmap' to enforce specific coding standards, particularly the use of block forms for the 'map' and 'grep' functions. It includes various testing steps and encountered multiple failed tests due to issues in implementation and policy application. Ultimately, the project aims to provide a framework for developers to enforce their coding conventions through customized rules in Perl Critic.

Embed presentation

Downloaded 75 times
Customizing and Extending Perl Critic YAPC::NA 2007 Houston, TX Josh McAdams
Extending Perl Critic Perl Critic is a very powerful and customizable system in its off-the-CPAN state; however, there are times when you need to create your own policies to enforce your own coding standards. We will see how to do that by creating a variant of one of the core modules: BuiltinFunctions::RequireBlockGrep . We'll call our policy BuiltinFunctions::RequireBlockGrepAndMap and make it force block map s in addition to grep s.
Extending Perl Critic use strict; use warnings; use Test::More tests => 1; use_ok( 'Perl::Critic::Policy::' . 'BuiltinFunctions::RequireBlockGrepAndMap' ); t/initial-setup.t
Extending Perl Critic --(0)> prove -Ilib t/initial-setup.t t/initial-setup.... # Failed test 'use Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap;' # at t/initial-setup.t line 5. # Tried to use 'Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap'. # Error: Can't locate Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm in @INC (...) line 2. # BEGIN failed--compilation aborted at t/initial-setup.t line 5. # Looks like you failed 1 test of 1. t/initial-setup....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 1 Failed 1/1 tests, 0.00% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/initial-setup.t 1 256 1 1 1 Failed 1/1 test scripts. 1/1 subtests failed. Files=1, Tests=1, 0 wallclock secs ( 0.04 cusr + 0.02 csys = 0.06 CPU) Failed 1/1 test programs. 1/1 subtests failed.
Extending Perl Critic package Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap ; use warnings; use strict; 1; lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/initial-setup....ok All tests successful.
Extending Perl Critic use strict; use warnings; use Test::More tests => 2; use_ok( 'Perl::Critic::Policy::' . 'BuiltinFunctions::RequireBlockGrepAndMap' ); my $policy = Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap ->new(); is($policy->get_severity(), 4, 'high severity set'); t/initial-setup.t
Extending Perl Critic --(0)> prove -Ilib t/* t/initial-setup....Can't locate object method "new" via package "Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap" at t/initial-setup.t line 10. # Looks like you planned 2 tests but only ran 1. # Looks like your test died just after 1. t/initial-setup....dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED test 2 Failed 1/2 tests, 50.00% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/initial-setup.t 255 65280 2 2 2 Failed 1/1 test scripts. 1/2 subtests failed. Files=1, Tests=2, 0 wallclock secs ( 0.04 cusr + 0.02 csys = 0.06 CPU) Failed 1/1 test programs. 1/2 subtests failed.
Extending Perl Critic package Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap; use warnings; use strict; use base qw(Perl::Critic::Policy); use Perl::Critic::Utils; sub new { my ($class, %args) = @_; return $class->SUPER::new(%args); } sub default_severity { return $SEVERITY_HIGH; } 1; lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/initial-setup....ok All tests successful. Files=1, Tests=2, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU)
Extending Perl Critic Severity Level Variables Exported By Perl::Critic::Utils $SEVERITY_HIGHEST == 5 $SEVERITY_HIGH == 4 $SEVERITY_MEDIUM == 3 $SEVERITY_LOW == 2 $SEVERITY_LOWEST == 1
Extending Perl Critic ... is_deeply( [$policy->get_themes()], [qw(almost_core pbp)], 'proper themes set' ); t/initial-setup.t
Extending Perl Critic --(0)> prove -Ilib t/* t/initial-setup....NOK 3 # Failed test 'proper themes set' # at t/initial-setup.t line 16. # Structures begin differing at: # $got->[0] = Does not exist # $expected->[0] = 'almost_core' # Looks like you failed 1 test of 3. t/initial-setup....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 3 Failed 1/3 tests, 66.67% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/initial-setup.t 1 256 3 1 3 Failed 1/1 test scripts. 1/3 subtests failed. Files=1, Tests=3, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU) Failed 1/1 test programs. 1/3 subtests failed.
Extending Perl Critic sub default_themes { return qw( almost_core pbp ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/initial-setup....ok All tests successful. Files=1, Tests=3, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU)
Extending Perl Critic ... is_deeply( [$policy->applies_to()], [qw(PPI::Token::Word)], 'applies only to words' ); t/initial-setup.t
Extending Perl Critic --(0)> prove -Ilib t/* t/initial-setup....NOK 4 # Failed test 'applies only to words' # at t/initial-setup.t line 18. # Structures begin differing at: # $got->[0] = 'PPI::Element' # $expected->[0] = 'PPI::Token::Word' # Looks like you failed 1 test of 4. t/initial-setup....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 4 Failed 1/4 tests, 75.00% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/initial-setup.t 1 256 4 1 4 Failed 1/1 test scripts. 1/4 subtests failed. Files=1, Tests=4, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU) Failed 1/1 test programs. 1/4 subtests failed.
Extending Perl Critic sub applies_to { return 'PPI::Token::Word'; } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/initial-setup....ok All tests successful. Files=1, Tests=4, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU)
Extending Perl Critic PPI::Document PPI::Document::File PPI::Document::Fragment PPI::Document::Normalized PPI::Element PPI::Statement PPI::Statement::Break PPI::Statement::Compound PPI::Statement::Data PPI::Statement::End PPI::Statement::Expression PPI::Statement::Include PPI::Statement::Null PPI::Statement::Package PPI::Statement::Scheduled PPI::Statement::Sub PPI::Statement::Unknown PPI::Statement::UnmatchedBrace PPI::Statement::Variable PPI::Structure PPI::Structure::Block PPI::Structure::Condition PPI::Structure::Constructor PPI::Token::Quote::Single PPI::Token::QuoteLike PPI::Token::QuoteLike::Backtick PPI::Token::QuoteLike::Command PPI::Token::QuoteLike::Readline PPI::Token::QuoteLike::Regexp PPI::Token::QuoteLike::Words PPI::Token::Regexp PPI::Token::Regexp::Match PPI::Token::Regexp::Substitute PPI::Token::Regexp::Transliterate PPI::Token::Separator PPI::Token::Structure PPI::Token::Symbol PPI::Token::Unknown PPI::Token::Whitespace PPI::Token::Word PPI::Structure::ForLoop PPI::Structure::List PPI::Structure::Subscript PPI::Structure::Unknown PPI::Token PPI::Token::ArrayIndex PPI::Token::Attribute PPI::Token::Cast PPI::Token::Comment PPI::Token::DashedWord PPI::Token::Data PPI::Token::End PPI::Token::HereDoc PPI::Token::Label PPI::Token::Magic PPI::Token::Number PPI::Token::Operator PPI::Token::Pod PPI::Token::Prototype PPI::Token::Quote PPI::Token::Quote::Double PPI::Token::Quote::Interpolate PPI::Token::Quote::Literal PPI Modules
Extending Perl Critic use warnings; use strict; use Test::More tests => 1; use Perl::Critic::TestUtils qw(pcritique); my $custom_policy = 'BuiltinFunctions::RequireBlockGrepAndMap'; my $code = 'grep { $_ }'; my $violation_count = pcritique( $custom_policy, \$code ); ok(!$violation_count, 'allowed block grep'); t/exercise-policy.t
Extending Perl Critic Some Perl::Critic::TestUtils Help Methods - block_perlcriticrc - critique - pcritique - fcritique
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....Can't call abstract method at /opt/local/lib/perl5/site_perl/5.8.7/Perl/Critic/Policy.pm line 98 Perl::Critic::Policy::violates('Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMa...', 'PPI::Token::Word=HASH(0x1a01b40)', 'Perl::Critic::Document=HASH(0x183d338)') called at /opt/local/lib/perl5/site_perl/5.8.7/Perl/Critic.pm line 165 Perl::Critic::_critique('Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMa...', 'Perl::Critic::Document=HASH(0x183d338)', 'HASH(0x19fc194)') called at /opt/local/lib/perl5/site_perl/5.8.7/Perl/Critic.pm line 121 Perl::Critic::critique('Perl::Critic=HASH(0x1800f88)', 'SCALAR(0x1810eac)') called at /opt/local/lib/perl5/site_perl/5.8.7/Perl/Critic/TestUtils.pm line 53 Perl::Critic::TestUtils::pcritique('BuiltinFunctions::RequireBlockGrepAndMap', 'SCALAR(0x1810eac)') called at t/exercise-policy.t line 9 # Looks like your test died before it could output anything. t/exercise-policy....dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED test 1 Failed 1/1 tests, 0.00% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 255 65280 1 2 1 Failed 1/2 test scripts. 1/5 subtests failed. Files=2, Tests=5, 1 wallclock secs ( 0.99 cusr + 0.24 csys = 1.23 CPU) Failed 1/2 test programs. 1/5 subtests failed.
Extending Perl Critic sub violates {} lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=5, 2 wallclock secs ( 0.98 cusr + 0.22 csys = 1.20 CPU)
Extending Perl Critic my $custom_policy = 'BuiltinFunctions::RequireBlockGrepAndMap'; { my $code = 'grep { $_ }'; my $violation_count = pcritique( $custom_policy, \$code ); is($violation_count, 0, 'allowed block grep'); } { my $code = 'grep "$_"'; my $violation_count = pcritique( $custom_policy, \$code ); is($violation_count, 1, 'disallowed string grep'); } t/exercise-policy.t
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....NOK 2 # Failed test 'disallowed string grep' # at t/exercise-policy.t line 17. # got: '0' # expected: '1' # Looks like you failed 1 test of 2. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 2 Failed 1/2 tests, 50.00% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 2 1 2 Failed 1/2 test scripts. 1/6 subtests failed. Files=2, Tests=6, 2 wallclock secs ( 1.00 cusr + 0.22 csys = 1.22 CPU) Failed 1/2 test programs. 1/6 subtests failed.
Extending Perl Critic my $description = q{Expression form of "grep" and "map"}; my $explanation = [169]; sub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; my $sibling = $element->snext_sibling(); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=6, 1 wallclock secs ( 1.00 cusr + 0.22 csys = 1.22 CPU)
Extending Perl Critic Some PPI Utility Methods (from PPI::Element) - parent - next_sibling - snext_sibling - previous_sibling - sprevious_sibling - first_token - last_token - next_token - previous_token
Extending Perl Critic use warnings; use strict; use Test::More; use Perl::Critic::TestUtils qw(subtests_in_tree fcritique pcritique); my $custom_policy = 'BuiltinFunctions::RequireBlockGrepAndMap'; my $subtests = subtests_in_tree('t/BuiltinFunctions'); my $test_count = 0; $test_count += @{$subtests->{$_}} for ( keys %{$subtests} ); plan tests => $test_count; ... t/exercise-policy.t
Extending Perl Critic for my $policy ( sort keys %$subtests ) { for my $subtest ( @{ $subtests->{$policy} } ) { local $TODO = $subtest->{TODO}; my $desc = join( ' - ', $policy, "line $subtest->{lineno}", $subtest->{name} ); my $violations = $subtest->{filename} ? eval { fcritique( $policy, \$subtest->{code}, $subtest->{filename}, $subtest->{parms} ); } : eval { pcritique( $policy, \$subtest->{code}, $subtest->{parms} ) }; my $err = $@; if ( $subtest->{error} ) { if ( 'Regexp' eq ref $subtest->{error} ) { like( $err, $subtest->{error}, $desc ); } else { ok( $err, $desc ); } } else { die $err if $err; is( $violations, $subtest->{failures}, $desc ); } } } t/exercise-policy.t
Extending Perl Critic ## name allowed block grep ## failures 0 ## cut grep { $_ } ## name disallowed string grep ## failures 1 ## cut grep "$_" t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=6, 2 wallclock secs ( 1.01 cusr + 0.22 csys = 1.23 CPU)
Extending Perl Critic ## name A Test Name ## parms { allow_y => 0 } ## TODO Should pass later ## error 1 ## error /Can't load Foo::Bar/ ## filename lib/Foo/Bar.pm ## cut Options For .run Files
Extending Perl Critic ... ## name grep as a method call ## failures 0 ## cut $object->grep('this'); t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....NOK 3 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 13 - grep as a method call' # at t/exercise-policy.t line 41. # got: '1' # expected: '0' # Looks like you failed 1 test of 3. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 3 Failed 1/3 tests, 66.67% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 3 1 3 Failed 1/2 test scripts. 1/7 subtests failed. Files=2, Tests=7, 2 wallclock secs ( 1.00 cusr + 0.24 csys = 1.24 CPU) Failed 1/2 test programs. 1/7 subtests failed.
Extending Perl Critic use Perl::Critic::Utils; ... sub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; return if is_method_call($element); my $sibling = $element->snext_sibling(); return if $sibling ->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=7, 2 wallclock secs ( 1.01 cusr + 0.24 csys = 1.25 CPU)
Extending Perl Critic Some Useful Methods From Perl::Critic::Utils - is_perl_global - is_perl_builtin - is_hash_key - is_method_call - is_subroutine_name - is_function_call - first_arg - parse_arg_list
Extending Perl Critic ... ## name grep as a hash key ## failures 0 ## cut $my_hash{ grep } = 1; t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok 1/4Can't call method "isa" without a package or object reference at lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm line 36. # Looks like you planned 4 tests but only ran 3. # Looks like your test died just after 3. t/exercise-policy....dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED test 4 Failed 1/4 tests, 75.00% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 255 65280 4 2 4 Failed 1/2 test scripts. 1/8 subtests failed. Files=2, Tests=8, 1 wallclock secs ( 1.00 cusr + 0.22 csys = 1.22 CPU) Failed 1/2 test programs. 1/8 subtests failed.
Extending Perl Critic sub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; return if is_method_call($element); return if is_hash_key($element); my $sibling = $element->snext_sibling(); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=8, 2 wallclock secs ( 1.02 cusr + 0.25 csys = 1.27 CPU)
Extending Perl Critic ... ## name grep is a sub name ## failures 0 ## cut sub grep { return } t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=9, 2 wallclock secs ( 1.02 cusr + 0.22 csys = 1.24 CPU)
Extending Perl Critic ... ## name grep is a sub prototype name ## failures 0 ## cut sub grep; t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....NOK 6 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 31 - grep is a sub prototype name' # at t/exercise-policy.t line 41. # got: '1' # expected: '0' # Looks like you failed 1 test of 6. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 6 Failed 1/6 tests, 83.33% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 6 1 6 Failed 1/2 test scripts. 1/10 subtests failed. Files=2, Tests=10, 1 wallclock secs ( 1.04 cusr + 0.22 csys = 1.26 CPU) Failed 1/2 test programs. 1/10 subtests failed.
Extending Perl Critic sub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; return if is_method_call($element); return if is_hash_key($element); return if is_subroutine_name($element); my $sibling = $element->snext_sibling(); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=10, 2 wallclock secs ( 1.02 cusr + 0.22 csys = 1.24 CPU)
Extending Perl Critic ... ## name grep has parens ## failures 0 ## cut grep ( { $_ } @list ); t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....NOK 7 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 37 - grep has parens' # at t/exercise-policy.t line 41. # got: '1' # expected: '0' # Looks like you failed 1 test of 7. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 7 Failed 1/7 tests, 85.71% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 7 1 7 Failed 1/2 test scripts. 1/11 subtests failed. Files=2, Tests=11, 2 wallclock secs ( 1.03 cusr + 0.22 csys = 1.25 CPU) Failed 1/2 test programs. 1/11 subtests failed.
Extending Perl Critic sub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; return if is_method_call($element); return if is_hash_key($element); return if is_subroutine_name($element); my $sibling = $element->snext_sibling(); $sibling = $sibling->schild(0) if $sibling->isa('PPI::Structure::List'); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=11, 2 wallclock secs ( 1.04 cusr + 0.24 csys = 1.28 CPU)
Extending Perl Critic ... ## name block map ## failures 0 ## cut map { $_ } t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=12, 2 wallclock secs ( 1.04 cusr + 0.22 csys = 1.26 CPU)
Extending Perl Critic ... ## name string map ## failures 1 ## cut map "$_" t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....NOK 9 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 49 - string map' # at t/exercise-policy.t line 41. # got: '0' # expected: '1' # Looks like you failed 1 test of 9. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 9 Failed 1/9 tests, 88.89% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 9 1 9 Failed 1/2 test scripts. 1/13 subtests failed. Files=2, Tests=13, 1 wallclock secs ( 1.05 cusr + 0.22 csys = 1.27 CPU) Failed 1/2 test programs. 1/13 subtests failed.
Extending Perl Critic sub violates { my ( $self, $element, $document ) = @_; return unless grep { $element eq $_ } qw[grep map]; return if is_method_call($element); return if is_hash_key($element); return if is_subroutine_name($element); my $sibling = $element->snext_sibling(); $sibling = $sibling->schild(0) if $sibling->isa('PPI::Structure::List'); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=13, 1 wallclock secs ( 1.05 cusr + 0.23 csys = 1.28 CPU)
Extending Perl Critic ... ## name string map allowed ## failures 0 ## parms { allow => ['map'] } ## cut map "$_" t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....NOK 10 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 55 - string map allowed' # at t/exercise-policy.t line 41. # got: '1' # expected: '0' # Looks like you failed 1 test of 10. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 10 Failed 1/10 tests, 90.00% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 10 1 10 Failed 1/2 test scripts. 1/14 subtests failed. Files=2, Tests=14, 2 wallclock secs ( 1.05 cusr + 0.22 csys = 1.27 CPU) Failed 1/2 test programs. 1/14 subtests failed.
Extending Perl Critic sub new { my ($class, %args) = @_; my $self = $class->SUPER::new(%args); $args{allow} = [] unless exists $args{allow}; for my $function (qw(grep map)) { push @{$self->{filter}}, $function unless grep { $_ eq $function } @{$args{allow}}; } return $self; } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic sub violates { my ( $self, $element, $document ) = @_; return unless grep { $element eq $_ } @{$self->{filter} || []}; return if is_method_call($element); return if is_hash_key($element); return if is_subroutine_name($element); my $sibling = $element->snext_sibling(); $sibling = $sibling->schild(0) if $sibling->isa('PPI::Structure::List'); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=14, 2 wallclock secs ( 1.06 cusr + 0.24 csys = 1.30 CPU)
Extending Perl Critic ... ## name string grep allowed ## failures 0 ## parms { allow => ['grep'] } ## cut grep "$_" ## name string grep and map allowed ## failures 0 ## parms { allow => ['grep', 'map'] } ## cut grep "$_"; map "$_"; ## name string grep and map not allowed ## failures 2 ## cut grep "$_"; map "$_"; t/BuiltinFunctions/RequireBlockGrepAndMap.run
Extending Perl Critic --(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=17, 2 wallclock secs ( 1.08 cusr + 0.22 csys = 1.30 CPU)
Extending Perl Critic That's it for coding our module. We could of course add some POD. =pod =head1 NAME Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap =head1 DESCRIPTION The expression form of C<grep> and C<map> is awkward and hard to read. Use the block forms instead. @matches = grep /pattern/, @list; #not ok @matches = grep { /pattern/ } @list; #ok @mapped = map transform($_), @list; #not ok @mapped = map { transform($_) } @list; #ok =cut
Extending Perl Critic ... and more tests!
Extending Perl Critic - Use Perl::Critic::TestUtils to test your policies - Have your policies subclass Perl::Critic::Policy - Set a default severity for your policies - Set a default tag set for your policies - Configure your policy to apply to specific PPI elements - Create a violates subroutine that does your validation and throws a Perl::Critic::Violation when the policy finds a problem - Use Perl::Critic::Utils to help create your policy - User PPI::Element methods to traverse the PPI DOM In Review

More Related Content

PDF
Building Testable PHP Applications
bychartjes
 
PDF
Beginning PHPUnit
byJace Ju
 
PPTX
Unit Testing Presentation
bynicobn
 
PDF
PhpUnit Best Practices
byEdorian
 
PDF
PHPUnit best practices presentation
byThanh Robi
 
PPTX
Test in action week 2
byYi-Huan Chan
 
PPT
Test Driven Development with PHPUnit
byMindfire Solutions
 
PDF
Unit testing PHP apps with PHPUnit
byMichelangelo van Dam
 
Building Testable PHP Applications
bychartjes
 
Beginning PHPUnit
byJace Ju
 
Unit Testing Presentation
bynicobn
 
PhpUnit Best Practices
byEdorian
 
PHPUnit best practices presentation
byThanh Robi
 
Test in action week 2
byYi-Huan Chan
 
Test Driven Development with PHPUnit
byMindfire Solutions
 
Unit testing PHP apps with PHPUnit
byMichelangelo van Dam
 

What's hot

PDF
Test your code like a pro - PHPUnit in practice
bySebastian Marek
 
PPT
Phpunit testing
byNikunj Bhatnagar
 
PDF
PHPUnit
byHampton Roads PHP User Grop
 
PPT
Mocking Dependencies in PHPUnit
bymfrost503
 
PDF
Introduction to Unit Testing with PHPUnit
byMichelangelo van Dam
 
PPT
Unit Testing using PHPUnit
byvaruntaliyan
 
PPT
Advanced PHPUnit Testing
byMike Lively
 
PDF
What is wrong on Test::More? / Test::Moreが抱える問題点とその解決策
bykwatch
 
PDF
New Features PHPUnit 3.3 - Sebastian Bergmann
bydpc
 
PPTX
PHPUnit: from zero to hero
byJeremy Cook
 
PDF
2010 07-28-testing-zf-apps
byVenkata Ramana
 
PDF
Unlock The Mystery Of PHPUnit (Wave PHP 2018)
byENDelt260
 
PDF
Unit testing with PHPUnit - there's life outside of TDD
byPaweł Michalik
 
PDF
Testing Code and Assuring Quality
byKent Cowgill
 
PDF
Test Driven Development With Python
bySiddhi
 
KEY
PHPUnit testing to Zend_Test
byMichelangelo van Dam
 
PDF
Test driven node.js
byJay Harris
 
KEY
groovy & grails - lecture 7
byAlexandre Masselot
 
ODP
Testes pythonicos com pytest
byviniciusban
 
PPTX
Unit Testng with PHP Unit - A Step by Step Training
byRam Awadh Prasad, PMP
 
Test your code like a pro - PHPUnit in practice
bySebastian Marek
 
Phpunit testing
byNikunj Bhatnagar
 
PHPUnit
byHampton Roads PHP User Grop
 
Mocking Dependencies in PHPUnit
bymfrost503
 
Introduction to Unit Testing with PHPUnit
byMichelangelo van Dam
 
Unit Testing using PHPUnit
byvaruntaliyan
 
Advanced PHPUnit Testing
byMike Lively
 
What is wrong on Test::More? / Test::Moreが抱える問題点とその解決策
bykwatch
 
New Features PHPUnit 3.3 - Sebastian Bergmann
bydpc
 
PHPUnit: from zero to hero
byJeremy Cook
 
2010 07-28-testing-zf-apps
byVenkata Ramana
 
Unlock The Mystery Of PHPUnit (Wave PHP 2018)
byENDelt260
 
Unit testing with PHPUnit - there's life outside of TDD
byPaweł Michalik
 
Testing Code and Assuring Quality
byKent Cowgill
 
Test Driven Development With Python
bySiddhi
 
PHPUnit testing to Zend_Test
byMichelangelo van Dam
 
Test driven node.js
byJay Harris
 
groovy & grails - lecture 7
byAlexandre Masselot
 
Testes pythonicos com pytest
byviniciusban
 
Unit Testng with PHP Unit - A Step by Step Training
byRam Awadh Prasad, PMP
 

Viewers also liked

PPS
Reclamos
byEmosane Esther
 
PPS
Increible1
bydhuerta21
 
PPT
Hist Inter2
byAna Valentina
 
PPS
Tu mayor tesoro
byEmosane Esther
 
PPS
Semillas
byEmosane Esther
 
PPT
Perspectives des de Catalunya en formació
bystsiweb
 
PPT
DIAPOSITIVAS
byMARELY
 
Reclamos
byEmosane Esther
 
Increible1
bydhuerta21
 
Hist Inter2
byAna Valentina
 
Tu mayor tesoro
byEmosane Esther
 
Semillas
byEmosane Esther
 
Perspectives des de Catalunya en formació
bystsiweb
 
DIAPOSITIVAS
byMARELY
 

Similar to YAPC::NA 2007 - Customizing And Extending Perl Critic

ODP
Extending Perl Critic
byjoshua.mcadams
 
ODP
YAPC::NA 2007 - An Introduction To Perl Critic
byjoshua.mcadams
 
ODP
Modern Perl
byMarcos Rebelo
 
ODP
An Introduction To Perl Critic
byjoshua.mcadams
 
ODP
Advanced Perl Techniques
byDave Cross
 
PDF
Utility Modules That You Should Know About
byjoshua.mcadams
 
PDF
Good Evils In Perl
byKang-min Liu
 
KEY
Good Evils In Perl (Yapc Asia)
byKang-min Liu
 
PDF
Barely Legal Xxx Perl Presentation
byAttila Balazs
 
PDF
Benchmarking Perl (Chicago UniForum 2006)
bybrian d foy
 
PDF
Keeping objects healthy with Object::Exercise.
byWorkhorse Computing
 
ODP
Владимир Перепелица "Модули"
byMedia Gorod
 
ODP
What's new in Perl 5.10?
byacme
 
PPTX
Lecture 3 Perl & FreeBSD administration
byMohammed Farrag
 
PPT
Cleancode
byhendrikvb
 
PDF
The $path to knowledge: What little it take to unit-test Perl.
byWorkhorse Computing
 
PDF
Perl-Critic
byJonas Brømsø
 
PDF
Perl 6 by example
byAndrew Shitov
 
PPT
Perl Tidy Perl Critic
byolegmmiller
 
PDF
Perl::Lint - Yet Another Perl Source Code Linter
bymoznion
 
Extending Perl Critic
byjoshua.mcadams
 
YAPC::NA 2007 - An Introduction To Perl Critic
byjoshua.mcadams
 
Modern Perl
byMarcos Rebelo
 
An Introduction To Perl Critic
byjoshua.mcadams
 
Advanced Perl Techniques
byDave Cross
 
Utility Modules That You Should Know About
byjoshua.mcadams
 
Good Evils In Perl
byKang-min Liu
 
Good Evils In Perl (Yapc Asia)
byKang-min Liu
 
Barely Legal Xxx Perl Presentation
byAttila Balazs
 
Benchmarking Perl (Chicago UniForum 2006)
bybrian d foy
 
Keeping objects healthy with Object::Exercise.
byWorkhorse Computing
 
Владимир Перепелица "Модули"
byMedia Gorod
 
What's new in Perl 5.10?
byacme
 
Lecture 3 Perl & FreeBSD administration
byMohammed Farrag
 
Cleancode
byhendrikvb
 
The $path to knowledge: What little it take to unit-test Perl.
byWorkhorse Computing
 
Perl-Critic
byJonas Brømsø
 
Perl 6 by example
byAndrew Shitov
 
Perl Tidy Perl Critic
byolegmmiller
 
Perl::Lint - Yet Another Perl Source Code Linter
bymoznion
 

Recently uploaded

PDF
The Ultimate Guide to Problem Management Dashboards for IT Teams.pdf
byomnex systems
 
PDF
Top 7 Manufacturing Software for Small Businesses Boosting Growth in 2025
byEnvertis Software Solutions
 
PDF
Agentic Automation for Testers – A Hands-On Deep Dive
byUiPathCommunity
 
PDF
Incident Response Planning with a Foundation Model
byKim Hammar
 
PDF
Safeguarding AI-Based Financial Infrastructure
bysleepandremedies
 
PDF
ElyriaSoftware — Powering the Future with Blockchain Innovation
byElyria Software
 
PDF
Generative AI in 2026: Hype, Bubble, Winter or The Real Deal?
byDr. Tathagat Varma
 
PDF
Taming the Chaos: How to Turn Unstructured Data into Decisions
bySafe Software
 
PDF
eResource Scheduler Enterprise Resource Management and Scheduling Software.pdf
byeResource Scheduler
 
PDF
TPPmark2025 Kenta Inoue's answer 12/04/2025
byKenta Inoue
 
PDF
Zero Trust & Defense-in-Depth: The Future of Critical Infrastructure Security
bysleepandremedies
 
PPTX
Ritesh_kumar_Aatmanirbhar Bharat: Make in India, Make for the World.pptx
byriteshrkgs2008
 
PDF
Accelerating Responsible AI Adoption in Public Sector and Private Organizations.
bysleepandremedies
 
PDF
HCI and Its Impact on individual quality of life.pdf
byParham Abolghasemi
 
DOCX
Introduction to the World of Computers (Hardware & Software)
byALIABBAS ABASOV
 
PPTX
TCP/IP Presentation - Information Systems & Operations Management
byadriangallianispetka
 
PDF
Cybersecurity Prevention and Detection Specialization
byVICTOR MAESTRE RAMIREZ
 
PDF
DevSecOps Learning Path - TryHackMe Certificate
byVICTOR MAESTRE RAMIREZ
 
PPTX
The Future of IT Service Management AI Automation & Beyond.pptx
byChetu
 
PDF
AI and Computer Architecture: 200 Years Together
byDmitry Zinoviev
 
The Ultimate Guide to Problem Management Dashboards for IT Teams.pdf
byomnex systems
 
Top 7 Manufacturing Software for Small Businesses Boosting Growth in 2025
byEnvertis Software Solutions
 
Agentic Automation for Testers – A Hands-On Deep Dive
byUiPathCommunity
 
Incident Response Planning with a Foundation Model
byKim Hammar
 
Safeguarding AI-Based Financial Infrastructure
bysleepandremedies
 
ElyriaSoftware — Powering the Future with Blockchain Innovation
byElyria Software
 
Generative AI in 2026: Hype, Bubble, Winter or The Real Deal?
byDr. Tathagat Varma
 
Taming the Chaos: How to Turn Unstructured Data into Decisions
bySafe Software
 
eResource Scheduler Enterprise Resource Management and Scheduling Software.pdf
byeResource Scheduler
 
TPPmark2025 Kenta Inoue's answer 12/04/2025
byKenta Inoue
 
Zero Trust & Defense-in-Depth: The Future of Critical Infrastructure Security
bysleepandremedies
 
Ritesh_kumar_Aatmanirbhar Bharat: Make in India, Make for the World.pptx
byriteshrkgs2008
 
Accelerating Responsible AI Adoption in Public Sector and Private Organizations.
bysleepandremedies
 
HCI and Its Impact on individual quality of life.pdf
byParham Abolghasemi
 
Introduction to the World of Computers (Hardware & Software)
byALIABBAS ABASOV
 
TCP/IP Presentation - Information Systems & Operations Management
byadriangallianispetka
 
Cybersecurity Prevention and Detection Specialization
byVICTOR MAESTRE RAMIREZ
 
DevSecOps Learning Path - TryHackMe Certificate
byVICTOR MAESTRE RAMIREZ
 
The Future of IT Service Management AI Automation & Beyond.pptx
byChetu
 
AI and Computer Architecture: 200 Years Together
byDmitry Zinoviev
 

YAPC::NA 2007 - Customizing And Extending Perl Critic

  • 1.
    Customizing and Extending Perl Critic YAPC::NA 2007 Houston, TX Josh McAdams
  • 2.
    Extending Perl CriticPerl Critic is a very powerful and customizable system in its off-the-CPAN state; however, there are times when you need to create your own policies to enforce your own coding standards. We will see how to do that by creating a variant of one of the core modules: BuiltinFunctions::RequireBlockGrep . We'll call our policy BuiltinFunctions::RequireBlockGrepAndMap and make it force block map s in addition to grep s.
  • 3.
    Extending Perl Criticuse strict; use warnings; use Test::More tests => 1; use_ok( 'Perl::Critic::Policy::' . 'BuiltinFunctions::RequireBlockGrepAndMap' ); t/initial-setup.t
  • 4.
    Extending Perl Critic--(0)> prove -Ilib t/initial-setup.t t/initial-setup.... # Failed test 'use Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap;' # at t/initial-setup.t line 5. # Tried to use 'Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap'. # Error: Can't locate Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm in @INC (...) line 2. # BEGIN failed--compilation aborted at t/initial-setup.t line 5. # Looks like you failed 1 test of 1. t/initial-setup....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 1 Failed 1/1 tests, 0.00% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/initial-setup.t 1 256 1 1 1 Failed 1/1 test scripts. 1/1 subtests failed. Files=1, Tests=1, 0 wallclock secs ( 0.04 cusr + 0.02 csys = 0.06 CPU) Failed 1/1 test programs. 1/1 subtests failed.
  • 5.
    Extending Perl Criticpackage Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap ; use warnings; use strict; 1; lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 6.
    Extending Perl Critic--(0)> prove -Ilib t/* t/initial-setup....ok All tests successful.
  • 7.
    Extending Perl Criticuse strict; use warnings; use Test::More tests => 2; use_ok( 'Perl::Critic::Policy::' . 'BuiltinFunctions::RequireBlockGrepAndMap' ); my $policy = Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap ->new(); is($policy->get_severity(), 4, 'high severity set'); t/initial-setup.t
  • 8.
    Extending Perl Critic--(0)> prove -Ilib t/* t/initial-setup....Can't locate object method &quot;new&quot; via package &quot;Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap&quot; at t/initial-setup.t line 10. # Looks like you planned 2 tests but only ran 1. # Looks like your test died just after 1. t/initial-setup....dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED test 2 Failed 1/2 tests, 50.00% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/initial-setup.t 255 65280 2 2 2 Failed 1/1 test scripts. 1/2 subtests failed. Files=1, Tests=2, 0 wallclock secs ( 0.04 cusr + 0.02 csys = 0.06 CPU) Failed 1/1 test programs. 1/2 subtests failed.
  • 9.
    Extending Perl Criticpackage Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap; use warnings; use strict; use base qw(Perl::Critic::Policy); use Perl::Critic::Utils; sub new { my ($class, %args) = @_; return $class->SUPER::new(%args); } sub default_severity { return $SEVERITY_HIGH; } 1; lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 10.
    Extending Perl Critic--(0)> prove -Ilib t/* t/initial-setup....ok All tests successful. Files=1, Tests=2, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU)
  • 11.
    Extending Perl CriticSeverity Level Variables Exported By Perl::Critic::Utils $SEVERITY_HIGHEST == 5 $SEVERITY_HIGH == 4 $SEVERITY_MEDIUM == 3 $SEVERITY_LOW == 2 $SEVERITY_LOWEST == 1
  • 12.
    Extending Perl Critic... is_deeply( [$policy->get_themes()], [qw(almost_core pbp)], 'proper themes set' ); t/initial-setup.t
  • 13.
    Extending Perl Critic--(0)> prove -Ilib t/* t/initial-setup....NOK 3 # Failed test 'proper themes set' # at t/initial-setup.t line 16. # Structures begin differing at: # $got->[0] = Does not exist # $expected->[0] = 'almost_core' # Looks like you failed 1 test of 3. t/initial-setup....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 3 Failed 1/3 tests, 66.67% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/initial-setup.t 1 256 3 1 3 Failed 1/1 test scripts. 1/3 subtests failed. Files=1, Tests=3, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU) Failed 1/1 test programs. 1/3 subtests failed.
  • 14.
    Extending Perl Criticsub default_themes { return qw( almost_core pbp ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 15.
    Extending Perl Critic--(0)> prove -Ilib t/* t/initial-setup....ok All tests successful. Files=1, Tests=3, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU)
  • 16.
    Extending Perl Critic... is_deeply( [$policy->applies_to()], [qw(PPI::Token::Word)], 'applies only to words' ); t/initial-setup.t
  • 17.
    Extending Perl Critic--(0)> prove -Ilib t/* t/initial-setup....NOK 4 # Failed test 'applies only to words' # at t/initial-setup.t line 18. # Structures begin differing at: # $got->[0] = 'PPI::Element' # $expected->[0] = 'PPI::Token::Word' # Looks like you failed 1 test of 4. t/initial-setup....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 4 Failed 1/4 tests, 75.00% okay Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/initial-setup.t 1 256 4 1 4 Failed 1/1 test scripts. 1/4 subtests failed. Files=1, Tests=4, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU) Failed 1/1 test programs. 1/4 subtests failed.
  • 18.
    Extending Perl Criticsub applies_to { return 'PPI::Token::Word'; } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 19.
    Extending Perl Critic--(0)> prove -Ilib t/* t/initial-setup....ok All tests successful. Files=1, Tests=4, 0 wallclock secs ( 0.12 cusr + 0.03 csys = 0.15 CPU)
  • 20.
    Extending Perl CriticPPI::Document PPI::Document::File PPI::Document::Fragment PPI::Document::Normalized PPI::Element PPI::Statement PPI::Statement::Break PPI::Statement::Compound PPI::Statement::Data PPI::Statement::End PPI::Statement::Expression PPI::Statement::Include PPI::Statement::Null PPI::Statement::Package PPI::Statement::Scheduled PPI::Statement::Sub PPI::Statement::Unknown PPI::Statement::UnmatchedBrace PPI::Statement::Variable PPI::Structure PPI::Structure::Block PPI::Structure::Condition PPI::Structure::Constructor PPI::Token::Quote::Single PPI::Token::QuoteLike PPI::Token::QuoteLike::Backtick PPI::Token::QuoteLike::Command PPI::Token::QuoteLike::Readline PPI::Token::QuoteLike::Regexp PPI::Token::QuoteLike::Words PPI::Token::Regexp PPI::Token::Regexp::Match PPI::Token::Regexp::Substitute PPI::Token::Regexp::Transliterate PPI::Token::Separator PPI::Token::Structure PPI::Token::Symbol PPI::Token::Unknown PPI::Token::Whitespace PPI::Token::Word PPI::Structure::ForLoop PPI::Structure::List PPI::Structure::Subscript PPI::Structure::Unknown PPI::Token PPI::Token::ArrayIndex PPI::Token::Attribute PPI::Token::Cast PPI::Token::Comment PPI::Token::DashedWord PPI::Token::Data PPI::Token::End PPI::Token::HereDoc PPI::Token::Label PPI::Token::Magic PPI::Token::Number PPI::Token::Operator PPI::Token::Pod PPI::Token::Prototype PPI::Token::Quote PPI::Token::Quote::Double PPI::Token::Quote::Interpolate PPI::Token::Quote::Literal PPI Modules
  • 21.
    Extending Perl Criticuse warnings; use strict; use Test::More tests => 1; use Perl::Critic::TestUtils qw(pcritique); my $custom_policy = 'BuiltinFunctions::RequireBlockGrepAndMap'; my $code = 'grep { $_ }'; my $violation_count = pcritique( $custom_policy, \$code ); ok(!$violation_count, 'allowed block grep'); t/exercise-policy.t
  • 22.
    Extending Perl CriticSome Perl::Critic::TestUtils Help Methods - block_perlcriticrc - critique - pcritique - fcritique
  • 23.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....Can't call abstract method at /opt/local/lib/perl5/site_perl/5.8.7/Perl/Critic/Policy.pm line 98 Perl::Critic::Policy::violates('Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMa...', 'PPI::Token::Word=HASH(0x1a01b40)', 'Perl::Critic::Document=HASH(0x183d338)') called at /opt/local/lib/perl5/site_perl/5.8.7/Perl/Critic.pm line 165 Perl::Critic::_critique('Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMa...', 'Perl::Critic::Document=HASH(0x183d338)', 'HASH(0x19fc194)') called at /opt/local/lib/perl5/site_perl/5.8.7/Perl/Critic.pm line 121 Perl::Critic::critique('Perl::Critic=HASH(0x1800f88)', 'SCALAR(0x1810eac)') called at /opt/local/lib/perl5/site_perl/5.8.7/Perl/Critic/TestUtils.pm line 53 Perl::Critic::TestUtils::pcritique('BuiltinFunctions::RequireBlockGrepAndMap', 'SCALAR(0x1810eac)') called at t/exercise-policy.t line 9 # Looks like your test died before it could output anything. t/exercise-policy....dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED test 1 Failed 1/1 tests, 0.00% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 255 65280 1 2 1 Failed 1/2 test scripts. 1/5 subtests failed. Files=2, Tests=5, 1 wallclock secs ( 0.99 cusr + 0.24 csys = 1.23 CPU) Failed 1/2 test programs. 1/5 subtests failed.
  • 24.
    Extending Perl Criticsub violates {} lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 25.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=5, 2 wallclock secs ( 0.98 cusr + 0.22 csys = 1.20 CPU)
  • 26.
    Extending Perl Criticmy $custom_policy = 'BuiltinFunctions::RequireBlockGrepAndMap'; { my $code = 'grep { $_ }'; my $violation_count = pcritique( $custom_policy, \$code ); is($violation_count, 0, 'allowed block grep'); } { my $code = 'grep &quot;$_&quot;'; my $violation_count = pcritique( $custom_policy, \$code ); is($violation_count, 1, 'disallowed string grep'); } t/exercise-policy.t
  • 27.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....NOK 2 # Failed test 'disallowed string grep' # at t/exercise-policy.t line 17. # got: '0' # expected: '1' # Looks like you failed 1 test of 2. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 2 Failed 1/2 tests, 50.00% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 2 1 2 Failed 1/2 test scripts. 1/6 subtests failed. Files=2, Tests=6, 2 wallclock secs ( 1.00 cusr + 0.22 csys = 1.22 CPU) Failed 1/2 test programs. 1/6 subtests failed.
  • 28.
    Extending Perl Criticmy $description = q{Expression form of &quot;grep&quot; and &quot;map&quot;}; my $explanation = [169]; sub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; my $sibling = $element->snext_sibling(); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 29.
    Extending Perl Critict/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=6, 1 wallclock secs ( 1.00 cusr + 0.22 csys = 1.22 CPU)
  • 30.
    Extending Perl CriticSome PPI Utility Methods (from PPI::Element) - parent - next_sibling - snext_sibling - previous_sibling - sprevious_sibling - first_token - last_token - next_token - previous_token
  • 31.
    Extending Perl Criticuse warnings; use strict; use Test::More; use Perl::Critic::TestUtils qw(subtests_in_tree fcritique pcritique); my $custom_policy = 'BuiltinFunctions::RequireBlockGrepAndMap'; my $subtests = subtests_in_tree('t/BuiltinFunctions'); my $test_count = 0; $test_count += @{$subtests->{$_}} for ( keys %{$subtests} ); plan tests => $test_count; ... t/exercise-policy.t
  • 32.
    Extending Perl Criticfor my $policy ( sort keys %$subtests ) { for my $subtest ( @{ $subtests->{$policy} } ) { local $TODO = $subtest->{TODO}; my $desc = join( ' - ', $policy, &quot;line $subtest->{lineno}&quot;, $subtest->{name} ); my $violations = $subtest->{filename} ? eval { fcritique( $policy, \$subtest->{code}, $subtest->{filename}, $subtest->{parms} ); } : eval { pcritique( $policy, \$subtest->{code}, $subtest->{parms} ) }; my $err = $@; if ( $subtest->{error} ) { if ( 'Regexp' eq ref $subtest->{error} ) { like( $err, $subtest->{error}, $desc ); } else { ok( $err, $desc ); } } else { die $err if $err; is( $violations, $subtest->{failures}, $desc ); } } } t/exercise-policy.t
  • 33.
    Extending Perl Critic## name allowed block grep ## failures 0 ## cut grep { $_ } ## name disallowed string grep ## failures 1 ## cut grep &quot;$_&quot; t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 34.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=6, 2 wallclock secs ( 1.01 cusr + 0.22 csys = 1.23 CPU)
  • 35.
    Extending Perl Critic## name A Test Name ## parms { allow_y => 0 } ## TODO Should pass later ## error 1 ## error /Can't load Foo::Bar/ ## filename lib/Foo/Bar.pm ## cut Options For .run Files
  • 36.
    Extending Perl Critic... ## name grep as a method call ## failures 0 ## cut $object->grep('this'); t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 37.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....NOK 3 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 13 - grep as a method call' # at t/exercise-policy.t line 41. # got: '1' # expected: '0' # Looks like you failed 1 test of 3. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 3 Failed 1/3 tests, 66.67% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 3 1 3 Failed 1/2 test scripts. 1/7 subtests failed. Files=2, Tests=7, 2 wallclock secs ( 1.00 cusr + 0.24 csys = 1.24 CPU) Failed 1/2 test programs. 1/7 subtests failed.
  • 38.
    Extending Perl Criticuse Perl::Critic::Utils; ... sub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; return if is_method_call($element); my $sibling = $element->snext_sibling(); return if $sibling ->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 39.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=7, 2 wallclock secs ( 1.01 cusr + 0.24 csys = 1.25 CPU)
  • 40.
    Extending Perl CriticSome Useful Methods From Perl::Critic::Utils - is_perl_global - is_perl_builtin - is_hash_key - is_method_call - is_subroutine_name - is_function_call - first_arg - parse_arg_list
  • 41.
    Extending Perl Critic... ## name grep as a hash key ## failures 0 ## cut $my_hash{ grep } = 1; t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 42.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok 1/4Can't call method &quot;isa&quot; without a package or object reference at lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm line 36. # Looks like you planned 4 tests but only ran 3. # Looks like your test died just after 3. t/exercise-policy....dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED test 4 Failed 1/4 tests, 75.00% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 255 65280 4 2 4 Failed 1/2 test scripts. 1/8 subtests failed. Files=2, Tests=8, 1 wallclock secs ( 1.00 cusr + 0.22 csys = 1.22 CPU) Failed 1/2 test programs. 1/8 subtests failed.
  • 43.
    Extending Perl Criticsub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; return if is_method_call($element); return if is_hash_key($element); my $sibling = $element->snext_sibling(); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 44.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=8, 2 wallclock secs ( 1.02 cusr + 0.25 csys = 1.27 CPU)
  • 45.
    Extending Perl Critic... ## name grep is a sub name ## failures 0 ## cut sub grep { return } t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 46.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=9, 2 wallclock secs ( 1.02 cusr + 0.22 csys = 1.24 CPU)
  • 47.
    Extending Perl Critic... ## name grep is a sub prototype name ## failures 0 ## cut sub grep; t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 48.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....NOK 6 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 31 - grep is a sub prototype name' # at t/exercise-policy.t line 41. # got: '1' # expected: '0' # Looks like you failed 1 test of 6. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 6 Failed 1/6 tests, 83.33% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 6 1 6 Failed 1/2 test scripts. 1/10 subtests failed. Files=2, Tests=10, 1 wallclock secs ( 1.04 cusr + 0.22 csys = 1.26 CPU) Failed 1/2 test programs. 1/10 subtests failed.
  • 49.
    Extending Perl Criticsub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; return if is_method_call($element); return if is_hash_key($element); return if is_subroutine_name($element); my $sibling = $element->snext_sibling(); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 50.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=10, 2 wallclock secs ( 1.02 cusr + 0.22 csys = 1.24 CPU)
  • 51.
    Extending Perl Critic... ## name grep has parens ## failures 0 ## cut grep ( { $_ } @list ); t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 52.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....NOK 7 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 37 - grep has parens' # at t/exercise-policy.t line 41. # got: '1' # expected: '0' # Looks like you failed 1 test of 7. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 7 Failed 1/7 tests, 85.71% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 7 1 7 Failed 1/2 test scripts. 1/11 subtests failed. Files=2, Tests=11, 2 wallclock secs ( 1.03 cusr + 0.22 csys = 1.25 CPU) Failed 1/2 test programs. 1/11 subtests failed.
  • 53.
    Extending Perl Criticsub violates { my ( $self, $element, $document ) = @_; return unless $element eq 'grep'; return if is_method_call($element); return if is_hash_key($element); return if is_subroutine_name($element); my $sibling = $element->snext_sibling(); $sibling = $sibling->schild(0) if $sibling->isa('PPI::Structure::List'); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 54.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=11, 2 wallclock secs ( 1.04 cusr + 0.24 csys = 1.28 CPU)
  • 55.
    Extending Perl Critic... ## name block map ## failures 0 ## cut map { $_ } t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 56.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=12, 2 wallclock secs ( 1.04 cusr + 0.22 csys = 1.26 CPU)
  • 57.
    Extending Perl Critic... ## name string map ## failures 1 ## cut map &quot;$_&quot; t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 58.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....NOK 9 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 49 - string map' # at t/exercise-policy.t line 41. # got: '0' # expected: '1' # Looks like you failed 1 test of 9. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 9 Failed 1/9 tests, 88.89% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 9 1 9 Failed 1/2 test scripts. 1/13 subtests failed. Files=2, Tests=13, 1 wallclock secs ( 1.05 cusr + 0.22 csys = 1.27 CPU) Failed 1/2 test programs. 1/13 subtests failed.
  • 59.
    Extending Perl Criticsub violates { my ( $self, $element, $document ) = @_; return unless grep { $element eq $_ } qw[grep map]; return if is_method_call($element); return if is_hash_key($element); return if is_subroutine_name($element); my $sibling = $element->snext_sibling(); $sibling = $sibling->schild(0) if $sibling->isa('PPI::Structure::List'); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 60.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=13, 1 wallclock secs ( 1.05 cusr + 0.23 csys = 1.28 CPU)
  • 61.
    Extending Perl Critic... ## name string map allowed ## failures 0 ## parms { allow => ['map'] } ## cut map &quot;$_&quot; t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 62.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....NOK 10 # Failed test 'BuiltinFunctions::RequireBlockGrepAndMap - line 55 - string map allowed' # at t/exercise-policy.t line 41. # got: '1' # expected: '0' # Looks like you failed 1 test of 10. t/exercise-policy....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 10 Failed 1/10 tests, 90.00% okay t/initial-setup......ok Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/exercise-policy.t 1 256 10 1 10 Failed 1/2 test scripts. 1/14 subtests failed. Files=2, Tests=14, 2 wallclock secs ( 1.05 cusr + 0.22 csys = 1.27 CPU) Failed 1/2 test programs. 1/14 subtests failed.
  • 63.
    Extending Perl Criticsub new { my ($class, %args) = @_; my $self = $class->SUPER::new(%args); $args{allow} = [] unless exists $args{allow}; for my $function (qw(grep map)) { push @{$self->{filter}}, $function unless grep { $_ eq $function } @{$args{allow}}; } return $self; } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 64.
    Extending Perl Criticsub violates { my ( $self, $element, $document ) = @_; return unless grep { $element eq $_ } @{$self->{filter} || []}; return if is_method_call($element); return if is_hash_key($element); return if is_subroutine_name($element); my $sibling = $element->snext_sibling(); $sibling = $sibling->schild(0) if $sibling->isa('PPI::Structure::List'); return if $sibling->isa('PPI::Structure::Block'); return $self->violation( $description, $explanation, $element, ); } lib/Perl/Critic/Policy/BuiltinFunctions/RequireBlockGrepAndMap.pm
  • 65.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=14, 2 wallclock secs ( 1.06 cusr + 0.24 csys = 1.30 CPU)
  • 66.
    Extending Perl Critic... ## name string grep allowed ## failures 0 ## parms { allow => ['grep'] } ## cut grep &quot;$_&quot; ## name string grep and map allowed ## failures 0 ## parms { allow => ['grep', 'map'] } ## cut grep &quot;$_&quot;; map &quot;$_&quot;; ## name string grep and map not allowed ## failures 2 ## cut grep &quot;$_&quot;; map &quot;$_&quot;; t/BuiltinFunctions/RequireBlockGrepAndMap.run
  • 67.
    Extending Perl Critic--(0)> prove -Ilib t/* t/exercise-policy....ok t/initial-setup......ok All tests successful. Files=2, Tests=17, 2 wallclock secs ( 1.08 cusr + 0.22 csys = 1.30 CPU)
  • 68.
    Extending Perl CriticThat's it for coding our module. We could of course add some POD. =pod =head1 NAME Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrepAndMap =head1 DESCRIPTION The expression form of C<grep> and C<map> is awkward and hard to read. Use the block forms instead. @matches = grep /pattern/, @list; #not ok @matches = grep { /pattern/ } @list; #ok @mapped = map transform($_), @list; #not ok @mapped = map { transform($_) } @list; #ok =cut
  • 69.
    Extending Perl Critic... and more tests!
  • 70.
    Extending Perl Critic- Use Perl::Critic::TestUtils to test your policies - Have your policies subclass Perl::Critic::Policy - Set a default severity for your policies - Set a default tag set for your policies - Configure your policy to apply to specific PPI elements - Create a violates subroutine that does your validation and throws a Perl::Critic::Violation when the policy finds a problem - Use Perl::Critic::Utils to help create your policy - User PPI::Element methods to traverse the PPI DOM In Review