Prevent false positives

lib/Perl/Critic/Policy/ValuesAndExpressions/PreventSQLInjection.pm

@@ -216,6 +216,17 @@ Readonly::Scalar my $QUOTING_METHODS_DEFAULT => q|
 Readonly::Scalar my $SAFE_FUNCTIONS_DEFAULT => q|
 |;
 
+# Default for the name of the functions that are generally safe to use (because they
+# are not expected to generate SQL calls -- unless you are doing something really,
+# really weird.)
+Readonly::Scalar my $SAFE_CONTEXT_DEFAULT => q|
+	die
+	warn
+	carp
+	croak
+	confess
+|;
+
 # Regex to detect comments like ## SQL safe ($var1, $var2).
 Readonly::Scalar my $SQL_SAFE_COMMENTS_REGEX => qr/
 	\A
@@ -257,6 +268,12 @@ sub supported_parameters
 			default_string  => $SAFE_FUNCTIONS_DEFAULT,
 			behavior        => 'string',
 		},
+		{
+			name            => 'safe_context',
+			description     => 'A space-separated string listing the functions that are not subject to SQL injections',
+			default_string  => $SAFE_CONTEXT_DEFAULT,
+			behavior        => 'string',
+		},
 	);
 }
 
@@ -330,6 +347,10 @@ sub violates
 	return ()
 		if !is_sql_statement( $element );
 
+	# Skip this statement if we are in a safe context (e.g., die "string")
+	return ()
+		if $self->is_in_safe_context( $element );
+
 	# Find SQL injection vulnerabilities.
 	my $sql_injections = detect_sql_injections( $self, $element );
 
@@ -580,6 +601,27 @@ sub is_sql_statement
 		: 0;
 }
 
+=head2 is_in_safe_context()
+
+Return a boolean indicating whether a string is used in a safe context (e.g., die "string").
+
+    my $is_in_safe_context = is_in_safe_context( $token );
+
+=cut
+
+sub is_in_safe_context
+{
+    my ( $self, $token ) = @_;
+
+    return 0 if !$self->{'_safe_context_regex'};
+
+    my $sprevious_sibling = $token->sprevious_sibling;
+
+    return 0 if !defined $sprevious_sibling or $sprevious_sibling eq '';
+    return 0 if !$sprevious_sibling->isa('PPI::Token::Word');
+
+    return $sprevious_sibling->{content} =~ $self->{'_safe_context_regex'};
+}
 
 =head2 get_token_content()
 
@@ -824,6 +866,20 @@ sub parse_config_parameters
 		}
 	}
 
+	if ( !exists( $self->{'_safe_context_regex'} ) )
+	{
+		if ( $self->{'_safe_context'} =~ /\w/ )
+		{
+			my $regex_components = join( '|', grep { $_ =~ /\w/ } split( /,?\s+/, $self->{'_safe_context'} ) );
+			$self->{'_safe_context_regex'} = qr/^(?:$regex_components)$/x;
+		}
+		else
+		{
+			$self->{'_safe_context_regex'} = undef;
+		}
+	}
+
+
 	return;
 }
 

t/ValuesAndExpressions/PreventSQLInjection.run

@@ -4,6 +4,22 @@
 
 my $string = "Hello $world";
 
+## name Prevent false positives in non-db operations
+## failures 0
+## cut
+
+die     "Select returned: $error";
+warn    "Update returned: $error";
+croak   "Insert returned: $error";
+carp    "Delete returned: $error";
+confess "Select returned: $error";
+
+do_something() or die     "Select returned: $error";
+do_something() or warn    "Update returned: $error";
+do_something() or croak   "Insert returned: $error";
+do_something() or carp    "Delete returned: $error";
+do_something() or confess "Select returned: $error";
+
 ## name Single-quoted SQL string with an escaped variable.
 ## failures 0
 ## cut