--- /dev/null
+##############################################################################
+# $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<Perl::Critic> 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<Fatal> or C<Fatal::Exception>, 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<open>, C<print> and C<close>. You can
+override this to set it to a different list of functions with the
+C<functions> 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<return> and C<exit>. 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 <amoore@mooresystems.com>.
+
+=head1 AUTHOR
+
+Chris Dolan <cdolan@cpan.org>
+
+=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 :
projects / dh-make-perl / blobdiff