Chris,

Attached are three new P::C policies for Parrot:

prohibit_shebang_warnings_arg.patch:   checks for C<perl -w>
misplaced_shebang.patch:                    checks for shebang not on
first line of script
require_portable_shebang.patch:            checks for non-portable shebang line

That's completely up to you.  You seem to have a knack for writing
policies, so we'd love to have the help with Perl::Critic.  But
Parrot is a worthy cause too! :-)  If you don't provide a P::C patch,
I'll probably do it myself eventually.
If I get the tuits I'll send a patch in for P::C :-)

Hope this helps!

Paul
Index: lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitShebangWarningsArg.pm
===================================================================
--- lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitShebangWarningsArg.pm	(revision 0)
+++ lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitShebangWarningsArg.pm	(revision 0)
@@ -0,0 +1,70 @@
+# $Id$
+package Perl::Critic::Policy::TestingAndDebugging::ProhibitShebangWarningsArg;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.1';
+$VERSION = eval $VERSION;    ## no critic
+
+my $desc = q{Warnings argument of perl shebang found.'};
+my $expl = q{All perl source in parrot must 'use warnings;' not the older 'perl -w' usage};
+
+#----------------------------------------------------------------------------
+
+sub default_severity { return $SEVERITY_LOW }
+sub applies_to       { return 'PPI::Document' }
+
+#----------------------------------------------------------------------------
+
+sub violates {
+    my ( $self, $elem, $doc ) = @_;
+
+    my @elements = $doc->children();
+
+    # look for the shebang line, if any
+    foreach my $element ( @elements) {
+        # if the element isn't on the first line, it's not a valid shebang
+        return if ($element->location()->[0] != 1);
+
+        if ($element =~ m/^\#! .*? perl/xgs) {
+            # if the shebang line matches '-w', report the violation
+            if ($element =~ m/-[^w]*w/s) {
+                my $sev = $self->get_severity();
+                return Perl::Critic::Violation
+                    ->new( $desc, $expl, $element, $sev ); 
+            }
+            else {
+                last;  # shebang line ok; skip to the end of the elements
+            }
+        }
+    }
+
+    # we didn't find any dodgy shebang lines, so return with success
+    return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::TestingAndDebugging::ProhibitShebangWarningsArg
+
+=head1 DESCRIPTION
+
+Check to see if the old style C<perl -w> shebang line is used to switch on
+warnings.  This should be replaced with the newer C<use warnings;> syntax.
+
+=cut
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Index: lib/Perl/Critic/Policy/TestingAndDebugging/MisplacedShebang.pm
===================================================================
--- lib/Perl/Critic/Policy/TestingAndDebugging/MisplacedShebang.pm	(revision 0)
+++ lib/Perl/Critic/Policy/TestingAndDebugging/MisplacedShebang.pm	(revision 0)
@@ -0,0 +1,66 @@
+# $Id$
+package Perl::Critic::Policy::TestingAndDebugging::MisplacedShebang;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.1';
+$VERSION = eval $VERSION;    ## no critic
+
+my $desc = q{Found misplaced shebang line};
+my $expl = q{Perl source in parrot needs shebang line on first line of file};
+
+#----------------------------------------------------------------------------
+
+sub default_severity { return $SEVERITY_LOW }
+sub applies_to       { return 'PPI::Document' }
+
+#----------------------------------------------------------------------------
+
+sub violates {
+    my ( $self, $elem, $doc ) = @_;
+
+    # grab all elements in the document
+    my @elements = $doc->children();
+
+    foreach my $element ( @elements ) {
+
+        # look for a shebang line
+        if ($element =~ m/^\#!/xs) {
+            # if the shebang line isn't on the first line, report the
+            # policy violation
+            if ($element->location()->[0] != 1) {
+                my $sev = $self->get_severity();
+                return Perl::Critic::Violation
+                    ->new( $desc, $expl, $element, $sev ); 
+            }
+        }
+    }
+
+    # we didn't find any dodgy shebang lines, so return with success
+    return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::TestingAndDebugging::MisplacedShebang
+
+=head1 DESCRIPTION
+
+Make sure that the shebang line occurs on the first line of the file.
+
+=cut
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Index: lib/Perl/Critic/Policy/TestingAndDebugging/RequirePortableShebang.pm
===================================================================
--- lib/Perl/Critic/Policy/TestingAndDebugging/RequirePortableShebang.pm	(revision 0)
+++ lib/Perl/Critic/Policy/TestingAndDebugging/RequirePortableShebang.pm	(revision 0)
@@ -0,0 +1,77 @@
+# $Id$
+package Perl::Critic::Policy::TestingAndDebugging::RequirePortableShebang;
+
+use strict;
+use warnings;
+use Perl::Critic::Utils;
+use Perl::Critic::Violation;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '0.1';
+$VERSION = eval $VERSION;    ## no critic
+
+my $desc = q{Found platform-specific perl shebang line};
+my $expl = q{Perl source in parrot should use the platform-independent shebang line: #! perl};
+
+#----------------------------------------------------------------------------
+
+sub default_severity { return $SEVERITY_LOW }
+sub applies_to       { return 'PPI::Document' }
+
+#----------------------------------------------------------------------------
+
+sub violates {
+    my ( $self, $elem, $doc ) = @_;
+
+    # grab all elements in the document
+    my @elements = $doc->children();
+
+    foreach my $element ( @elements ) {
+        # if the element isn't on the first line, it's not a valid shebang
+        return if ($element->location()->[0] != 1);
+
+        # look for a perl shebang line
+        if ($element =~ m/^\#! .*? perl/xs) {
+
+            # if we have a platform-specific shebang, barf
+            if ($element !~ m{^\#!     # get shebang part at line's start
+                               \s*     # any number of spaces
+                               perl    # the word 'perl'
+                               \s*     # any number of spaces
+                               .*$     # and any characters up to end of line
+                              }xs) {
+                my $sev = $self->get_severity();
+                return Perl::Critic::Violation
+                    ->new( $desc, $expl, $element, $sev ); 
+            }
+            else {
+                return;  # shebang line ok, return
+            }
+        }
+    }
+
+    # we didn't find any dodgy shebang lines, so return with success
+    return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Perl::Critic::Policy::TestingAndDebugging::RequirePortableShebang
+
+=head1 DESCRIPTION
+
+Make sure the perl shebang line isn't platform-specific i.e. uses something 
+like C<#!/usr/bin/perl> instead of the cross-platform C<#! perl>.
+
+=cut
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Reply via email to