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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/InputOutput/RequireCheckedSyscalls.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::RequireCheckedSyscalls;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :booleans :characters :severities :classification
  16                             hashify is_perl_bareword };
  17
  18 use base 'Perl::Critic::Policy';
  19
  20 our $VERSION = '1.088';
  21
  22 #-----------------------------------------------------------------------------
  23
  24 Readonly::Scalar my $DESC => q{Return value of flagged function ignored};
  25 Readonly::Scalar my $EXPL => [208, 278];
  26
  27 Readonly::Array my @DEFAULT_FUNCTIONS => qw(
  28     open close print
  29 );
  30 # I created this list by searching for "return" in perlfunc
  31 Readonly::Array my @BUILTIN_FUNCTIONS => qw(
  32     accept bind binmode chdir chmod chown close closedir connect
  33     dbmclose dbmopen exec fcntl flock fork ioctl kill link listen
  34     mkdir msgctl msgget msgrcv msgsnd open opendir pipe print read
  35     readdir readline readlink readpipe recv rename rmdir seek seekdir
  36     semctl semget semop send setpgrp setpriority setsockopt shmctl
  37     shmget shmread shutdown sleep socket socketpair symlink syscall
  38     sysopen sysread sysseek system syswrite tell telldir truncate
  39     umask unlink utime wait waitpid
  40 );
  41
  42 #-----------------------------------------------------------------------------
  43
  44 sub supported_parameters {
  45     return (
  46         {
  47             name            => 'functions',
  48             description     => 'The set of functions to require checking the return value of.',
  49             default_string  => join( $SPACE, @DEFAULT_FUNCTIONS ),
  50             behavior        => 'string list',
  51         },
  52     );
  53 }
  54
  55 sub default_severity     { return $SEVERITY_LOWEST       }
  56 sub default_themes       { return qw( core maintenance ) }
  57 sub applies_to           { return 'PPI::Token::Word'     }
  58
  59 #-----------------------------------------------------------------------------
  60
  61 sub initialize_if_enabled {
  62     my ($self, $config) = @_;
  63
  64     my @specified_functions = keys %{ $self->{_functions} };
  65     my @resulting_functions;
  66
  67     foreach my $function (@specified_functions) {
  68         if ( $function eq ':defaults' ) {
  69             push @resulting_functions, @DEFAULT_FUNCTIONS;
  70         }
  71         elsif ( $function eq ':builtins' ) {
  72             push @resulting_functions, @BUILTIN_FUNCTIONS;
  73         }
  74         else {
  75             push @resulting_functions, $function;
  76         }
  77     }
  78
  79     $self->{_functions} = { hashify(@resulting_functions) };
  80
  81     return $TRUE;
  82 }
  83
  84 #-----------------------------------------------------------------------------
  85
  86 sub violates {
  87     my ( $self, $elem, undef ) = @_;
  88
  89     return if $self->{_functions}->{':all'} ? is_perl_bareword($elem) : !$self->{_functions}->{$elem};
  90     return if ! is_unchecked_call( $elem );
  91
  92     return $self->violation( $DESC . ' - ' . $elem, $EXPL, $elem );
  93 }
  94
  95
  96 1;
  97
  98 __END__
  99
 100 #-----------------------------------------------------------------------------
 101
 102 =pod
 103
 104 =for stopwords nyah
 105
 106 =head1 NAME
 107
 108 Perl::Critic::Policy::InputOutput::RequireCheckedSyscalls - Return value of flagged function ignored.
 109
 110 =head1 AFFILIATION
 111
 112 This Policy is part of the core L<Perl::Critic> distribution.
 113
 114
 115 =head1 DESCRIPTION
 116
 117 This performs identically to InputOutput::RequireCheckedOpen/Close
 118 except that this is configurable to apply to any function, whether
 119 core or user-defined.
 120
 121 If your module uses L<Fatal> or C<Fatal::Exception>, then any
 122 functions wrapped by those modules will not trigger this policy.  For
 123 example:
 124
 125    use Fatal qw(open);
 126    open my $fh, $filename;  # no violation
 127    close $fh;               # yes violation
 128
 129 =head1 CONFIGURATION
 130
 131 This policy watches for a configurable list of function names.  By
 132 default, it applies to C<open>, C<print> and C<close>.  You can
 133 override this to set it to a different list of functions with the
 134 C<functions> setting.  To do this, put entries in a F<.perlcriticrc>
 135 file like this:
 136
 137   [InputOutput::RequireCheckedSyscalls]
 138   functions = open opendir read readline readdir close closedir
 139
 140 We have defined a few shortcuts for creating this list
 141
 142   [InputOutput::RequireCheckedSyscalls]
 143   functions = :defaults opendir readdir closedir
 144
 145   [InputOutput::RequireCheckedSyscalls]
 146   functions = :builtins
 147
 148   [InputOutput::RequireCheckedSyscalls]
 149   functions = :all
 150
 151 The C<:builtins> shortcut above represents all of the builtin
 152 functions that have error conditions (about 65 of them, many of them
 153 rather obscure).
 154
 155 The C<:all> is the insane case: you must check the return value of
 156 EVERY function call, even C<return> and C<exit>.  Yes, this "feature"
 157 is overkill and is wasting CPU cycles on your computer by just
 158 existing.  Nyah nyah.  I shouldn't code after midnight.
 159
 160 =head1 CREDITS
 161
 162 Initial development of this policy was supported by a grant from the
 163 Perl Foundation.
 164
 165 This policy module is based heavily on policies written by Andrew
 166 Moore <amoore@mooresystems.com>.
 167
 168 =head1 AUTHOR
 169
 170 Chris Dolan <cdolan@cpan.org>
 171
 172 =head1 COPYRIGHT
 173
 174 Copyright (c) 2007-2008 Chris Dolan.  Many rights reserved.
 175
 176 This program is free software; you can redistribute it and/or modify
 177 it under the same terms as Perl itself.  The full text of this license
 178 can be found in the LICENSE file included with this module.
 179
 180 =cut
 181
 182 ##############################################################################
 183 # Local Variables:
 184 #   mode: cperl
 185 #   cperl-indent-level: 4
 186 #   fill-column: 78
 187 #   indent-tabs-mode: nil
 188 #   c-indentation-style: bsd
 189 # End:
 190 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :