X-Git-Url: http://git.maemo.org/git/?a=blobdiff_plain;ds=sidebyside;f=dev%2Fi386%2Flibperl-critic-perl%2Flibperl-critic-perl-1.088%2Flib%2FPerl%2FCritic%2FPolicy%2FInputOutput%2FRequireCheckedSyscalls.pm;fp=dev%2Fi386%2Flibperl-critic-perl%2Flibperl-critic-perl-1.088%2Flib%2FPerl%2FCritic%2FPolicy%2FInputOutput%2FRequireCheckedSyscalls.pm;h=9a62133bbd8561e61de5d1210882015ae628feb9;hb=da95c414033799c3a62606f299c3c00b5c77ca11;hp=0000000000000000000000000000000000000000;hpb=2d38e14bacbb15b98e539843a40b3c52a225f493;p=dh-make-perl diff --git a/dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/InputOutput/RequireCheckedSyscalls.pm b/dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/InputOutput/RequireCheckedSyscalls.pm new file mode 100644 index 0000000..9a62133 --- /dev/null +++ b/dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/InputOutput/RequireCheckedSyscalls.pm @@ -0,0 +1,190 @@ +############################################################################## +# $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/InputOutput/RequireCheckedSyscalls.pm $ +# $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $ +# $Author: clonezone $ +# $Revision: 2489 $ +############################################################################## + +package Perl::Critic::Policy::InputOutput::RequireCheckedSyscalls; + +use 5.006001; +use strict; +use warnings; +use Readonly; + +use Perl::Critic::Utils qw{ :booleans :characters :severities :classification + hashify is_perl_bareword }; + +use base 'Perl::Critic::Policy'; + +our $VERSION = '1.088'; + +#----------------------------------------------------------------------------- + +Readonly::Scalar my $DESC => q{Return value of flagged function ignored}; +Readonly::Scalar my $EXPL => [208, 278]; + +Readonly::Array my @DEFAULT_FUNCTIONS => qw( + open close print +); +# I created this list by searching for "return" in perlfunc +Readonly::Array my @BUILTIN_FUNCTIONS => qw( + accept bind binmode chdir chmod chown close closedir connect + dbmclose dbmopen exec fcntl flock fork ioctl kill link listen + mkdir msgctl msgget msgrcv msgsnd open opendir pipe print read + readdir readline readlink readpipe recv rename rmdir seek seekdir + semctl semget semop send setpgrp setpriority setsockopt shmctl + shmget shmread shutdown sleep socket socketpair symlink syscall + sysopen sysread sysseek system syswrite tell telldir truncate + umask unlink utime wait waitpid +); + +#----------------------------------------------------------------------------- + +sub supported_parameters { + return ( + { + name => 'functions', + description => 'The set of functions to require checking the return value of.', + default_string => join( $SPACE, @DEFAULT_FUNCTIONS ), + behavior => 'string list', + }, + ); +} + +sub default_severity { return $SEVERITY_LOWEST } +sub default_themes { return qw( core maintenance ) } +sub applies_to { return 'PPI::Token::Word' } + +#----------------------------------------------------------------------------- + +sub initialize_if_enabled { + my ($self, $config) = @_; + + my @specified_functions = keys %{ $self->{_functions} }; + my @resulting_functions; + + foreach my $function (@specified_functions) { + if ( $function eq ':defaults' ) { + push @resulting_functions, @DEFAULT_FUNCTIONS; + } + elsif ( $function eq ':builtins' ) { + push @resulting_functions, @BUILTIN_FUNCTIONS; + } + else { + push @resulting_functions, $function; + } + } + + $self->{_functions} = { hashify(@resulting_functions) }; + + return $TRUE; +} + +#----------------------------------------------------------------------------- + +sub violates { + my ( $self, $elem, undef ) = @_; + + return if $self->{_functions}->{':all'} ? is_perl_bareword($elem) : !$self->{_functions}->{$elem}; + return if ! is_unchecked_call( $elem ); + + return $self->violation( $DESC . ' - ' . $elem, $EXPL, $elem ); +} + + +1; + +__END__ + +#----------------------------------------------------------------------------- + +=pod + +=for stopwords nyah + +=head1 NAME + +Perl::Critic::Policy::InputOutput::RequireCheckedSyscalls - Return value of flagged function ignored. + +=head1 AFFILIATION + +This Policy is part of the core L distribution. + + +=head1 DESCRIPTION + +This performs identically to InputOutput::RequireCheckedOpen/Close +except that this is configurable to apply to any function, whether +core or user-defined. + +If your module uses L or C, then any +functions wrapped by those modules will not trigger this policy. For +example: + + use Fatal qw(open); + open my $fh, $filename; # no violation + close $fh; # yes violation + +=head1 CONFIGURATION + +This policy watches for a configurable list of function names. By +default, it applies to C, C and C. You can +override this to set it to a different list of functions with the +C setting. To do this, put entries in a F<.perlcriticrc> +file like this: + + [InputOutput::RequireCheckedSyscalls] + functions = open opendir read readline readdir close closedir + +We have defined a few shortcuts for creating this list + + [InputOutput::RequireCheckedSyscalls] + functions = :defaults opendir readdir closedir + + [InputOutput::RequireCheckedSyscalls] + functions = :builtins + + [InputOutput::RequireCheckedSyscalls] + functions = :all + +The C<:builtins> shortcut above represents all of the builtin +functions that have error conditions (about 65 of them, many of them +rather obscure). + +The C<:all> is the insane case: you must check the return value of +EVERY function call, even C and C. Yes, this "feature" +is overkill and is wasting CPU cycles on your computer by just +existing. Nyah nyah. I shouldn't code after midnight. + +=head1 CREDITS + +Initial development of this policy was supported by a grant from the +Perl Foundation. + +This policy module is based heavily on policies written by Andrew +Moore . + +=head1 AUTHOR + +Chris Dolan + +=head1 COPYRIGHT + +Copyright (c) 2007-2008 Chris Dolan. Many rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. The full text of this license +can be found in the LICENSE file included with this module. + +=cut + +############################################################################## +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 78 +# indent-tabs-mode: nil +# c-indentation-style: bsd +# End: +# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :