git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/BuiltinFunctions/RequireSimpleSortBlock.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/BuiltinFunctions/RequireSimpleSortBlock.pm $
   3 #     $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities :classification };
  16 use base 'Perl::Critic::Policy';
  17
  18 our $VERSION = '1.088';
  19
  20 #-----------------------------------------------------------------------------
  21
  22 Readonly::Scalar my $DESC => q{Sort blocks should have a single statement};
  23 Readonly::Scalar my $EXPL => [ 149 ];
  24
  25 #-----------------------------------------------------------------------------
  26
  27 sub supported_parameters { return ()                                   }
  28 sub default_severity     { return $SEVERITY_MEDIUM                     }
  29 sub default_themes       { return qw( core pbp maintenance complexity) }
  30 sub applies_to           { return 'PPI::Token::Word'                   }
  31
  32 #-----------------------------------------------------------------------------
  33
  34 sub violates {
  35     my ( $self, $elem, undef ) = @_;
  36
  37     return if $elem ne 'sort';
  38     return if ! is_function_call($elem);
  39
  40     my $sib = $elem->snext_sibling();
  41     return if !$sib;
  42
  43     my $arg = $sib;
  44     if ( $arg->isa('PPI::Structure::List') ) {
  45         $arg = $arg->schild(0);
  46         # Forward looking: PPI might change in v1.200 so schild(0) is a PPI::Statement::Expression
  47         if ( $arg && $arg->isa('PPI::Statement::Expression') ) {
  48             $arg = $arg->schild(0);
  49         }
  50     }
  51     return if !$arg || !$arg->isa('PPI::Structure::Block');
  52
  53     # If we get here, we found a sort with a block as the first arg
  54     return if ( 1 >= $arg->schildren() );
  55
  56     # more than one child statements
  57     return $self->violation( $DESC, $EXPL, $elem );
  58 }
  59
  60 1;
  61
  62 #-----------------------------------------------------------------------------
  63
  64 __END__
  65
  66 =pod
  67
  68 =head1 NAME
  69
  70 Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock - Sort blocks should have a single statement.
  71
  72 =head1 AFFILIATION
  73
  74 This Policy is part of the core L<Perl::Critic> distribution.
  75
  76
  77 =head1 DESCRIPTION
  78
  79 Conway advises that sort functions should be simple.  Any complicated
  80 operations on list elements should be computed and cached (perhaps via
  81 a Schwartzian Transform) before the sort, rather than computed inside
  82 the sort block, because the sort block is called C<N log N> times
  83 instead of just C<N> times.
  84
  85 This policy prohibits the most blatant case of complicated sort
  86 blocks: multiple statements.  Future policies may wish to examine the
  87 sort block in more detail -- looking for subroutine calls or large
  88 numbers of operations.
  89
  90
  91 =head1 CONFIGURATION
  92
  93 This Policy is not configurable except for the standard options.
  94
  95
  96 =head1 AUTHOR
  97
  98 Chris Dolan <cdolan@cpan.org>
  99
 100 =head1 COPYRIGHT
 101
 102 Copyright (C) 2006 Chris Dolan.  All rights reserved.
 103
 104 This program is free software; you can redistribute it and/or modify
 105 it under the same terms as Perl itself.
 106
 107 =cut
 108
 109 # Local Variables:
 110 #   mode: cperl
 111 #   cperl-indent-level: 4
 112 #   fill-column: 78
 113 #   indent-tabs-mode: nil
 114 #   c-indentation-style: bsd
 115 # End:
 116 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :