package CGI::Taintless;

use vars qw(@ISA);

sub new {
    my $class = shift;

    # inherit from a CGI hash-based object, to which we default many CGI operations
    my $self = shift; # must be something conforming to CGI interface
    my $uclass = ref($self);
    @ISA = ($uclass);

    die "I am going in circles" if $uclass eq $class;

    $self->{__Taintless_taint_handlers} = shift || {}; # must be a param => taint handler mapping
    my $max_param_len = shift || 10;
    $self->{__Taintless_param_check} = "^\(\[\\w\\\_\]\{1\,$max_param_len\}\)\$";

    bless $self, $class;
    return $self;
}

sub param {
    my $self = shift;
    if (scalar(@_) == 0) {
        # must only allow alphanumeric parameters for which we have taint handlers
        my @params = $self->SUPER::param();
        my @filtered = ();
        foreach my $p (@params) {
            if ($self->get_re($p)) {
                push @filtered, $1 if $p =~ /$self->{__Taintless_param_check}/;
            }
        }
        return @filtered;
    }
    elsif (scalar(@_) == 1) { # will be tainted
        my $p = shift;
        my $v = $self->SUPER::param($p);
        return undef unless defined($v); # need this line to deal with the .cgifields parameter
        my $re = $self->get_re($p) || die "Cannot find taint handler for $p";
        return $1 if $v =~ /$re/;
        die "$p does not pass taint check"
    }
    else {
        $self->SUPER::param(@_);
    }

}

sub get_re {
    my $self = shift;
    my $p = shift;
    if (exists $self->{__Taintless_taint_handlers}->{$p}) {
        return $self->{__Taintless_taint_handlers}->{$p};
    }
    elsif (exists $self->{__Taintless_taint_handlers}->{-DEFAULT_HANDLER}) {
        return $self->{__Taintless_taint_handlers}->{-DEFAULT_HANDLER};
    }
    return undef;
}

1