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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/InputOutput/ProhibitBarewordFileHandles.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::ProhibitBarewordFileHandles;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities :classification :ppi };
  16 use base 'Perl::Critic::Policy';
  17
  18 our $VERSION = '1.088';
  19
  20 #-----------------------------------------------------------------------------
  21
  22 Readonly::Scalar my $DESC => q{Bareword file handle opened};
  23 Readonly::Scalar my $EXPL => [ 202, 204 ];
  24
  25 #-----------------------------------------------------------------------------
  26
  27 sub supported_parameters { return ()                  }
  28 sub default_severity     { return $SEVERITY_HIGHEST   }
  29 sub default_themes       { return qw( core pbp bugs ) }
  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 'open';
  38     return if ! is_function_call($elem);
  39
  40     my $first_arg = ( parse_arg_list($elem) )[0];
  41     return if !$first_arg;
  42     my $first_token = $first_arg->[0];
  43     return if !$first_token;
  44
  45     if ( $first_token->isa('PPI::Token::Word') ) {
  46         if ( ($first_token ne 'my') && ($first_token !~ m/^STD(?:IN|OUT|ERR)$/mx ) ) {
  47             return $self->violation( $DESC, $EXPL, $elem );
  48         }
  49     }
  50     return; #ok!
  51 }
  52
  53 1;
  54
  55 __END__
  56
  57 #-----------------------------------------------------------------------------
  58
  59 =pod
  60
  61 =head1 NAME
  62
  63 Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles - Write C<open my $fh, q{<}, $filename;> instead of C<open FH, q{<}, $filename;>.
  64
  65 =head1 AFFILIATION
  66
  67 This Policy is part of the core L<Perl::Critic> distribution.
  68
  69
  70 =head1 DESCRIPTION
  71
  72 Using bareword symbols to refer to file handles is particularly evil
  73 because they are global, and you have no idea if that symbol already
  74 points to some other file handle.  You can mitigate some of that risk
  75 by C<local>izing the symbol first, but that's pretty ugly.  Since Perl
  76 5.6, you can use an undefined scalar variable as a lexical reference
  77 to an anonymous filehandle.  Alternatively, see the L<IO::Handle> or
  78 L<IO::File> or L<FileHandle> modules for an object-oriented approach.
  79
  80     open FH, '<', $some_file;           #not ok
  81     open my $fh, '<', $some_file;       #ok
  82     my $fh = IO::File->new($some_file); #ok
  83
  84 There are three exceptions: STDIN, STDOUT and STDERR.  These three
  85 standard filehandles are always package variables.
  86
  87
  88 =head1 CONFIGURATION
  89
  90 This Policy is not configurable except for the standard options.
  91
  92
  93 =head1 SEE ALSO
  94
  95 L<IO::Handle>
  96
  97 L<IO::File>
  98
  99 =head1 AUTHOR
 100
 101 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 102
 103 =head1 COPYRIGHT
 104
 105 Copyright (C) 2005-2007 Jeffrey Ryan Thalhammer.  All rights reserved.
 106
 107 This program is free software; you can redistribute it and/or modify
 108 it under the same terms as Perl itself.
 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 :