vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/InputOutput/RequireBracedFileHandleWithPrint.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/InputOutput/RequireBracedFileHandleWithPrint.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::RequireBracedFileHandleWithPrint;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities :classification :data_conversion };
  16 use base 'Perl::Critic::Policy';
  17
  18 our $VERSION = '1.088';
  19
  20 #-----------------------------------------------------------------------------
  21
  22 Readonly::Array my @POSTFIX_WORDS => qw( if unless for );
  23 Readonly::Hash my %POSTFIX_WORDS => hashify( @POSTFIX_WORDS );
  24
  25 Readonly::Scalar my $DESC => q{File handle for "print" is not braced};
  26 Readonly::Scalar my $EXPL => [ 217 ];
  27
  28 #-----------------------------------------------------------------------------
  29
  30 sub supported_parameters { return ()                      }
  31 sub default_severity     { return $SEVERITY_LOWEST        }
  32 sub default_themes       { return qw( core pbp cosmetic ) }
  33 sub applies_to           { return 'PPI::Token::Word'      }
  34
  35 #-----------------------------------------------------------------------------
  36
  37 sub violates {
  38     my ( $self, $elem, undef ) = @_;
  39
  40     return if $elem ne 'print';
  41     return if ! is_function_call($elem);
  42
  43     my @sib;
  44
  45     $sib[0] = $elem->snext_sibling();
  46     return if !$sib[0];
  47
  48     # Deal with situations where 'print' is called with parentheses
  49     if ( $sib[0]->isa('PPI::Structure::List') ) {
  50         my $expr = $sib[0]->schild(0);
  51         return if !$expr;
  52         $sib[0] = $expr->schild(0);
  53         return if !$sib[0];
  54     }
  55
  56     $sib[1] = $sib[0]->next_sibling();
  57     return if !$sib[1];
  58     $sib[2] = $sib[1]->next_sibling();
  59     return if !$sib[2];
  60
  61     # First token must be a scalar symbol or bareword;
  62     return if !( ($sib[0]->isa('PPI::Token::Symbol') && $sib[0] =~ m/\A \$/mx)
  63                  || $sib[0]->isa('PPI::Token::Word') );
  64
  65     # First token must not be a builtin function or control
  66     return if is_perl_builtin($sib[0]);
  67     return if exists $POSTFIX_WORDS{ $sib[0] };
  68
  69     # Second token must be white space
  70     return if !$sib[1]->isa('PPI::Token::Whitespace');
  71
  72     # Third token must not be an operator
  73     return if $sib[2]->isa('PPI::Token::Operator');
  74
  75     # Special case for postfix controls
  76     return if exists $POSTFIX_WORDS{ $sib[2] };
  77
  78     return if $sib[0]->isa('PPI::Structure::Block');
  79
  80     return $self->violation( $DESC, $EXPL, $elem );
  81 }
  82
  83 1;
  84
  85 __END__
  86
  87 #-----------------------------------------------------------------------------
  88
  89 =pod
  90
  91 =head1 NAME
  92
  93 Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint - Write C<print {$FH} $foo, $bar;> instead of C<print $FH $foo, $bar;>.
  94
  95 =head1 AFFILIATION
  96
  97 This Policy is part of the core L<Perl::Critic> distribution.
  98
  99
 100 =head1 DESCRIPTION
 101
 102 The C<print> function has a unique syntax that supports an optional
 103 file handle argument.  Conway suggests wrapping this argument in
 104 braces to make it visually stand out from the other arguments.  When
 105 you put braces around any of the special package-level file handles
 106 like C<STDOUT>, C<STDERR>, and C<DATA>, you must the C<'*'> sigil or
 107 else it won't compile under C<use strict 'subs'>.
 108
 109   print $FH   "Mary had a little lamb\n";  #not ok
 110   print {$FH} "Mary had a little lamb\n";  #ok
 111
 112   print   STDERR   $foo, $bar, $baz;  #not ok
 113   print  {STDERR}  $foo, $bar, $baz;  #won't compile under 'strict'
 114   print {*STDERR}  $foo, $bar, $baz;  #perfect!
 115
 116
 117 =head1 CONFIGURATION
 118
 119 This Policy is not configurable except for the standard options.
 120
 121
 122 =head1 AUTHOR
 123
 124 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 125
 126 =head1 COPYRIGHT
 127
 128 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 129
 130 This program is free software; you can redistribute it and/or modify
 131 it under the same terms as Perl itself.  The full text of this license
 132 can be found in the LICENSE file included with this module.
 133
 134 =cut
 135
 136 # Local Variables:
 137 #   mode: cperl
 138 #   cperl-indent-level: 4
 139 #   fill-column: 78
 140 #   indent-tabs-mode: nil
 141 #   c-indentation-style: bsd
 142 # End:
 143 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :