Login
Update autodie support to v1.994.
authorElliot Shank <perl@galumph.com>
Sat, 27 Sep 2008 04:24:10 +0000 (04:24 +0000)
committerElliot Shank <perl@galumph.com>
Sat, 27 Sep 2008 04:24:10 +0000 (04:24 +0000)
lib/Perl/Critic/Utils.pm
lib/Perl/Critic/Utils/PPI.pm
tools/dump-autodie-tag-contents [new file with mode: 0755]

index 5f6d99e..a5a4f9c 100644 (file)
@@ -1125,48 +1125,52 @@ sub is_unchecked_call {
     return 1;
 }
 
+# Based upon autodie 1.994.
 Readonly::Hash my %AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP => (
     # Map builtins to themselves.
-    binmode    => { hashify(qw< binmode        >) },
-    close      => { hashify(qw< close          >) },
-    fcntl      => { hashify(qw< fcntl          >) },
-    fileno     => { hashify(qw< fileno         >) },
-    open       => { hashify(qw< open           >) },
-    sysopen    => { hashify(qw< sysopen        >) },
-    chdir      => { hashify(qw< chdir          >) },
-    opendir    => { hashify(qw< opendir        >) },
-    rename     => { hashify(qw< rename         >) },
-    unlink     => { hashify(qw< unlink         >) },
-    accept     => { hashify(qw< accept         >) },
-    bind       => { hashify(qw< bind           >) },
-    connect    => { hashify(qw< connect        >) },
-    getsockopt => { hashify(qw< getsockopt     >) },
-    listen     => { hashify(qw< listen         >) },
-    recv       => { hashify(qw< recv           >) },
-    send       => { hashify(qw< send           >) },
-    setsockopt => { hashify(qw< setsockopt     >) },
-    shutdown   => { hashify(qw< shutdown       >) },
-    socketpair => { hashify(qw< socketpair     >) },
-    fork       => { hashify(qw< fork           >) },
-    system     => { hashify(qw< system         >) },
-    exec       => { hashify(qw< exec           >) },
-
-    # Tags with immediate children.
-    ':file' => {
+    (
+        map { $_ => { hashify( $_ ) } }
+            qw<
+                accept bind binmode chdir close closedir connect dbmclose
+                dbmopen exec fcntl fileno flock fork getsockopt ioctl link
+                listen mkdir msgctl msgget msgrcv msgsnd open opendir pipe
+                read readlink recv rename rmdir seek semctl semget semop send
+                setsockopt shmctl shmget shmread shutdown socketpair symlink
+                sysopen sysread sysseek system syswrite truncate umask unlink
+            >
+    ),
+
+    # Generate these using tools/dump-autodie-tag-contents
+    ':threads'      => { hashify( qw< fork                          > ) },
+    ':system'       => { hashify( qw< exec system                   > ) },
+    ':dbm'          => { hashify( qw< dbmclose dbmopen              > ) },
+    ':semaphore'    => { hashify( qw< semctl semget semop           > ) },
+    ':shm'          => { hashify( qw< shmctl shmget shmread         > ) },
+    ':msg'          => { hashify( qw< msgctl msgget msgrcv msgsnd   > ) },
+    ':file'     => {
+        hashify(
+            qw<
+                binmode close fcntl fileno flock ioctl open sysopen truncate
+            >
+        )
+    },
+    ':filesys'      => {
         hashify(
             qw<
-                binmode close fcntl fileno open sysopen
+                chdir closedir link mkdir opendir readlink rename rmdir
+                symlink umask unlink
             >
         )
     },
-    ':filesys' => {
+    ':ipc'      => {
         hashify(
             qw<
-                chdir opendir rename unlink
+                msgctl msgget msgrcv msgsnd pipe semctl semget semop shmctl
+                shmget shmread
             >
         )
     },
-    ':socket' => {
+    ':socket'       => {
         hashify(
             qw<
                 accept bind connect getsockopt listen recv send setsockopt
@@ -1174,38 +1178,39 @@ Readonly::Hash my %AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP => (
             >
         )
     },
-    ':threads' => { hashify(qw< fork >) },
-    ':system'  => { hashify(qw< system exec >) },
-
-    # Tag with one level of tags below them.
-    ':io' => {
+    ':io'       => {
         hashify(
             qw<
-                binmode close fcntl fileno open sysopen chdir opendir rename
-                unlink accept bind connect getsockopt listen recv send
-                setsockopt shutdown socketpair
+                accept bind binmode chdir close closedir connect dbmclose
+                dbmopen fcntl fileno flock getsockopt ioctl link listen mkdir
+                msgctl msgget msgrcv msgsnd open opendir pipe read readlink
+                recv rename rmdir seek semctl semget semop send setsockopt
+                shmctl shmget shmread shutdown socketpair symlink sysopen
+                sysread sysseek syswrite truncate umask unlink
             >
         )
     },
-
-    # Tag with two levels of tags below them.
-    ':default' => {
+    ':default'      => {
         hashify(
             qw<
-                binmode close fcntl fileno open sysopen chdir opendir rename
-                unlink accept bind connect getsockopt listen recv send
-                setsockopt shutdown socketpair fork
+                accept bind binmode chdir close closedir connect dbmclose
+                dbmopen fcntl fileno flock fork getsockopt ioctl link listen
+                mkdir msgctl msgget msgrcv msgsnd open opendir pipe read
+                readlink recv rename rmdir seek semctl semget semop send
+                setsockopt shmctl shmget shmread shutdown socketpair symlink
+                sysopen sysread sysseek syswrite truncate umask unlink
             >
         )
     },
-
-    # The lot.
-    ':all' => {
+    ':all'      => {
         hashify(
             qw<
-                binmode close fcntl fileno open sysopen chdir opendir rename
-                unlink accept bind connect getsockopt listen recv send
-                setsockopt shutdown socketpair fork system exec
+                accept bind binmode chdir close closedir connect dbmclose
+                dbmopen exec fcntl fileno flock fork getsockopt ioctl link
+                listen mkdir msgctl msgget msgrcv msgsnd open opendir pipe
+                read readlink recv rename rmdir seek semctl semget semop send
+                setsockopt shmctl shmget shmread shutdown socketpair symlink
+                sysopen sysread sysseek system syswrite truncate umask unlink
             >
         )
     },
@@ -1237,26 +1242,34 @@ sub _is_fatal {
             }
         }
         elsif ('autodie' eq $include->pragma()) {
-            my @args = parse_arg_list($include->schild(1));
+            return _is_covered_by_autodie($elem, $include);
+        }
+    }
 
-            if (@args) {
-                foreach my $arg (@args) {
-                    my $builtins =
-                        $AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP{
-                            $arg->[0]->string
-                        };
+    return;
+}
 
-                    return $TRUE if $builtins and $builtins->{$elem->content()};
-                }
-            }
-            else {
-                my $builtins =
-                    $AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP{':default'};
+sub _is_covered_by_autodie {
+    my ($elem, $include) = @_;
 
-                return $TRUE if $builtins and $builtins->{$elem->content()};
-            }
+    my @args = parse_arg_list($include->schild(1));
+
+    if (@args) {
+        foreach my $arg (@args) {
+            my $builtins =
+                $AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP{
+                    $arg->[0]->string
+                };
+
+            return $TRUE if $builtins and $builtins->{$elem->content()};
         }
     }
+    else {
+        my $builtins =
+            $AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP{':default'};
+
+        return $TRUE if $builtins and $builtins->{$elem->content()};
+    }
 
     return;
 }
index 795dff5..9871d5e 100644 (file)
@@ -11,6 +11,8 @@ use 5.006001;
 use strict;
 use warnings;
 
+use Scalar::Util qw< blessed >;
+
 use base 'Exporter';
 
 our $VERSION = '1.093_01';
@@ -32,13 +34,13 @@ our %EXPORT_TAGS = (
 sub is_ppi_expression_or_generic_statement {
     my $element = shift;
 
-    my $element_class = ref $element;
-
-    return 0 if not $element_class;
+    return 0 if not $element;
     return 0 if not $element->isa('PPI::Statement');
-
     return 1 if $element->isa('PPI::Statement::Expression');
 
+    my $element_class = blessed($element);
+
+    return 0 if not $element_class;
     return $element_class eq 'PPI::Statement';
 }
 
@@ -47,7 +49,7 @@ sub is_ppi_expression_or_generic_statement {
 sub is_ppi_generic_statement {
     my $element = shift;
 
-    my $element_class = ref $element;
+    my $element_class = blessed($element);
 
     return 0 if not $element_class;
     return 0 if not $element->isa('PPI::Statement');
@@ -60,7 +62,7 @@ sub is_ppi_generic_statement {
 sub is_ppi_statement_subclass {
     my $element = shift;
 
-    my $element_class = ref $element;
+    my $element_class = blessed($element);
 
     return 0 if not $element_class;
     return 0 if not $element->isa('PPI::Statement');
diff --git a/tools/dump-autodie-tag-contents b/tools/dump-autodie-tag-contents
new file mode 100755 (executable)
index 0000000..6ed0c2a
--- /dev/null
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+our $VERSION = '1.093_01';
+
+
+use autodie qw< :all >; # Just to be sure that we're using the correct version of Fatal.
+use Fatal;
+
+use List::MoreUtils qw< uniq >;
+
+
+if (not @ARGV) {
+    push @ARGV, ':default';
+}
+
+foreach my $tag (@ARGV) {
+    # Uses a private sub, but this is what Paul Fenwick suggested.
+    my $functions = Fatal->_expand_tag($tag);
+
+    print $tag, q< > x 3;
+
+    foreach my $function ( uniq( sort @{$functions} ) ) {
+        (my $stripped = $function) =~ s< \A CORE:: ><>xms;
+
+        print q< >, $stripped;
+    }
+
+    print "\n";
+}
+
+__END__
+
+#-----------------------------------------------------------------------------
+
+=pod
+
+=head1 NAME
+
+dump-autodie-tag-contents - List the perl functions covered by a given L<autodie> tag.
+
+=head1 SYNOPSIS
+
+    dump-autodie-tag-contents       # Dump the :default tag.
+    dump-autodie-tag-contents :io   # Dump all the I/O builtins autodie can
+                                    # deal with.
+
+=head1 DESCRIPTION
+
+This is a simple tool for helping to maintain the InputOutput::RequireChecked*
+policies.
+
+It lists all the perl builtins that a given L<autotag> tag covers.  If none is
+specified, the ":default" tag is used.
+
+=head1 AUTHOR
+
+Elliot Shank C<< <perl@galumph.com> >>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Elliot Shank.  All 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 :