vcs.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/InputOutput/ProhibitJoinedReadline.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/InputOutput/ProhibitJoinedReadline.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::InputOutput::ProhibitJoinedReadline;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14 use List::MoreUtils qw(any);
  15
  16 use Perl::Critic::Utils qw{ :severities :classification parse_arg_list };
  17 use base 'Perl::Critic::Policy';
  18
  19 our $VERSION = '1.088';
  20
  21 #-----------------------------------------------------------------------------
  22
  23 Readonly::Scalar my $DESC => q{Use "local $/ = undef" or File::Slurp instead of joined readline}; ##no critic qw(Interpolation)
  24 Readonly::Scalar my $EXPL => [213];
  25
  26 #-----------------------------------------------------------------------------
  27
  28 sub supported_parameters { return ()                     }
  29 sub default_severity     { return $SEVERITY_MEDIUM       }
  30 sub default_themes       { return qw( core pbp performance ) }
  31 sub applies_to           { return 'PPI::Token::Word'     }
  32
  33 #-----------------------------------------------------------------------------
  34
  35 sub violates {
  36     my ( $self, $elem, undef ) = @_;
  37
  38     return if $elem ne 'join';
  39     return if ! is_function_call($elem);
  40     my @args = parse_arg_list($elem);
  41     shift @args; # ignore separator string
  42
  43     if (any { any { $_->isa('PPI::Token::QuoteLike::Readline') } @{$_} } @args) {
  44        return $self->violation( $DESC, $EXPL, $elem );
  45     }
  46
  47     return;  # OK
  48 }
  49
  50
  51 1;
  52
  53 __END__
  54
  55 #-----------------------------------------------------------------------------
  56
  57 =pod
  58
  59 =head1 NAME
  60
  61 Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline - Use C<local $/ = undef> or L<File::Slurp> instead of joined readline.
  62
  63 =head1 AFFILIATION
  64
  65 This Policy is part of the core L<Perl::Critic> distribution.
  66
  67
  68 =head1 DESCRIPTION
  69
  70 It's really easy to slurp a whole filehandle in at once with C<join
  71 q{}, <$fh>>, but that's inefficient -- Perl goes to the trouble of
  72 splitting the file into lines only to have that work thrown away.
  73
  74 To save performance, either slurp the filehandle without splitting like so:
  75
  76   do { local $/ = undef; <$fh> }
  77
  78 or use L<File::Slurp>, which is even faster.
  79
  80
  81 =head1 CONFIGURATION
  82
  83 This Policy is not configurable except for the standard options.
  84
  85
  86 =head1 CAVEATS
  87
  88 Due to a bug in the current version of PPI (v1.119_03) and earlier,
  89 the readline operator is often misinterpreted as less-than and
  90 greater-than operators after a comma.  Therefore, this policy only
  91 works well on the empty filehandle, C<<>>.  When PPI is fixed, this
  92 should just start working.
  93
  94 =head1 CREDITS
  95
  96 Initial development of this policy was supported by a grant from the Perl Foundation.
  97
  98 =head1 AUTHOR
  99
 100 Chris Dolan <cdolan@cpan.org>
 101
 102 =head1 COPYRIGHT
 103
 104 Copyright (c) 2007-2008 Chris Dolan.  Many rights reserved.
 105
 106 This program is free software; you can redistribute it and/or modify
 107 it under the same terms as Perl itself.  The full text of this license
 108 can be found in the LICENSE file included with this module
 109
 110 =cut
 111
 112 # Local Variables:
 113 #   mode: cperl
 114 #   cperl-indent-level: 4
 115 #   fill-column: 78
 116 #   indent-tabs-mode: nil
 117 #   c-indentation-style: bsd
 118 # End:
 119 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :