#!/usr/bin/perl --
use strict;
use warnings;

use CGI;
use Data::Dumper;

my $tainted_query =  join '&', map{ "$_=$_" } 1, 1, 1, 2, 3;
substr($ENV{PATH}, 0, 0) .= $tainted_query; # taints it

print $tainted_query, "\n";

my $tainted    = CGI->new($tainted_query);
my $default_re = { "\0default"=> qr/^(.*)$/ };

# all untainted
my $untainted = get_taintless_cgi( $tainted, $default_re );

print "\njust parameters named 2 and 3 \n",
    Dumper(
      get_taintless_cgi(
          $tainted,
          $default_re,
          [ 2 , 3 ]
      ));

eval {
    require CGI::Simple;
    $tainted = CGI::Simple->new($tainted_query);
};

print "\nall parameters whose value is 3\n",
    Dumper(
      get_taintless_cgi(
        $tainted,
        {"\0default"=> qr/^(3)$/},
      )
    );

sub get_taintless_cgi {
    my ( $q, $r, $k ) = @_;
    die "Need regex hashref with a default" unless $r and $$r{"\0defau
+lt"};
    die "Need a CGI->new like object "      unless ref $q and $q->can(
+'param');

    my $t = ref($q)->new({});

    my @k = $k ? @$k : $q->param;

    for my $k (@k) {
        my $re = $$r{$k} || $$r{"\0default"};
        my @v;
        for my $v ( $q->param($k) ) {
            push @v, $1 if $v =~ $re;
        }
        $t->param( $k, @v ) if @v; # use $q-> to untaint in original
    }
    return $t;
}

__END__

1=1&1=1&1=1&2=2&3=3

just parameters named 2 and 3 
$VAR1 = bless( {
                 '.parameters' => [
                                    2,
                                    3
                                  ],
                 'use_tempfile' => 1,
                 '.charset' => 'ISO-8859-1',
                 '.fieldnames' => {},
                 'param' => {
                              '3' => [
                                       '3'
                                     ],
                              '2' => [
                                       '2'
                                     ]
                            },
                 'escape' => 1
               }, 'CGI' );

all parameters whose value is 3
$VAR1 = bless( {
                 '.parameters' => [
                                    '3'
                                  ],
                 '.globals' => {
                                 'DEBUG' => 0,
                                 'NO_UNDEF_PARAMS' => 0,
                                 'NO_NULL' => 1,
                                 'FATAL' => -1,
                                 'USE_PARAM_SEMICOLONS' => 0,
                                 'PARAM_UTF8' => 0,
                                 'DISABLE_UPLOADS' => 1,
                                 'USE_CGI_PM_DEFAULTS' => 0,
                                 'NPH' => 0,
                                 'POST_MAX' => 102400,
                                 'HEADERS_ONCE' => 0
                               },
                 '3' => [
                          '3'
                        ],
                 '.fieldnames' => {
                                    '3' => 1
                                  }
               }, 'CGI::Simple' );
[download]