File Coverage

lib/CGI/ValidOp/Check/sql.pm

Criterion	Covered	Total	%
statement	33	33	100.0
branch	17	18	94.4
condition			n/a
subroutine	9	9	100.0
pod	3	3	100.0
total	62	63	98.4

package CGI::ValidOp::Check::sql;
use strict;
use warnings;

use base qw/ CGI::ValidOp::Check /;

sub default {
    (
        qr|^[\w\s\.:\[\]_\^\*/%+<>=~!@#&\|`\?\$\(\),;'"-]+$|,
        q{Only letters, numbers, and the following punctuation are allowed for $label: .  : [ ] _ ^ * / % + - <> = ~ !  @ # & | ` ?  $ ( )  , ; ' "},
    )
}

sub safer {
    my $self = shift;
    sub {
        my( $value ) = @_;

        my $error = _safer( $value );
        return $self->fail( $error )
            if $error;

        return $self->fail( "SELECT statement not allowed for \$label" )
            if $value =~ /select/i;
        $value =~ /^(.*)$/s;
        return $self->pass( $1 );
    }
}

sub safer_select {
    my $self = shift;
    sub {
        my( $value ) = @_;

        my $error = _safer( $value );
        return $self->fail( $error )
            if $error;

        $value =~ /^(.*)$/s;
        return $self->pass( $1 );
    }
}

sub _safer {
    my( $value ) = @_;

    return "Semicolons not allowed for \$label"
        if $value =~ /[;]/;
    return "Dashes not allowed for \$label"
        if $value =~ /[-]/;
    return "DELETE statement not allowed for \$label"
        if $value =~ /delete/i;
    return "DROP statement not allowed for \$label"
        if $value =~ /drop/i;
    return "UPDATE statement not allowed for \$label"
        if $value =~ /update/i;
    return "INTO statement not allowed for \$label"
        if $value =~ /into/i;
    return;
}

1;

__END__