Index: /rdnap/lib/Attribute/Params/Validate.pm
===================================================================
--- /rdnap/lib/Attribute/Params/Validate.pm	(revision 203)
+++ /rdnap/lib/Attribute/Params/Validate.pm	(revision 203)
@@ -0,0 +1,186 @@
+package Attribute::Params::Validate;
+
+use strict;
+use warnings; # ok to use cause Attribute::Handlers needs 5.6.0+ as well
+
+use attributes;
+
+use Attribute::Handlers;
+
+# this will all be re-exported
+use Params::Validate qw(:all);
+
+require Exporter;
+
+use vars qw($VERSION);
+
+our @ISA = qw(Exporter);
+
+my %tags = ( types => [ qw( SCALAR ARRAYREF HASHREF CODEREF GLOB GLOBREF SCALARREF HANDLE UNDEF OBJECT ) ],
+	   );
+
+our %EXPORT_TAGS = ( 'all' => [ qw( validation_options ), map { @{ $tags{$_} } } keys %tags ],
+		     %tags,
+		   );
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} }, 'validation_options' );
+
+$VERSION = sprintf '%2d.%02d', q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
+
+
+sub UNIVERSAL::Validate : ATTR(CODE, INIT)
+{
+    _wrap_sub('named', @_);
+}
+
+sub UNIVERSAL::ValidatePos : ATTR(CODE, INIT)
+{
+    _wrap_sub('positional', @_);
+}
+
+sub _wrap_sub
+{
+    my ($type, $package, $symbol, $referent, $attr, $params) = @_;
+
+    my @p = ref $params ? @{ $params } : $params;
+
+    my $subname = $package . '::' . *{$symbol}{NAME};
+
+    my %attributes = map { $_ => 1 } attributes::get($referent);
+    my $is_method = $attributes{method};
+
+    {
+	no warnings 'redefine';
+	no strict 'refs';
+
+	# An unholy mixture of closure and eval.  This is done so that
+	# the code to automatically create the relevant scalars from
+	# the hash of params can create the scalars in the proper
+	# place lexically.
+
+	my $code = <<"EOF";
+sub
+{
+    package $package;
+EOF
+
+	$code .= "    my \$object = shift;\n" if $is_method;
+
+	if ($type eq 'named')
+	{
+            $params = {@p};
+	    $code .= "    Params::Validate::validate(\@_, \$params);\n";
+	}
+	else
+	{
+	    $code .= "    Params::Validate::validate_pos(\@_, \@p);\n";
+	}
+
+	$code .= "    unshift \@_, \$object if \$object;\n" if $is_method;
+
+	$code .= <<"EOF";
+    \$referent->(\@_);
+}
+EOF
+
+	my $sub = eval $code;
+	die $@ if $@;
+
+	*{$subname} = $sub;
+    }
+}
+
+1;
+
+
+=head1 NAME
+
+Attribute::Params::Validate - Validate method/function parameters using attributes
+
+=head1 SYNOPSIS
+
+  use Attribute::Params::Validate qw(:all);
+
+  # takes named params (hash or hashref)
+  # foo is mandatory, bar is optional
+  sub foo : Validate( foo => 1, bar => 0 )
+  {
+      ...
+  }
+
+  # takes positional params
+  # first two are mandatory, third is optional
+  sub bar : ValidatePos( 1, 1, 0 )
+  {
+      ...
+  }
+
+  # for some reason Perl insists that the entire attribute be on one line
+  sub foo2 : Validate( foo => { type => ARRAYREF }, bar => { can => [ 'print', 'flush', 'frobnicate' ] }, baz => { type => SCALAR, callbacks => { 'numbers only' => sub { shift() =~ /^\d+$/ }, 'less than 90' => sub { shift() < 90 } } } )
+  {
+      ...
+  }
+
+  # note that this is marked as a method.  This is very important!
+  sub baz : Validate( foo => { type => ARRAYREF }, bar => { isa => 'Frobnicator' } ) method
+  {
+      ...
+  }
+
+=head1 DESCRIPTION
+
+
+The Attribute::Params::Validate module allows you to validate method
+or function call parameters just like Params::Validate does.  However,
+this module allows you to specify your validation spec as an
+attribute, rather than by calling the C<validate> routine.
+
+Please see Params::Validate for more information on how you can
+specify what validation is performed.
+
+=head2 EXPORT
+
+This module exports everthing that Params::Validate does except for
+the C<validate> and C<validate_pos> subroutines.
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item * Validate
+
+This attribute corresponse to the C<validate> subroutine in
+Params::Validate.
+
+=item * ValidatePos
+
+This attribute corresponse to the C<validate_pos> subroutine in
+Params::Validate.
+
+=back
+
+=head2 OO
+
+If you are using this module to mark B<methods> for validation, as
+opposed to subroutines, it is crucial that you mark these methods with
+the C<:method> attribute, as well as the C<Validate> or C<ValidatePos>
+attribute.
+
+If you do not do this, then the object or class used in the method
+call will be passed to the validation routines, which is probably not
+what you want.
+
+=head2 CAVEATS
+
+You B<must> put all the arguments to the C<Validate> or C<ValidatePos>
+attribute on a single line, or Perl will complain.
+
+=head1 SEE ALSO
+
+Params::Validate
+
+=head1 AUTHOR
+
+Dave Rolsky, <autarch@urth.org>
+
+=cut
+
Index: /rdnap/lib/Geo/Coordinates/RDNAP.pm
===================================================================
--- /rdnap/lib/Geo/Coordinates/RDNAP.pm	(revision 203)
+++ /rdnap/lib/Geo/Coordinates/RDNAP.pm	(revision 203)
@@ -0,0 +1,392 @@
+package Geo::Coordinates::RDNAP;
+
+use strict;
+use warnings;
+
+use vars qw($VERSION);
+$VERSION = '0.11';
+
+use Carp;
+use Params::Validate qw/validate BOOLEAN SCALAR/;
+
+use Exporter;
+use vars qw/@ISA @EXPORT_OK/;
+@ISA = qw/Exporter/;
+@EXPORT_OK = qw/from_rd to_rd deg dms/;
+
+sub deg {
+    my (@in) = @_;
+    my @out;
+
+    while (my($d, $m, $s) = splice (@in, 0, 3)) {
+        push @out, $d + ($m||0)/60 + ($s||0)/3600;
+    }
+    return @out;
+}
+
+sub dms {
+    return map {int($_), int($_*60)%60, ($_-int($_*60)/60)*3600} @_;
+}
+
+my %a = (
+    '01' => 3236.0331637,
+    20 => -32.5915821,
+    '02' => -0.2472814,
+    21 => -0.8501341,
+    '03' => -0.0655238,
+    22 => -0.0171137,
+    40 =>  0.0052771,
+    23 => -0.0003859,
+    41 =>  0.0003314,
+    '04' =>  0.0000371,
+    42 =>  0.0000143,
+    24 => -0.0000090,
+);
+
+my %b = (
+    10 => 5261.3028966,
+    11 => 105.9780241,
+    12 =>  2.4576469,
+    30 => -0.8192156,
+    31 => -0.0560092,
+    13 =>  0.0560089,
+    32 => -0.0025614,
+    14 =>  0.0012770,
+    50 =>  0.0002574,
+    33 => -0.0000973,
+    51 =>  0.0000293,
+    15 =>  0.0000291,
+);
+
+my %c = (
+    '01' => 190066.98903,
+    11 => -11830.85831,
+    21 => -114.19754,
+    '03' => -32.38360,
+    31 => -2.34078,
+    13 => -0.60639,
+    23 => 0.15774,
+    41 => -0.04158,
+    '05' => -0.00661,
+);
+
+my %d = (
+    10 => 309020.31810,
+    '02' => 3638.36193,
+    12 => -157.95222,
+    20 => 72.97141,
+    30 => 59.79734,
+    22 => -6.43481,
+    '04' => 0.09351,
+    32 => -0.07379,
+    14 => -0.05419,
+    40 => -0.03444,
+);
+
+my %bessel = (
+    a   => 6377397.155,
+    e2  => 6674372e-9,
+    f_i => 299.1528128,
+);
+
+my %etrs89 = (
+    a   => 6378137,
+    e2  => 6694380e-9,
+    f_i => 298.257222101,
+);
+
+# Transformation parameters from Bessel to ETRS89 with respect to
+# Amersfoort.
+
+my %b2e = (
+    tx  => 593.032,
+    ty  => 26,
+    tz  => 478.741,
+    a   => 1.9848e-6,
+    b   => -1.7439e-6,
+    c   => 9.0587e-6,
+    d   => 4.0772e-6,
+);
+
+my %e2b = map {$_ => -$b2e{$_}} keys %b2e;
+
+my @amersfoort_b = ( 3903_453.148, 368_135.313, 5012_970.306 );
+my @amersfoort_e = ( 3904_046.180, 368_161.313, 5013_449.047 );
+
+sub from_rd {
+    croak 'Geo::Coordinates::RDNAP::from_rd needs two or three arguments'
+        if (@_ !=2 && @_ != 3);
+
+    my ($x, $y, $h) = (@_, 0);
+
+    croak "Geo::Coordinates::RDNAP::from_rd: X out of bounds: $x"
+        if ($x < -7_000 or $x > 300_000);
+    croak "Geo::Coordinates::RDNAP::from_rd: Y out of bounds: $y"
+        if ($y < 289_000 or $y > 629_000);
+
+    # Use the approximated transformation.
+    # Step 1: RD -> Bessel (spherical coords)
+
+    $x = ($x/100_000) - 1.55;
+    $y = ($y/100_000) - 4.63;
+
+    my $lat = (52*60*60) + (9*60) + 22.178;
+    my $lon = (5 *60*60) + (23*60) + 15.5;
+
+    foreach my $i (keys %a) {
+        my ($m, $n) = split //, $i;
+        $lat += $a{$i} * ($x**$m) * ($y**$n);
+    }
+
+    foreach my $i (keys %b) {
+        my ($m, $n) = split //, $i;
+        $lon += $b{$i} * ($x**$m) * ($y**$n);
+    }
+
+    # Step 2: spherical coords -> X, Y, Z
+    my @coords = _ellipsoid_to_cartesian($lat/3600, $lon/3600, $h, \%bessel);
+
+    # Step 3: Bessel -> ETRS89
+    @coords = _transform_datum( @coords, \%b2e, \@amersfoort_b );
+
+    # Step 4: X, Y, Z -> spherical coords
+    return _cartesian_to_ellipsoid(@coords, \%etrs89);
+}
+
+sub to_rd {
+    croak 'Geo::Coordinates::RDNAP::to_rd needs two or three arguments'
+        if (@_ !=2 && @_ != 3);
+
+    my ($lat, $lon, $h) = (@_, 0);
+
+    # Use the approximated transformation.
+    # Step 1: spherical coords -> X, Y, Z
+    my @coords = _ellipsoid_to_cartesian($lat, $lon, $h, \%etrs89);
+
+    # Step 2: ETRS89 -> Bessel
+    @coords = _transform_datum( @coords, \%e2b, \@amersfoort_e );
+
+    # Step 3: X, Y, Z -> spherical coords
+    ($lat, $lon, $h) = _cartesian_to_ellipsoid(@coords, \%bessel);
+
+    # Step 4: Bessel -> RD'
+
+    # Convert to units of 10_000 secs; as deltas from Amersfoort.
+    $lat = ($lat * 3600 - ((52*60*60) + (9*60) + 22.178))/10_000;
+    $lon = ($lon * 3600 - ((5 *60*60) + (23*60) + 15.5))/10_000;
+
+    my $x = 155e3;
+    my $y = 463e3;
+
+    foreach my $i (keys %c) {
+        my ($m, $n) = split //, $i;
+        $x += $c{$i} * ($lat**$m) * ($lon**$n);
+    }
+
+    foreach my $i (keys %d) {
+        my ($m, $n) = split //, $i;
+        $y += $d{$i} * ($lat**$m) * ($lon**$n);
+    }
+
+    croak "Geo::Coordinates::RDNAP::to_rd: X out of bounds: $x"
+        if ($x < -7_000 or $x > 300_000);
+    croak "Geo::Coordinates::RDNAP::to_rd: Y out of bounds: $y"
+        if ($y < 289_000 or $y > 629_000);
+
+    return ($x, $y, $h);
+}
+
+sub _to_rads {
+    return $_[0] * 2*3.14159_26535_89793 /360;
+}
+
+sub _from_rads {
+    return $_[0] / (2*3.14159_26535_89793) *360;
+}
+
+sub _ellipsoid_to_cartesian {
+    my ($lat, $lon, $h, $para) = @_;
+
+    my $sinphi = sin(_to_rads($lat));
+    my $cosphi = cos(_to_rads($lat));
+    my $n = $para->{a}/sqrt(1 - $para->{e2}*$sinphi*$sinphi);
+
+    return (($n+$h)*$cosphi*cos(_to_rads($lon)),
+            ($n+$h)*$cosphi*sin(_to_rads($lon)),
+            ($n*(1-$para->{e2})+$h)*$sinphi );
+}
+
+# Returns (lat, lon, h) in degrees.
+
+sub _cartesian_to_ellipsoid {
+    my ($x, $y, $z, $para) = @_;
+
+    my $lon = atan2($y, $x);
+
+    my $r = sqrt($x*$x+$y*$y);
+    my $phi = 0;
+    my $n_sinphi = $z;
+    my $n;
+    my $oldphi;
+
+    do {
+        $oldphi = $phi;
+        $phi = atan2($z + $para->{e2}*$n_sinphi, $r);
+        my $sinphi = sin($phi);
+        $n = $para->{a}/sqrt(1-$para->{e2}*$sinphi*$sinphi);
+        $n_sinphi = $n*$sinphi;
+    } while (abs($oldphi-$phi) > 1e-8);
+
+    my $h = $r/cos($phi) - $n;
+
+    return (_from_rads($phi), _from_rads($lon), $h);
+}
+
+sub _transform_datum {
+    my ($x, $y, $z, $t, $centre) = @_;
+
+    return (
+        $x + $t->{d}*($x-$centre->[0]) + $t->{c}*($y-$centre->[1])
+            - $t->{b}*($z-$centre->[2]) + $t->{tx},
+        $y - $t->{c}*($x-$centre->[0]) + $t->{d}*($y-$centre->[1])
+            + $t->{a}*($z-$centre->[2]) + $t->{ty},
+        $z + $t->{b}*($x-$centre->[0]) - $t->{a}*($y-$centre->[1])
+            + $t->{d}*($z-$centre->[2]) + $t->{tz}
+    );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Geo::Coordinates::RDNAP - convert to/from Dutch RDNAP coordinate system
+
+=head1 SYNOPSIS
+
+  use Geo::Coordinates::RDNAP qw/from_rd to_rd dd dms/;
+
+  # RD coordinates and height in meters
+  my ($lat, $lon, $h) = from_rd( 150_000, 480_000, -2.75 );
+
+  printf "%d %d' %.2f\" %d %d' %.2f\"", dms($lat, $lon);
+
+  lat/lon coordinates in degrees; height in meters
+  my ($x, $y, $h) = to_rd( 52.75, 6.80, 10 );
+
+  # equivalent: to_rd( deg(52,45,0, 6,48,0), 10 );
+
+=head1 DESCRIPTION
+
+This module converts between two coordinate systems: RD-NAP and ETRS89.
+ETRS89 is a geodesic frame of reference used in Europe, which is
+approximately equal to the international reference frame WGS84.
+GPS data. Coordinates in ETRS89 are given in degrees (latitude and
+longitude) and meters (height above the reference ellipsoid).
+
+RD-NAP (or "Amersfoort datum") is a Dutch coordinate system, consisting
+of the X and Y coordinates of the Rijksdriehoekmeting, used e.g. in
+topographical maps, and a Z coordinate which is the height above Normaal
+Amsterdams Peil, the mean sea level at Amsterdam. X, Y, and Z are all
+expressed in meters (this is a change compared to the previous versions
+of this module!)
+
+These transformations should only be used for locations in or close to
+the Netherlands.
+
+See http://www.rdnap.nl/ for a description of the RD-NAP system;
+especially http://www.rdnap.nl/download/rdnaptrans.pdf for the formulas
+used in this module.
+
+=head2 Precision
+
+This module implements an approximated transformation, which should be
+accurate to about 25 cm in X and Y, and about 1 meter in the vertical
+direction, for all locations in the Netherlands. The full
+transformation, called RDNAPTRANS, is NOT implemented in this module. It
+takes into account small deviations, measured at more than 5000 points
+in the Netherlands.
+
+Coordinates in ETRS89 deviate from WGS84 and ITRS because the former is
+coupled to the Eurasian plate, which drifts a few cm per year compared
+to other plates. The current (2006) difference between these coordinate
+systems is in the order of 40 cm.
+
+=head2 Disclaimer
+
+Although this module implements conversion to/from the RD-NAP coordinate
+system, it is not a product of RDNAP, the cooperation between the
+Kadaster and Rijkwaterstaat, which maintains this coordinate system.
+
+RDNAPTRANS is a trademark, presumably by Kadaster and/or
+Rijkswaterstaat. This module is not an implementation of RDNAPTRANS. For
+the official transformation software, visit http://www.rdnap.nl.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item from_rd( $x, $y, $h )
+
+Converts coordinates in the RD-NAP coordinate system to geographical
+coordinates. The input are the X and Y coordinates in the RD system,
+given in meters, and optionally the height above NAP in meters.
+
+This should only be used for points in or close to the Netherlands. For
+this area, X should roughly be between 0 and 300_000, and Y between
+300_000 and 650_000.
+
+The output is a list of three numbers: latitude and longitude in
+degrees, according to the ETRS89 coordinate system, and height above the
+ETRS89 reference geoid, in meters.
+
+=item to_rd( $lat, $lon, $h )
+
+Converts geegraphical coordinates to coordinates in the RD-NAP
+coordinate system. The input are the latituse and longitude in degrees,
+and optionally the height above the ETRS89 reference geoid in meters.
+
+This should only be used for points in or close to the Netherlands.
+
+The output is a list of three numbers: X and Y in the RD system in
+meters, and the height above NAP in meters.
+
+=item deg
+
+Helper function to convert degrees/minutes/seconds to decimal degrees.
+Works only for positive latitude and longitude.
+
+=item dms
+
+Helper function to convert decimal degrees to degrees/minutes/seconds.
+Works only for positive latitude and longitude. The returned degrees and
+minutes are integers; the returned number of seconds can be fractional.
+
+When rounding the number of seconds, remember that it wraps at 60 (and
+so does the number of minutes). One easy way (but perhaps not the
+fastest) of taking this into account is the following piece of code:
+
+    ($d, $m, $s) = dms($degrees);
+    $s = int($s + 0.5);
+    ($d, $m, $s) = map {sprintf "%.0f"} dms(deg($d, $m, $s));
+
+=back
+
+=head1 BUGS
+
+None known.
+
+=head1 AUTHOR
+
+Eugene van der Pijll C<< <pijll@cpan.org> >>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006 Eugene van der Pijll.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+The full text of the license can be found in the LICENSE file included
+with this module.
+
+=cut
Index: /rdnap/lib/Params/Validate.pm
===================================================================
--- /rdnap/lib/Params/Validate.pm	(revision 203)
+++ /rdnap/lib/Params/Validate.pm	(revision 203)
@@ -0,0 +1,737 @@
+package Params::Validate;
+
+use strict;
+
+BEGIN {
+    use Exporter;
+    use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK
+        %EXPORT_TAGS %OPTIONS $options $NO_VALIDATION );
+
+    @ISA = 'Exporter';
+
+    $VERSION = '0.95';
+
+    my %tags = (
+        types => [
+            qw( SCALAR ARRAYREF HASHREF CODEREF GLOB GLOBREF
+                SCALARREF HANDLE BOOLEAN UNDEF OBJECT )
+        ],
+    );
+
+    %EXPORT_TAGS = (
+        'all' => [
+            qw( validate validate_pos validation_options validate_with ),
+            map { @{ $tags{$_} } } keys %tags
+        ],
+        %tags,
+    );
+
+    @EXPORT_OK = ( @{ $EXPORT_TAGS{all} }, 'set_options' );
+    @EXPORT = qw( validate validate_pos );
+
+    $NO_VALIDATION = $ENV{PERL_NO_VALIDATION};
+
+    eval { require Params::ValidateXS; } unless $ENV{PV_TEST_PERL};
+
+    if ( $@ || $ENV{PV_TEST_PERL} ) {
+        require Params::ValidatePP;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Params::Validate - Validate method/function parameters
+
+=head1 SYNOPSIS
+
+  use Params::Validate qw(:all);
+
+  # takes named params (hash or hashref)
+  sub foo
+  {
+      validate( @_, { foo => 1, # mandatory
+		      bar => 0, # optional
+		    }
+	      );
+  }
+
+  # takes positional params
+  sub bar
+  {
+      # first two are mandatory, third is optional
+      validate_pos( @_, 1, 1, 0 );
+  }
+
+
+  sub foo2
+  {
+      validate( @_,
+		{ foo =>
+		  # specify a type
+		  { type => ARRAYREF },
+
+		  bar =>
+		  # specify an interface
+		  { can => [ 'print', 'flush', 'frobnicate' ] },
+
+		  baz =>
+		  { type => SCALAR,   # a scalar ...
+               	    # ... that is a plain integer ...
+                    regex => qr/^\d+$/,
+		    callbacks =>
+		    { # ... and smaller than 90
+		      'less than 90' => sub { shift() < 90 },
+		    },
+		  }
+		}
+	      );
+  }
+
+  sub with_defaults
+  {
+       my %p = validate( @_, { foo => 1, # required
+                               # $p{bar} will be 99 if bar is not
+                               # given.  bar is now optional.
+                               bar => { default => 99 } } );
+  }
+
+  sub pos_with_defaults
+  {
+       my @p = validate_pos( @_, 1, { default => 99 } );
+  }
+
+  sub sets_options_on_call
+  {
+       my %p = validate_with
+                   ( params => \@_,
+                     spec   => { foo => { type SCALAR, default => 2 } },
+                     normalize_keys => sub { $_[0] =~ s/^-//; lc $_[0] },
+                   );
+  }
+
+=head1 DESCRIPTION
+
+The Params::Validate module allows you to validate method or function
+call parameters to an arbitrary level of specificity.  At the simplest
+level, it is capable of validating the required parameters were given
+and that no unspecified additional parameters were passed in.
+
+It is also capable of determining that a parameter is of a specific
+type, that it is an object of a certain class hierarchy, that it
+possesses certain methods, or applying validation callbacks to
+arguments.
+
+=head2 EXPORT
+
+The module always exports the C<validate()> and C<validate_pos()>
+functions.
+
+It also has an additional function available for export,
+C<validate_with>, which can be used to validate any type of
+parameters, and set various options on a per-invocation basis.
+
+In addition, it can export the following constants, which are used as
+part of the type checking.  These are C<SCALAR>, C<ARRAYREF>,
+C<HASHREF>, C<CODEREF>, C<GLOB>, C<GLOBREF>, and C<SCALARREF>,
+C<UNDEF>, C<OBJECT>, C<BOOLEAN>, and C<HANDLE>.  These are explained
+in the section on L<Type Validation|Params::Validate/Type Validation>.
+
+The constants are available via the export tag C<:types>.  There is
+also an C<:all> tag which includes all of the constants as well as the
+C<validation_options()> function.
+
+=head1 PARAMETER VALIDATION
+
+The validation mechanisms provided by this module can handle both
+named or positional parameters.  For the most part, the same features
+are available for each.  The biggest difference is the way that the
+validation specification is given to the relevant subroutine.  The
+other difference is in the error messages produced when validation
+checks fail.
+
+When handling named parameters, the module will accept either a hash
+or a hash reference.
+
+Subroutines expecting named parameters should call the C<validate()>
+subroutine like this:
+
+ validate( @_, { parameter1 => validation spec,
+                 parameter2 => validation spec,
+                 ...
+               } );
+
+Subroutines expecting positional parameters should call the
+C<validate_pos()> subroutine like this:
+
+ validate_pos( @_, { validation spec }, { validation spec } );
+
+=head2 Mandatory/Optional Parameters
+
+If you just want to specify that some parameters are mandatory and
+others are optional, this can be done very simply.
+
+For a subroutine expecting named parameters, you would do this:
+
+ validate( @_, { foo => 1, bar => 1, baz => 0 } );
+
+This says that the "foo" and "bar" parameters are mandatory and that
+the "baz" parameter is optional.  The presence of any other
+parameters will cause an error.
+
+For a subroutine expecting positional parameters, you would do this:
+
+ validate_pos( @_, 1, 1, 0, 0 );
+
+This says that you expect at least 2 and no more than 4 parameters.
+If you have a subroutine that has a minimum number of parameters but
+can take any maximum number, you can do this:
+
+ validate_pos( @_, 1, 1, (0) x (@_ - 2) );
+
+This will always be valid as long as at least two parameters are
+given.  A similar construct could be used for the more complex
+validation parameters described further on.
+
+Please note that this:
+
+ validate_pos( @_, 1, 1, 0, 1, 1 );
+
+makes absolutely no sense, so don't do it.  Any zeros must come at the
+end of the validation specification.
+
+In addition, if you specify that a parameter can have a default, then
+it is considered optional.
+
+=head2 Type Validation
+
+This module supports the following simple types, which can be
+L<exported as constants|/EXPORT>:
+
+=over 4
+
+=item * SCALAR
+
+A scalar which is not a reference, such as C<10> or C<'hello'>.  A
+parameter that is undefined is B<not> treated as a scalar.  If you
+want to allow undefined values, you will have to specify C<SCALAR |
+UNDEF>.
+
+=item * ARRAYREF
+
+An array reference such as C<[1, 2, 3]> or C<\@foo>.
+
+=item * HASHREF
+
+A hash reference such as C<< { a => 1, b => 2 } >> or C<\%bar>.
+
+=item * CODEREF
+
+A subroutine reference such as C<\&foo_sub> or C<sub { print "hello" }>.
+
+=item * GLOB
+
+This one is a bit tricky.  A glob would be something like C<*FOO>, but
+not C<\*FOO>, which is a glob reference.  It should be noted that this
+trick:
+
+ my $fh = do { local *FH; };
+
+makes C<$fh> a glob, not a glob reference.  On the other hand, the
+return value from C<Symbol::gensym> is a glob reference.  Either can
+be used as a file or directory handle.
+
+=item * GLOBREF
+
+A glob reference such as C<\*FOO>.  See the L<GLOB|GLOB> entry above
+for more details.
+
+=item * SCALARREF
+
+A reference to a scalar such as C<\$x>.
+
+=item * UNDEF
+
+An undefined value
+
+=item * OBJECT
+
+A blessed reference.
+
+=item * BOOLEAN
+
+This is a special option, and is just a shortcut for C<UNDEF | SCALAR>.
+
+=item * HANDLE
+
+This option is also special, and is just a shortcut for C<GLOB |
+GLOBREF>.  However, it seems likely that most people interested in
+either globs or glob references are likely to really be interested in
+whether the parameter in question could be a valid file or directory
+handle.
+
+=back
+
+To specify that a parameter must be of a given type when using named
+parameters, do this:
+
+ validate( @_, { foo => { type => SCALAR },
+                 bar => { type => HASHREF } } );
+
+If a parameter can be of more than one type, just use the bitwise or
+(C<|>) operator to combine them.
+
+ validate( @_, { foo => { type => GLOB | GLOBREF } );
+
+For positional parameters, this can be specified as follows:
+
+ validate_pos( @_, { type => SCALAR | ARRAYREF }, { type => CODEREF } );
+
+=head2 Interface Validation
+
+To specify that a parameter is expected to have a certain set of
+methods, we can do the following:
+
+ validate( @_,
+           { foo =>
+             # just has to be able to ->bar
+             { can => 'bar' } } );
+
+ ... or ...
+
+ validate( @_,
+           { foo =>
+             # must be able to ->bar and ->print
+             { can => [ qw( bar print ) ] } } );
+
+=head2 Class Validation
+
+A word of warning.  When constructing your external interfaces, it is
+probably better to specify what methods you expect an object to
+have rather than what class it should be of (or a child of).  This
+will make your API much more flexible.
+
+With that said, if you want to validate that an incoming parameter
+belongs to a class (or child class) or classes, do:
+
+ validate( @_,
+           { foo =>
+             { isa => 'My::Frobnicator' } } );
+
+ ... or ...
+
+ validate( @_,
+           { foo =>
+             { isa => [ qw( My::Frobnicator IO::Handle ) ] } } );
+ # must be both, not either!
+
+=head2 Regex Validation
+
+If you want to specify that a given parameter must match a specific
+regular expression, this can be done with "regex" spec key.  For
+example:
+
+
+ validate( @_,
+           { foo =>
+             { regex => qr/^\d+$/ } } );
+
+The value of the "regex" key may be either a string or a pre-compiled
+regex created via C<qr>.
+
+If the value being checked against a regex is undefined, the regex is
+explicitly checked against the empty string ('') instead, in order to
+avoid "Use of uninitialized value" warnings.
+
+The C<Regexp::Common> module on CPAN is an excellent source of regular
+expressions suitable for validating input.
+
+=head2 Callback Validation
+
+If none of the above are enough, it is possible to pass in one or more
+callbacks to validate the parameter.  The callback will be given the
+B<value> of the parameter as its first argument.  Its second argument
+will be all the parameters, as a reference to either a hash or array.
+Callbacks are specified as hash reference.  The key is an id for the
+callback (used in error messages) and the value is a subroutine
+reference, such as:
+
+ validate( @_,
+           { foo =>
+             { callbacks =>
+               { 'smaller than a breadbox' => sub { shift() < $breadbox },
+                 'green or blue' =>
+                  sub { $_[0] eq 'green' || $_[0] eq 'blue' } } } );
+
+ validate( @_,
+           { foo =>
+             { callbacks =>
+               { 'bigger than baz' => sub { $_[0] > $_[1]->{baz} } } } } );
+
+=head2 Untainting
+
+If you want values untainted, set the "untaint" key in a spec hashref
+to a true value, like this:
+
+ my %p =
+   validate( @_, { foo =>
+                   { type => SCALAR, untaint => 1 },
+                   bar =>
+                   { type => ARRAYREF } } );
+
+This will untaint the "foo" parameter if the parameters are valid.
+
+Note that untainting is only done if I<all parameters> are valid.
+Also, only the return values are untainted, not the original values
+passed into the validation function.
+
+Asking for untainting of a reference value will not do anything, as
+C<Params::Validate> will only attempt to untaint the reference itself.
+
+=head2 Mandatory/Optional Revisited
+
+If you want to specify something such as type or interface, plus the
+fact that a parameter can be optional, do this:
+
+ validate( @_, { foo =>
+                 { type => SCALAR },
+                 bar =>
+                 { type => ARRAYREF, optional => 1 } } );
+
+or this for positional parameters:
+
+ validate_pos( @_, { type => SCALAR }, { type => ARRAYREF, optional => 1 } );
+
+By default, parameters are assumed to be mandatory unless specified as
+optional.
+
+=head2 Dependencies
+
+It also possible to specify that a given optional parameter depends on
+the presence of one or more other optional parameters.
+
+ validate( @_, { cc_number =>
+                 { type => SCALAR, optional => 1,
+                   depends => [ 'cc_expiration', 'cc_holder_name' ],
+                 },
+                 cc_expiration
+                 { type => SCALAR, optional => 1 },
+                 cc_holder_name
+                 { type => SCALAR, optional => 1 },
+               } );
+
+In this case, "cc_number", "cc_expiration", and "cc_holder_name" are
+all optional.  However, if "cc_number" is provided, then
+"cc_expiration" and "cc_holder_name" must be provided as well.
+
+This allows you to group together sets of parameters that all must be
+provided together.
+
+The C<validate_pos()> version of dependencies is slightly different,
+in that you can only depend on one other parameter.  Also, if for
+example, the second parameter 2 depends on the fourth parameter, then
+it implies a dependency on the third parameter as well.  This is
+because if the fourth parameter is required, then the user must also
+provide a third parameter so that there can be four parameters in
+total.
+
+C<Params::Validate> will die if you try to depend on a parameter not
+declared as part of your parameter specification.
+
+=head2 Specifying defaults
+
+If the C<validate()> or C<validate_pos()> functions are called in a
+list context, they will return an array or hash containing the
+original parameters plus defaults as indicated by the validation spec.
+
+If the function is not called in a list context, providing a default
+in the validation spec still indicates that the parameter is optional.
+
+The hash or array returned from the function will always be a copy of
+the original parameters, in order to leave C<@_> untouched for the
+calling function.
+
+Simple examples of defaults would be:
+
+ my %p = validate( @_, { foo => 1, bar => { default => 99 } } );
+
+ my @p = validate( @_, 1, { default => 99 } );
+
+In scalar context, a hash reference or array reference will be
+returned, as appropriate.
+
+=head1 USAGE NOTES
+
+=head2 Validation failure
+
+By default, when validation fails C<Params::Validate> calls
+C<Carp::confess()>.  This can be overridden by setting the C<on_fail>
+option, which is described in the L<"GLOBAL" OPTIONS|"GLOBAL" OPTIONS>
+section.
+
+=head2 Method calls
+
+When using this module to validate the parameters passed to a method
+call, you will probably want to remove the class/object from the
+parameter list B<before> calling C<validate()> or C<validate_pos()>.
+If your method expects named parameters, then this is necessary for
+the C<validate()> function to actually work, otherwise C<@_> will not
+be useable as a hash, because it will first have your object (or
+class) B<followed> by a set of keys and values.
+
+Thus the idiomatic usage of C<validate()> in a method call will look
+something like this:
+
+ sub method
+ {
+     my $self = shift;
+
+     my %params = validate( @_, { foo => 1, bar => { type => ARRAYREF } } );
+ }
+
+=head1 "GLOBAL" OPTIONS
+
+Because the API for the C<validate()> and C<validate_pos()> functions
+does not make it possible to specify any options other than the the
+validation spec, it is possible to set some options as
+pseudo-'globals'.  These allow you to specify such things as whether
+or not the validation of named parameters should be case sensitive,
+for one example.
+
+These options are called pseudo-'globals' because these settings are
+B<only applied to calls originating from the package that set the
+options>.
+
+In other words, if I am in package C<Foo> and I call
+C<validation_options()>, those options are only in effect when I call
+C<validate()> from package C<Foo>.
+
+While this is quite different from how most other modules operate, I
+feel that this is necessary in able to make it possible for one
+module/application to use Params::Validate while still using other
+modules that also use Params::Validate, perhaps with different
+options set.
+
+The downside to this is that if you are writing an app with a standard
+calling style for all functions, and your app has ten modules, B<each
+module must include a call to C<validation_options()>>. You could of
+course write a module that all your modules use which uses various
+trickery to do this when imported.
+
+=head2 Options
+
+=over 4
+
+=item * normalize_keys => $callback
+
+This option is only relevant when dealing with named parameters.
+
+This callback will be used to transform the hash keys of both the
+parameters and the parameter spec when C<validate()> or
+C<validate_with()> are called.
+
+Any alterations made by this callback will be reflected in the
+parameter hash that is returned by the validation function.  For
+example:
+
+  sub foo {
+      return
+        validate_with( params => \@_,
+                       spec   => { foo => { type => SCALAR } },
+                       normalize_keys =>
+                       sub { my $k = shift; $k =~ s/^-//; return uc $k },
+                     );
+
+  }
+
+  %p = foo( foo => 20 );
+
+  # $p{FOO} is now 20
+
+  %p = foo( -fOo => 50 );
+
+  # $p{FOO} is now 50
+
+The callback must return a defined value.
+
+If a callback is given than the deprecated "ignore_case" and
+"strip_leading" options are ignored.
+
+=item * allow_extra => $boolean
+
+If true, then the validation routine will allow extra parameters not
+named in the validation specification.  In the case of positional
+parameters, this allows an unlimited number of maximum parameters
+(though a minimum may still be set).  Defaults to false.
+
+=item * on_fail => $callback
+
+If given, this callback will be called whenever a validation check
+fails.  It will be called with a single parameter, which will be a
+string describing the failure.  This is useful if you wish to have
+this module throw exceptions as objects rather than as strings, for
+example.
+
+This callback is expected to C<die()> internally.  If it does not, the
+validation will proceed onwards, with unpredictable results.
+
+The default is to simply use the Carp module's C<confess()> function.
+
+=item * stack_skip => $number
+
+This tells Params::Validate how many stack frames to skip when finding
+a subroutine name to use in error messages.  By default, it looks one
+frame back, at the immediate caller to C<validate()> or
+C<validate_pos()>.  If this option is set, then the given number of
+frames are skipped instead.
+
+=item * ignore_case => $boolean
+
+DEPRECATED
+
+This is only relevant when dealing with named parameters.  If it is
+true, then the validation code will ignore the case of parameter
+names.  Defaults to false.
+
+=item * strip_leading => $characters
+
+DEPRECATED
+
+This too is only relevant when dealing with named parameters.  If this
+is given then any parameters starting with these characters will be
+considered equivalent to parameters without them entirely.  For
+example, if this is specified as '-', then C<-foo> and C<foo> would be
+considered identical.
+
+=back
+
+=head1 PER-INVOCATION OPTIONS
+
+The C<validate_with()> function can be used to set the options listed
+above on a per-invocation basis.  For example:
+
+  my %p =
+      validate_with
+          ( params => \@_,
+            spec   => { foo => { type => SCALAR },
+                        bar => { default => 10 } },
+            allow_extra => 1,
+          );
+
+In addition to the options listed above, it is also possible to set
+the option "called", which should be a string.  This string will be
+used in any error messages caused by a failure to meet the validation
+spec.
+
+This subroutine will validate named parameters as a hash if the "spec"
+parameter is a hash reference.  If it is an array reference, the
+parameters are assumed to be positional.
+
+  my %p =
+      validate_with
+          ( params => \@_,
+            spec   => { foo => { type => SCALAR },
+                        bar => { default => 10 } },
+            allow_extra => 1,
+            called => 'The Quux::Baz class constructor',
+          );
+
+  my @p =
+      validate_with
+          ( params => \@_,
+            spec   => [ { type => SCALAR },
+                        { default => 10 } ],
+            allow_extra => 1,
+            called => 'The Quux::Baz class constructor',
+          );
+
+=head1 DISABLING VALIDATION
+
+If the environment variable C<PERL_NO_VALIDATION> is set to something
+true, then validation is turned off.  This may be useful if you only
+want to use this module during development but don't want the speed
+hit during production.
+
+The only error that will be caught will be when an odd number of
+parameters are passed into a function/method that expects a hash.
+
+If you want to selectively turn validation on and off at runtime, you
+can directly set the C<$Params::Validate::NO_VALIDATION> global
+variable.  It is B<strongly> recommended that you B<localize> any
+changes to this variable, because other modules you are using may
+expect validation to be on when they execute.  For example:
+
+
+  {
+      local $Params::Validate::NO_VALIDATION = 1;
+      # no error
+      foo( bar => 2 );
+  }
+
+  # error
+  foo( bar => 2 );
+
+  sub foo
+  {
+      my %p = validate( @_, { foo => 1 } );
+      ...
+  }
+
+But if you want to shoot yourself in the foot and just turn it off, go
+ahead!
+
+=head1 LIMITATIONS
+
+Right now there is no way (short of a callback) to specify that
+something must be of one of a list of classes, or that it must possess
+one of a list of methods.  If this is desired, it can be added in the
+future.
+
+Ideally, there would be only one validation function.  If someone
+figures out how to do this, please let me know.
+
+=head1 SUPPORT
+
+Please submit bugs and patches to the CPAN RT system at
+http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Params%3A%3AValidate or
+via email at bug-params-validate@rt.cpan.org.
+
+Support questions can be sent to Dave at autarch@urth.org.
+
+The code repository is at https://svn.urth.org/svn/Params-Validate/
+
+=head1 DONATIONS
+
+If you'd like to thank me for the work I've done on this module,
+please consider making a "donation" to me via PayPal. I spend a lot of
+free time creating free software, and would appreciate any support
+you'd care to offer.
+
+Please note that B<I am not suggesting that you must do this> in order
+for me to continue working on this particular software. I will
+continue to do so, inasmuch as I have in the past, for as long as it
+interests me.
+
+Similarly, a donation made in this way will probably not make me work
+on this software much more, unless I get so many donations that I can
+consider working on free software full time, which seems unlikely at
+best.
+
+To donate, log into PayPal and send money to autarch@urth.org or use
+the button on this page:
+L<http://www.urth.org/~autarch/fs-donation.html>
+
+=head1 AUTHORS
+
+Dave Rolsky, <autarch@urth.org> and Ilya Martynov <ilya@martynov.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004-2007 David Rolsky.  All rights reserved.  This
+program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Index: /rdnap/lib/Params/Validate.xs
===================================================================
--- /rdnap/lib/Params/Validate.xs	(revision 203)
+++ /rdnap/lib/Params/Validate.xs	(revision 203)
@@ -0,0 +1,1768 @@
+/* Copyright (c) 2000-2009 Dave Rolsky
+   All rights reserved.
+   This program is free software; you can redistribute it and/or
+   modify it under the same terms as Perl itself.  See the LICENSE
+   file that comes with this distribution for more details. */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#define NEED_eval_pv
+#define NEED_sv_2pv_nolen
+#define NEED_newCONSTSUB
+#include "ppport.h"
+
+#ifdef __GNUC__
+#define INLINE inline
+#else
+#define INLINE
+#endif
+
+/* type constants */
+#define SCALAR    1
+#define ARRAYREF  2
+#define HASHREF   4
+#define CODEREF   8
+#define GLOB      16
+#define GLOBREF   32
+#define SCALARREF 64
+#define UNKNOWN   128
+#define UNDEF     256
+#define OBJECT    512
+
+#define HANDLE    (GLOB | GLOBREF)
+#define BOOLEAN   (SCALAR | UNDEF)
+
+/* return data macros */
+#define RETURN_ARRAY(ret) \
+    STMT_START \
+    { \
+        I32 i; \
+        switch(GIMME_V) \
+        { \
+            case G_VOID: \
+                return; \
+                case G_ARRAY: \
+                    EXTEND(SP, av_len(ret) + 1); \
+                    for(i = 0; i <= av_len(ret); i++) \
+                    { \
+                        PUSHs(*av_fetch(ret, i, 1)); \
+                    } \
+                    break; \
+                    case G_SCALAR: \
+                        XPUSHs(sv_2mortal(newRV_inc((SV*) ret))); \
+                        break; \
+                    } \
+                } STMT_END \
+
+#define RETURN_HASH(ret) \
+    STMT_START \
+    { \
+        HE* he; \
+        I32 keys; \
+        switch(GIMME_V) \
+        { \
+            case G_VOID: \
+                return; \
+                case G_ARRAY: \
+                    keys = hv_iterinit(ret); \
+                    EXTEND(SP, keys * 2); \
+                    while ((he = hv_iternext(ret))) \
+                    { \
+                        PUSHs(HeSVKEY_force(he)); \
+                        PUSHs(HeVAL(he)); \
+                    } \
+                    break; \
+                    case G_SCALAR: \
+                        XPUSHs(sv_2mortal(newRV_inc((SV*) ret))); \
+                        break; \
+                    } \
+                } STMT_END
+
+    /* These macros are used because Perl 5.6.1 (and presumably 5.6.0)
+           have problems if we try to die directly from XS code.  So instead,
+           we just set some global variables and return 0.  For 5.6.0,
+           validate(), validate_pos(), and validate_with() are thin Perl level
+           wrappers which localize these globals, call the XS sub, and then
+           check the globals afterwards. */
+
+#if (PERL_VERSION == 6)          /* 5.6.0 or 5.6.1 */
+#define FAIL(message, options) \
+    { \
+        SV* perl_error; \
+        SV* perl_on_fail; \
+        SV* on_fail; \
+        perl_error = get_sv("Params::Validate::ERROR", 0); \
+        if (! perl_error) \
+            croak("Cannot retrieve $Params::Validate::ERROR\n"); \
+        perl_on_fail = get_sv("Params::Validate::ON_FAIL", 0); \
+        if (! perl_on_fail) \
+            croak("Cannot retrieve $Params::Validate::ON_FAIL\n"); \
+        SvSetSV(perl_error, message); \
+        on_fail = get_on_fail(options); \
+        SvSetSV(perl_on_fail, on_fail); \
+        return 0; \
+    }
+#else                            /* any other version*/
+#define FAIL(message, options) \
+    validation_failure(message, options);
+#endif                           /* PERL_VERSION */
+
+/* module initialization */
+static void
+bootinit() {
+    HV* stash;
+
+    /* define constants */
+    stash = gv_stashpv("Params::Validate", 1);
+    newCONSTSUB(stash, "SCALAR", newSViv(SCALAR));
+    newCONSTSUB(stash, "ARRAYREF", newSViv(ARRAYREF));
+    newCONSTSUB(stash, "HASHREF", newSViv(HASHREF));
+    newCONSTSUB(stash, "CODEREF", newSViv(CODEREF));
+    newCONSTSUB(stash, "GLOB", newSViv(GLOB));
+    newCONSTSUB(stash, "GLOBREF", newSViv(GLOBREF));
+    newCONSTSUB(stash, "SCALARREF", newSViv(SCALARREF));
+    newCONSTSUB(stash, "UNKNOWN", newSViv(UNKNOWN));
+    newCONSTSUB(stash, "UNDEF", newSViv(UNDEF));
+    newCONSTSUB(stash, "OBJECT", newSViv(OBJECT));
+    newCONSTSUB(stash, "HANDLE", newSViv(HANDLE));
+    newCONSTSUB(stash, "BOOLEAN", newSViv(BOOLEAN));
+}
+
+
+INLINE static bool
+no_validation() {
+    SV* no_v;
+
+    no_v = perl_get_sv("Params::Validate::NO_VALIDATION", 0);
+    if (! no_v)
+        croak("Cannot retrieve $Params::Validate::NO_VALIDATION\n");
+
+    return SvTRUE(no_v);
+}
+
+
+/* return type string that corresponds to typemask */
+INLINE static SV*
+typemask_to_string(IV mask) {
+    SV* buffer;
+    IV empty = 1;
+
+    buffer = sv_2mortal(newSVpv("", 0));
+
+    if (mask & SCALAR) {
+        sv_catpv(buffer, "scalar");
+        empty = 0;
+    }
+    if (mask & ARRAYREF) {
+        sv_catpv(buffer, empty ? "arrayref" : " arrayref");
+        empty = 0;
+    }
+    if (mask & HASHREF) {
+        sv_catpv(buffer, empty ? "hashref" : " hashref");
+        empty = 0;
+    }
+    if (mask & CODEREF) {
+        sv_catpv(buffer, empty ? "coderef" : " coderef");
+        empty = 0;
+    }
+    if (mask & GLOB) {
+        sv_catpv(buffer, empty ? "glob" : " glob");
+        empty = 0;
+    }
+    if (mask & GLOBREF) {
+        sv_catpv(buffer, empty ? "globref" : " globref");
+        empty = 0;
+    }
+    if (mask & SCALARREF) {
+        sv_catpv(buffer, empty ? "scalarref" : " scalarref");
+        empty = 0;
+    }
+    if (mask & UNDEF) {
+        sv_catpv(buffer, empty ? "undef" : " undef");
+        empty = 0;
+    }
+    if (mask & OBJECT) {
+        sv_catpv(buffer, empty ? "object" : " object");
+        empty = 0;
+    }
+    if (mask & UNKNOWN) {
+        sv_catpv(buffer, empty ? "unknown" : " unknown");
+        empty = 0;
+    }
+
+    return buffer;
+}
+
+
+/* compute numberic datatype for variable */
+INLINE static IV
+get_type(SV* sv) {
+    IV type = 0;
+
+    if (SvTYPE(sv) == SVt_PVGV) {
+        return GLOB;
+    }
+    if (!SvOK(sv)) {
+        return UNDEF;
+    }
+    if (!SvROK(sv)) {
+        return SCALAR;
+    }
+
+    switch (SvTYPE(SvRV(sv))) {
+        case SVt_NULL:
+        case SVt_IV:
+        case SVt_NV:
+        case SVt_PV:
+        #if PERL_VERSION <= 10
+        case SVt_RV:
+        #endif
+        case SVt_PVMG:
+        case SVt_PVIV:
+        case SVt_PVNV:
+        #if PERL_VERSION <= 8
+        case SVt_PVBM:
+        #elif PERL_VERSION >= 11
+        case SVt_REGEXP:
+        #endif
+            type = SCALARREF;
+            break;
+        case SVt_PVAV:
+            type = ARRAYREF;
+            break;
+        case SVt_PVHV:
+            type = HASHREF;
+            break;
+        case SVt_PVCV:
+            type = CODEREF;
+            break;
+        case SVt_PVGV:
+            type = GLOBREF;
+            break;
+            /* Perl 5.10 has a bunch of new types that I don't think will ever
+               actually show up here (I hope), but not handling them makes the
+               C compiler cranky. */
+        default:
+            type = UNKNOWN;
+            break;
+    }
+
+    if (type) {
+        if (sv_isobject(sv)) return type | OBJECT;
+        return type;
+    }
+
+    /* Getting here should not be possible */
+    return UNKNOWN;
+}
+
+
+/* get an article for given string */
+INLINE
+#if (PERL_VERSION >= 6)          /* Perl 5.6.0+ */
+static const char*
+#else
+static char*
+#endif
+article(SV* string) {
+    STRLEN len;
+    char* rawstr;
+
+    rawstr = SvPV(string, len);
+    if (len) {
+        switch(rawstr[0]) {
+            case 'a':
+            case 'e':
+            case 'i':
+            case 'o':
+            case 'u':
+                return "an";
+        }
+    }
+
+    return "a";
+}
+
+
+#if (PERL_VERSION == 6)          /* 5.6.0 or 5.6.1 */
+static SV*
+get_on_fail(HV* options) {
+    SV** temp;
+
+    if ((temp = hv_fetch(options, "on_fail", 7, 0))) {
+        SvGETMAGIC(*temp);
+        return *temp;
+    }
+    else {
+        return &PL_sv_undef;
+    }
+}
+#endif                           /* PERL_VERSION */
+
+#if (PERL_VERSION != 6)          /* not used with 5.6.0 or 5.6.1 */
+/* raises exception either using user-defined callback or using
+   built-in method */
+static void
+validation_failure(SV* message, HV* options) {
+    SV** temp;
+    SV* on_fail;
+
+    if ((temp = hv_fetch(options, "on_fail", 7, 0))) {
+        SvGETMAGIC(*temp);
+        on_fail = *temp;
+    }
+    else {
+        on_fail = NULL;
+    }
+
+    /* use user defined callback if available */
+    if (on_fail) {
+        dSP;
+        PUSHMARK(SP);
+        XPUSHs(message);
+        PUTBACK;
+        call_sv(on_fail, G_DISCARD);
+    }
+
+    /* by default resort to Carp::confess for error reporting */
+    {
+        dSP;
+        perl_require_pv("Carp.pm");
+        PUSHMARK(SP);
+        XPUSHs(message);
+        PUTBACK;
+        call_pv("Carp::confess", G_DISCARD);
+    }
+
+    return;
+}
+#endif                           /* PERL_VERSION */
+
+/* get called subroutine fully qualified name */
+static SV*
+get_called(HV* options) {
+    SV** temp;
+
+    if ((temp = hv_fetch(options, "called", 6, 0))) {
+        SvGETMAGIC(*temp);
+        return *temp;
+    }
+    else {
+        IV frame;
+        SV* buffer;
+        SV* caller;
+
+        if ((temp = hv_fetch(options, "stack_skip", 10, 0))) {
+            SvGETMAGIC(*temp);
+            frame = SvIV(*temp);
+        }
+        else {
+            frame = 1;
+        }
+
+        /* With 5.6.0 & 5.6.1 there is an extra wrapper around the
+           validation subs which we want to ignore */
+        #if (PERL_VERSION == 6)
+        frame++;
+        #endif
+
+        buffer = sv_2mortal(newSVpvf("(caller(%d))[3]", (int) frame));
+        SvTAINTED_off(buffer);
+
+        caller = eval_pv(SvPV_nolen(buffer), 1);
+        if (SvTYPE(caller) == SVt_NULL) {
+            sv_setpv(caller, "N/A");
+        }
+
+        return caller;
+    }
+}
+
+
+/* $value->isa alike validation */
+static IV
+validate_isa(SV* value, SV* package, SV* id, HV* options) {
+    SV* buffer;
+    IV ok = 1;
+
+    SvGETMAGIC(value);
+    if (SvOK(value) && (sv_isobject(value) || (SvPOK(value) && ! looks_like_number(value)))) {
+        dSP;
+
+        SV* ret;
+        IV count;
+
+        ENTER;
+        SAVETMPS;
+
+        PUSHMARK(SP);
+        EXTEND(SP, 2);
+        PUSHs(value);
+        PUSHs(package);
+        PUTBACK;
+
+        count = call_method("isa", G_SCALAR);
+
+        if (! count)
+            croak("Calling isa did not return a value");
+
+        SPAGAIN;
+
+        ret = POPs;
+        SvGETMAGIC(ret);
+
+        ok = SvTRUE(ret);
+
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
+    }
+    else {
+        ok = 0;
+    }
+
+    if (! ok) {
+        buffer = sv_2mortal(newSVsv(id));
+        sv_catpv(buffer, " to ");
+        sv_catsv(buffer, get_called(options));
+        sv_catpv(buffer, " was not ");
+        sv_catpv(buffer, article(package));
+        sv_catpv(buffer, " '");
+        sv_catsv(buffer, package);
+        sv_catpv(buffer, "' (it is ");
+        if ( SvOK(value) ) {
+            sv_catpv(buffer, article(value));
+            sv_catpv(buffer, " ");
+            sv_catsv(buffer, value);
+        }
+        else {
+            sv_catpv(buffer, "undef");
+        }
+        sv_catpv(buffer, ")\n");
+        FAIL(buffer, options);
+    }
+
+    return 1;
+}
+
+
+static IV
+validate_can(SV* value, SV* method, SV* id, HV* options) {
+    IV ok = 1;
+
+    SvGETMAGIC(value);
+    if (SvOK(value) && (sv_isobject(value) || (SvPOK(value) && ! looks_like_number(value)))) {
+        dSP;
+
+        SV* ret;
+        IV count;
+
+        ENTER;
+        SAVETMPS;
+
+        PUSHMARK(SP);
+        EXTEND(SP, 2);
+        PUSHs(value);
+        PUSHs(method);
+        PUTBACK;
+
+        count = call_method("can", G_SCALAR);
+
+        if (! count)
+            croak("Calling can did not return a value");
+
+        SPAGAIN;
+
+        ret = POPs;
+        SvGETMAGIC(ret);
+
+        ok = SvTRUE(ret);
+
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
+    }
+    else {
+        ok = 0;
+    }
+
+    if (! ok) {
+        SV* buffer;
+
+        buffer = sv_2mortal(newSVsv(id));
+        sv_catpv(buffer, " to ");
+        sv_catsv(buffer, get_called(options));
+        sv_catpv(buffer, " does not have the method: '");
+        sv_catsv(buffer, method);
+        sv_catpv(buffer, "'\n");
+        FAIL(buffer, options);
+    }
+
+    return 1;
+}
+
+
+/* validates specific parameter using supplied parameter specification */
+static IV
+validate_one_param(SV* value, SV* params, HV* spec, SV* id, HV* options, IV* untaint) {
+    SV** temp;
+    IV   i;
+
+    /* check type */
+    if ((temp = hv_fetch(spec, "type", 4, 0))) {
+        IV type;
+
+        if ( ! ( SvOK(*temp)
+            && looks_like_number(*temp)
+        && SvIV(*temp) > 0 ) ) {
+            SV* buffer;
+
+            buffer = sv_2mortal(newSVsv(id));
+            sv_catpv( buffer, " has a type specification which is not a number. It is ");
+            if ( SvOK(*temp) ) {
+                sv_catpv( buffer, "a string - " );
+                sv_catsv( buffer, *temp );
+            }
+            else {
+                sv_catpv( buffer, "undef");
+            }
+            sv_catpv( buffer, ".\n Use the constants exported by Params::Validate to declare types." );
+
+            FAIL(buffer, options);
+        }
+
+        SvGETMAGIC(*temp);
+        type = get_type(value);
+        if (! (type & SvIV(*temp))) {
+            SV* buffer;
+            SV* is;
+            SV* allowed;
+
+            buffer = sv_2mortal(newSVsv(id));
+            sv_catpv(buffer, " to ");
+            sv_catsv(buffer, get_called(options));
+            sv_catpv(buffer, " was ");
+            is = typemask_to_string(type);
+            allowed = typemask_to_string(SvIV(*temp));
+            sv_catpv(buffer, article(is));
+            sv_catpv(buffer, " '");
+            sv_catsv(buffer, is);
+            sv_catpv(buffer, "', which is not one of the allowed types: ");
+            sv_catsv(buffer, allowed);
+            sv_catpv(buffer, "\n");
+            FAIL(buffer, options);
+        }
+    }
+
+    /* check isa */
+    if ((temp = hv_fetch(spec, "isa", 3, 0))) {
+        SvGETMAGIC(*temp);
+
+        if (SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVAV) {
+            AV* array = (AV*) SvRV(*temp);
+
+            for(i = 0; i <= av_len(array); i++) {
+                SV* package;
+
+                package = *av_fetch(array, i, 1);
+                SvGETMAGIC(package);
+                if (! validate_isa(value, package, id, options)) {
+                    return 0;
+                }
+            }
+        }
+        else {
+            if (! validate_isa(value, *temp, id, options)) {
+                return 0;
+            }
+        }
+    }
+
+    /* check can */
+    if ((temp = hv_fetch(spec, "can", 3, 0))) {
+        SvGETMAGIC(*temp);
+        if (SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVAV) {
+            AV* array = (AV*) SvRV(*temp);
+
+            for (i = 0; i <= av_len(array); i++) {
+                SV* method;
+
+                method = *av_fetch(array, i, 1);
+                SvGETMAGIC(method);
+
+                if (! validate_can(value, method, id, options)) {
+                    return 0;
+                }
+            }
+        }
+        else {
+            if (! validate_can(value, *temp, id, options)) {
+                return 0;
+            }
+        }
+    }
+
+    /* let callbacks to do their tests */
+    if ((temp = hv_fetch(spec, "callbacks", 9, 0))) {
+        SvGETMAGIC(*temp);
+        if (SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVHV) {
+            HE* he;
+
+            hv_iterinit((HV*) SvRV(*temp));
+            while ((he = hv_iternext((HV*) SvRV(*temp)))) {
+                if (SvROK(HeVAL(he)) && SvTYPE(SvRV(HeVAL(he))) == SVt_PVCV) {
+                    dSP;
+
+                    SV* ret;
+                    IV ok;
+                    IV count;
+
+                    ENTER;
+                    SAVETMPS;
+
+                    PUSHMARK(SP);
+                    EXTEND(SP, 2);
+                    PUSHs(value);
+                    PUSHs(sv_2mortal(newRV_inc(params)));
+                    PUTBACK;
+
+                    count = call_sv(SvRV(HeVAL(he)), G_SCALAR);
+
+                    SPAGAIN;
+
+                    if (! count)
+                        croak("Validation callback did not return anything");
+
+                    ret = POPs;
+                    SvGETMAGIC(ret);
+                    ok = SvTRUE(ret);
+
+                    PUTBACK;
+                    FREETMPS;
+                    LEAVE;
+
+                    if (! ok) {
+                        SV* buffer;
+
+                        buffer = sv_2mortal(newSVsv(id));
+                        sv_catpv(buffer, " to ");
+                        sv_catsv(buffer, get_called(options));
+                        sv_catpv(buffer, " did not pass the '");
+                        sv_catsv(buffer, HeSVKEY_force(he));
+                        sv_catpv(buffer, "' callback\n");
+                        FAIL(buffer, options);
+                    }
+                }
+                else {
+                    SV* buffer;
+
+                    buffer = sv_2mortal(newSVpv("callback '", 0));
+                    sv_catsv(buffer, HeSVKEY_force(he));
+                    sv_catpv(buffer, "' for ");
+                    sv_catsv(buffer, get_called(options));
+                    sv_catpv(buffer, " is not a subroutine reference\n");
+                    FAIL(buffer, options);
+                }
+            }
+        }
+        else {
+            SV* buffer;
+
+            buffer = sv_2mortal(newSVpv("'callbacks' validation parameter for '", 0));
+            sv_catsv(buffer, get_called(options));
+            sv_catpv(buffer, " must be a hash reference\n");
+            FAIL(buffer, options);
+        }
+    }
+
+    if ((temp = hv_fetch(spec, "regex", 5, 0))) {
+        dSP;
+
+        IV has_regex = 0;
+        IV ok;
+
+        SvGETMAGIC(*temp);
+        if (SvPOK(*temp)) {
+            has_regex = 1;
+        }
+        else if (SvROK(*temp)) {
+            SV* svp;
+
+            svp = (SV*)SvRV(*temp);
+
+            #if PERL_VERSION <= 10
+            if (SvMAGICAL(svp) && mg_find(svp, PERL_MAGIC_qr)) {
+                has_regex = 1;
+            }
+            #else
+            if (SvTYPE(svp) == SVt_REGEXP) {
+                has_regex = 1;
+            }
+            #endif
+        }
+
+        if (!has_regex) {
+            SV* buffer;
+
+            buffer = sv_2mortal(newSVpv("'regex' validation parameter for '", 0));
+            sv_catsv(buffer, get_called(options));
+            sv_catpv(buffer, " must be a string or qr// regex\n");
+            FAIL(buffer, options);
+        }
+
+        PUSHMARK(SP);
+        EXTEND(SP, 2);
+        PUSHs(value);
+        PUSHs(*temp);
+        PUTBACK;
+        call_pv("Params::Validate::_check_regex_from_xs", G_SCALAR);
+        SPAGAIN;
+        ok = POPi;
+        PUTBACK;
+
+        if (!ok) {
+            SV* buffer;
+
+            buffer = sv_2mortal(newSVsv(id));
+            sv_catpv(buffer, " to ");
+            sv_catsv(buffer, get_called(options));
+            sv_catpv(buffer, " did not pass regex check\n");
+            FAIL(buffer, options);
+        }
+    }
+
+    if ((temp = hv_fetch(spec, "untaint", 7, 0))) {
+        if (SvTRUE(*temp)) {
+            *untaint = 1;
+        }
+    }
+
+    return 1;
+}
+
+
+/* merges one hash into another (not deep copy) */
+static void
+merge_hashes(HV* in, HV* out) {
+    HE* he;
+
+    hv_iterinit(in);
+    while ((he = hv_iternext(in))) {
+        if (!hv_store_ent(out, HeSVKEY_force(he),
+        SvREFCNT_inc(HeVAL(he)), HeHASH(he))) {
+            SvREFCNT_dec(HeVAL(he));
+            croak("Cannot add new key to hash");
+        }
+    }
+}
+
+
+/* convert array to hash */
+static IV
+convert_array2hash(AV* in, HV* options, HV* out) {
+    IV i;
+    I32 len;
+
+    len = av_len(in);
+    if (len > -1 && len % 2 != 1) {
+        SV* buffer;
+        buffer = sv_2mortal(newSVpv("Odd number of parameters in call to ", 0));
+        sv_catsv(buffer, get_called(options));
+        sv_catpv(buffer, " when named parameters were expected\n");
+
+        FAIL(buffer, options);
+    }
+
+    for(i = 0; i <= av_len(in); i += 2) {
+        SV* key;
+        SV* value;
+
+        key = *av_fetch(in, i, 1);
+        SvGETMAGIC(key);
+
+        /* We need to make a copy because if the array was @_, then the
+           values in the array are marked as readonly, which causes
+           problems when the hash being made gets returned to the
+           caller. */
+        value = sv_2mortal( newSVsv( *av_fetch(in, i + 1, 1) ) );
+        SvGETMAGIC(value);
+
+        if (! hv_store_ent(out, key, SvREFCNT_inc(value), 0)) {
+            SvREFCNT_dec(value);
+            croak("Cannot add new key to hash");
+        }
+    }
+
+    return 1;
+}
+
+
+/* get current Params::Validate options */
+static HV*
+get_options(HV* options) {
+    HV* OPTIONS;
+    HV* ret;
+    SV** temp;
+    char* pkg;
+    #if (PERL_VERSION != 6)
+    SV* buffer;
+    SV* caller;
+    #endif
+
+    ret = (HV*) sv_2mortal((SV*) newHV());
+
+    #if (PERL_VERSION == 6)
+    pkg = SvPV_nolen(get_sv("Params::Validate::CALLER", 0));
+    #else
+    buffer = sv_2mortal(newSVpv("caller(0)", 0));
+    SvTAINTED_off(buffer);
+
+    caller = eval_pv(SvPV_nolen(buffer), 1);
+    if (SvTYPE(caller) == SVt_NULL) {
+        pkg = "main";
+    }
+    else {
+        pkg = SvPV_nolen(caller);
+    }
+    #endif
+    /* get package specific options */
+    OPTIONS = get_hv("Params::Validate::OPTIONS", 1);
+    if ((temp = hv_fetch(OPTIONS, pkg, strlen(pkg), 0))) {
+        SvGETMAGIC(*temp);
+        if (SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVHV) {
+            if (options) {
+                merge_hashes((HV*) SvRV(*temp), ret);
+            }
+            else {
+                return (HV*) SvRV(*temp);
+            }
+        }
+    }
+    if (options) {
+        merge_hashes(options, ret);
+    }
+
+    return ret;
+}
+
+
+static SV*
+normalize_one_key(SV* key, SV* normalize_func, SV* strip_leading, IV ignore_case) {
+    SV* copy;
+    STRLEN len_sl;
+    STRLEN len;
+    char *rawstr_sl;
+    char *rawstr;
+
+    copy = sv_2mortal(newSVsv(key));
+
+    /* if normalize_func is provided, ignore the other options */
+    if (normalize_func) {
+        dSP;
+
+        SV* normalized;
+
+        PUSHMARK(SP);
+        XPUSHs(copy);
+        PUTBACK;
+        if (! call_sv(SvRV(normalize_func), G_SCALAR)) {
+            croak("The normalize_keys callback did not return anything");
+        }
+        SPAGAIN;
+        normalized = POPs;
+        PUTBACK;
+
+        if (! SvOK(normalized)) {
+            croak("The normalize_keys callback did not return a defined value when normalizing the key '%s'", SvPV_nolen(copy));
+        }
+
+        return normalized;
+    }
+    else if (ignore_case || strip_leading) {
+        if (ignore_case) {
+            STRLEN i;
+
+            rawstr = SvPV(copy, len);
+            for (i = 0; i < len; i++) {
+                /* should this account for UTF8 strings? */
+                *(rawstr + i) = toLOWER(*(rawstr + i));
+            }
+        }
+
+        if (strip_leading) {
+            rawstr_sl = SvPV(strip_leading, len_sl);
+            rawstr = SvPV(copy, len);
+
+            if (len > len_sl && strnEQ(rawstr_sl, rawstr, len_sl)) {
+                copy = sv_2mortal(newSVpvn(rawstr + len_sl, len - len_sl));
+            }
+        }
+    }
+
+    return copy;
+}
+
+
+static HV*
+normalize_hash_keys(HV* p, SV* normalize_func, SV* strip_leading, IV ignore_case) {
+    SV* normalized;
+    HE* he;
+    HV* norm_p;
+
+    if (!normalize_func && !ignore_case && !strip_leading) {
+        return p;
+    }
+
+    norm_p = (HV*) sv_2mortal((SV*) newHV());
+    hv_iterinit(p);
+    while ((he = hv_iternext(p))) {
+        normalized =
+            normalize_one_key(HeSVKEY_force(he), normalize_func, strip_leading, ignore_case);
+
+        if (hv_fetch_ent(norm_p, normalized, 0, 0)) {
+            croak("The normalize_keys callback returned a key that already exists, '%s', when normalizing the key '%s'",
+                SvPV_nolen(normalized), SvPV_nolen(HeSVKEY_force(he)));
+        }
+
+        if (! hv_store_ent(norm_p, normalized, SvREFCNT_inc(HeVAL(he)), 0)) {
+            SvREFCNT_dec(HeVAL(he));
+            croak("Cannot add new key to hash");
+        }
+    }
+    return norm_p;
+}
+
+
+static IV
+validate_pos_depends(AV* p, AV* specs, HV* options) {
+    IV p_idx;
+    SV** depends;
+    SV** p_spec;
+    SV* buffer;
+
+    for (p_idx = 0; p_idx <= av_len(p); p_idx++) {
+        p_spec = av_fetch(specs, p_idx, 0);
+
+        if (p_spec != NULL && SvROK(*p_spec) &&
+        SvTYPE(SvRV(*p_spec)) == SVt_PVHV) {
+
+            depends = hv_fetch((HV*) SvRV(*p_spec), "depends", 7, 0);
+
+            if (! depends) {
+                return 1;
+            }
+
+            if (SvROK(*depends)) {
+                croak("Arguments to 'depends' for validate_pos() must be a scalar");
+            }
+
+            if (av_len(p) < SvIV(*depends) -1) {
+
+                buffer =
+                    sv_2mortal(newSVpvf("Parameter #%d depends on parameter #%d, which was not given",
+                    (int) p_idx + 1,
+                    (int) SvIV(*depends)));
+
+                FAIL(buffer, options);
+            }
+        }
+    }
+    return 1;
+}
+
+
+static IV
+validate_named_depends(HV* p, HV* specs, HV* options) {
+    HE* he;
+    HE* he1;
+    SV* buffer;
+    SV** depends_value;
+    AV* depends_list;
+    SV* depend_name;
+    SV* temp;
+    I32 d_idx;
+
+    /* the basic idea here is to iterate through the parameters
+     * (which we assumed to have already gone through validation
+     * via validate_one_param()), and the check to see if that
+     * parameter contains a "depends" spec. If it does, we'll
+     * check if that parameter specified by depends exists in p
+     */
+    hv_iterinit(p);
+    while ((he = hv_iternext(p))) {
+        he1 = hv_fetch_ent(specs, HeSVKEY_force(he), 0, HeHASH(he));
+
+        if (he1 && SvROK(HeVAL(he1)) &&
+        SvTYPE(SvRV(HeVAL(he1))) == SVt_PVHV) {
+
+            if (hv_exists((HV*) SvRV(HeVAL(he1)), "depends", 7)) {
+
+                depends_value = hv_fetch((HV*) SvRV(HeVAL(he1)), "depends", 7, 0);
+
+                if (! depends_value) {
+                    return 1;
+                }
+
+                if (! SvROK(*depends_value)) {
+                    depends_list = (AV*) sv_2mortal((SV*) newAV());
+                    temp = sv_2mortal(newSVsv(*depends_value));
+                    av_push(depends_list,SvREFCNT_inc(temp));
+                }
+                else if (SvTYPE(SvRV(*depends_value)) == SVt_PVAV) {
+                    depends_list = (AV*) SvRV(*depends_value);
+                }
+                else {
+                    croak("Arguments to 'depends' must be a scalar or arrayref");
+                }
+
+                for (d_idx =0; d_idx <= av_len(depends_list); d_idx++) {
+
+                    depend_name = *av_fetch(depends_list, d_idx, 0);
+
+                    /* first check if the parameter to which this
+                     * depends on was given to us
+                     */
+                    if (!hv_exists(p, SvPV_nolen(depend_name),
+                    SvCUR(depend_name))) {
+                        /* oh-oh, the parameter that this parameter
+                         * depends on is not available. Let's first check
+                         * if this is even valid in the spec (i.e., the
+                         * spec actually contains a spec for such parameter)
+                         */
+                        if (!hv_exists(specs, SvPV_nolen(depend_name),
+                        SvCUR(depend_name))) {
+
+                            buffer =
+                                sv_2mortal(newSVpv("Following parameter specified in depends for '", 0));
+
+                            sv_catsv(buffer, HeSVKEY_force(he1));
+                            sv_catpv(buffer, "' does not exist in spec: ");
+                            sv_catsv(buffer, depend_name);
+
+                            croak(SvPV_nolen(buffer));
+                        }
+                        /* if we got here, the spec was correct. we just
+                         * need to issue a regular validation failure
+                         */
+                        buffer = sv_2mortal(newSVpv( "Parameter '", 0));
+                        sv_catsv(buffer, HeSVKEY_force(he1));
+                        sv_catpv(buffer, "' depends on parameter '");
+                        sv_catsv(buffer, depend_name);
+                        sv_catpv(buffer, "', which was not given");
+                        FAIL(buffer, options);
+                    }
+                }
+            }
+        }
+    }
+    return 1;
+}
+
+
+void
+cat_string_representation(SV* buffer, SV* value) {
+    if(SvOK(value)) {
+        sv_catpv(buffer, "\"");
+        sv_catpv(buffer, SvPV_nolen(value));
+        sv_catpv(buffer, "\"");
+    }
+    else {
+        sv_catpv(buffer, "undef");
+    }
+}
+
+
+void
+apply_defaults(HV *ret, HV *p, HV *specs, AV *missing) {
+    HE* he;
+    SV** temp;
+
+    hv_iterinit(specs);
+    while ((he = hv_iternext(specs))) {
+        HV* spec;
+        SV* val;
+
+        val = HeVAL(he);
+
+        /* get extended param spec if available */
+        if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
+            spec = (HV*) SvRV(val);
+        }
+        else {
+            spec = NULL;
+        }
+
+        /* test for parameter existence  */
+        if (hv_exists_ent(p, HeSVKEY_force(he), HeHASH(he))) {
+            continue;
+        }
+
+        /* parameter may not be defined but we may have default */
+        if (spec && (temp = hv_fetch(spec, "default", 7, 0))) {
+            SV* value;
+
+            SvGETMAGIC(*temp);
+            value = sv_2mortal(newSVsv(*temp));
+
+            /* make sure that parameter is put into return hash */
+            if (GIMME_V != G_VOID) {
+                if (!hv_store_ent(ret, HeSVKEY_force(he),
+                SvREFCNT_inc(value), HeHASH(he))) {
+                    SvREFCNT_dec(value);
+                    croak("Cannot add new key to hash");
+                }
+            }
+
+            continue;
+        }
+
+        /* find if missing parameter is mandatory */
+        if (! no_validation()) {
+            SV** temp;
+
+            if (spec) {
+                if ((temp = hv_fetch(spec, "optional", 8, 0))) {
+                    SvGETMAGIC(*temp);
+
+                    if (SvTRUE(*temp)) continue;
+                }
+            }
+            else if (!SvTRUE(HeVAL(he))) {
+                continue;
+            }
+            av_push(missing, SvREFCNT_inc(HeSVKEY_force(he)));
+        }
+    }
+}
+
+
+static IV
+validate(HV* p, HV* specs, HV* options, HV* ret) {
+    AV* missing;
+    AV* unmentioned;
+    HE* he;
+    HE* he1;
+    SV* hv;
+    SV* hv1;
+    IV ignore_case = 0;
+    SV* strip_leading = NULL;
+    IV allow_extra = 0;
+    SV** temp;
+    SV* normalize_func = NULL;
+    AV* untaint_keys = (AV*) sv_2mortal((SV*) newAV());
+    IV i;
+
+    if ((temp = hv_fetch(options, "ignore_case", 11, 0))) {
+        SvGETMAGIC(*temp);
+        ignore_case = SvTRUE(*temp);
+    }
+
+    if ((temp = hv_fetch(options, "strip_leading", 13, 0))) {
+        SvGETMAGIC(*temp);
+        if (SvOK(*temp)) strip_leading = *temp;
+    }
+
+    if ((temp = hv_fetch(options, "normalize_keys", 14, 0))) {
+        SvGETMAGIC(*temp);
+        if(SvROK(*temp) && SvTYPE(SvRV(*temp)) == SVt_PVCV) {
+            normalize_func = *temp;
+        }
+    }
+
+    if (normalize_func || ignore_case || strip_leading) {
+        p = normalize_hash_keys(p, normalize_func, strip_leading, ignore_case);
+        specs = normalize_hash_keys(specs, normalize_func, strip_leading, ignore_case);
+    }
+
+    /* short-circuit everything else when no_validation is true */
+    if (no_validation()) {
+        if (GIMME_V != G_VOID) {
+            while ((he = hv_iternext(p))) {
+                hv = HeVAL(he);
+                SvGETMAGIC(hv);
+
+                /* put the parameter into return hash */
+                if (!hv_store_ent(ret, HeSVKEY_force(he), SvREFCNT_inc(hv),
+                HeHASH(he))) {
+                    SvREFCNT_dec(hv);
+                    croak("Cannot add new key to hash");
+                }
+            }
+            apply_defaults(ret, p, specs, NULL);
+        }
+
+        return 1;
+    }
+
+    if ((temp = hv_fetch(options, "allow_extra", 11, 0))) {
+        SvGETMAGIC(*temp);
+        allow_extra = SvTRUE(*temp);
+    }
+
+    /* find extra parameters and validate good parameters */
+    unmentioned = (AV*) sv_2mortal((SV*) newAV());
+
+    hv_iterinit(p);
+    while ((he = hv_iternext(p))) {
+        hv = HeVAL(he);
+        SvGETMAGIC(hv);
+
+        /* put the parameter into return hash */
+        if (GIMME_V != G_VOID) {
+            if (!hv_store_ent(ret, HeSVKEY_force(he), SvREFCNT_inc(hv),
+            HeHASH(he))) {
+                SvREFCNT_dec(hv);
+                croak("Cannot add new key to hash");
+            }
+        }
+
+        /* check if this parameter is defined in spec and if it is
+           then validate it using spec */
+        he1 = hv_fetch_ent(specs, HeSVKEY_force(he), 0, HeHASH(he));
+        if(he1) {
+            hv1 = HeVAL(he1);
+            if (SvROK(hv1) && SvTYPE(SvRV(hv1)) == SVt_PVHV) {
+                SV* buffer;
+                HV* spec;
+                IV untaint = 0;
+
+                spec = (HV*) SvRV(hv1);
+                buffer = sv_2mortal(newSVpv("The '", 0));
+                sv_catsv(buffer, HeSVKEY_force(he));
+                sv_catpv(buffer, "' parameter (");
+                cat_string_representation(buffer, hv);
+                sv_catpv(buffer, ")");
+
+                if (! validate_one_param(hv, (SV*) p, spec, buffer, options, &untaint))
+                    return 0;
+
+                /* The value stored here is meaningless, we're just tracking
+                   keys to untaint later */
+                if (untaint) {
+                    av_push(untaint_keys, SvREFCNT_inc(HeSVKEY_force(he1)));
+                }
+            }
+        }
+        else if (! allow_extra) {
+            av_push(unmentioned, SvREFCNT_inc(HeSVKEY_force(he)));
+        }
+
+        if (av_len(unmentioned) > -1) {
+            SV* buffer;
+
+            buffer = sv_2mortal(newSVpv("The following parameter", 0));
+            if (av_len(unmentioned) != 0) {
+                sv_catpv(buffer, "s were ");
+            }
+            else {
+                sv_catpv(buffer, " was ");
+            }
+            sv_catpv(buffer, "passed in the call to ");
+            sv_catsv(buffer, get_called(options));
+            sv_catpv(buffer, " but ");
+            if (av_len(unmentioned) != 0) {
+                sv_catpv(buffer, "were ");
+            }
+            else {
+                sv_catpv(buffer, "was ");
+            }
+            sv_catpv(buffer, "not listed in the validation options: ");
+            for(i = 0; i <= av_len(unmentioned); i++) {
+                sv_catsv(buffer, *av_fetch(unmentioned, i, 1));
+                if (i < av_len(unmentioned)) {
+                    sv_catpv(buffer, " ");
+                }
+            }
+            sv_catpv(buffer, "\n");
+
+            FAIL(buffer, options);
+        }
+    }
+
+    validate_named_depends(p, specs, options);
+
+    /* find missing parameters */
+    missing = (AV*) sv_2mortal((SV*) newAV());
+
+    apply_defaults(ret, p, specs, missing);
+
+    if (av_len(missing) > -1) {
+        SV* buffer;
+
+        buffer = sv_2mortal(newSVpv("Mandatory parameter", 0));
+        if (av_len(missing) > 0) {
+            sv_catpv(buffer, "s ");
+        }
+        else {
+            sv_catpv(buffer, " ");
+        }
+
+        for(i = 0; i <= av_len(missing); i++) {
+            sv_catpvf(buffer, "'%s'",
+                SvPV_nolen(*av_fetch(missing, i, 0)));
+            if (i < av_len(missing)) {
+                sv_catpv(buffer, ", ");
+            }
+        }
+        sv_catpv(buffer, " missing in call to ");
+        sv_catsv(buffer, get_called(options));
+        sv_catpv(buffer, "\n");
+
+        FAIL(buffer, options);
+    }
+
+    if (GIMME_V != G_VOID) {
+        for (i = 0; i <= av_len(untaint_keys); i++) {
+            SvTAINTED_off(HeVAL(hv_fetch_ent(p, *av_fetch(untaint_keys, i, 0), 0, 0)));
+        }
+    }
+
+    return 1;
+}
+
+
+static SV*
+validate_pos_failure(IV pnum, IV min, IV max, HV* options) {
+    SV* buffer;
+    SV** temp;
+    IV allow_extra;
+
+    if ((temp = hv_fetch(options, "allow_extra", 11, 0))) {
+        SvGETMAGIC(*temp);
+        allow_extra = SvTRUE(*temp);
+    }
+    else {
+        allow_extra = 0;
+    }
+
+    buffer = sv_2mortal(newSViv(pnum + 1));
+    if (pnum != 0) {
+        sv_catpv(buffer, " parameters were passed to ");
+    }
+    else {
+        sv_catpv(buffer, " parameter was passed to ");
+    }
+    sv_catsv(buffer, get_called(options));
+    sv_catpv(buffer, " but ");
+    if (!allow_extra) {
+        if (min != max) {
+            sv_catpvf(buffer, "%d - %d", (int) min + 1, (int) max + 1);
+        }
+        else {
+            sv_catpvf(buffer, "%d", (int) max + 1);
+        }
+    }
+    else {
+        sv_catpvf(buffer, "at least %d", (int) min + 1);
+    }
+    if ((allow_extra ? min : max) != 0) {
+        sv_catpv(buffer, " were expected\n");
+    }
+    else {
+        sv_catpv(buffer, " was expected\n");
+    }
+
+    return buffer;
+}
+
+
+/* Given a single parameter spec and a corresponding complex spec form
+   of it (which must be false if the spec is not complex), return true
+   says that the parameter is options.  */
+static bool
+spec_says_optional(SV* spec, IV complex_spec) {
+    SV** temp;
+
+    if (complex_spec) {
+        if ((temp = hv_fetch((HV*) SvRV(spec), "optional", 8, 0))) {
+            SvGETMAGIC(*temp);
+            if (!SvTRUE(*temp))
+                return FALSE;
+        }
+        else {
+            return FALSE;
+        }
+    }
+    else {
+        if (SvTRUE(spec)) {
+            return FALSE;
+        }
+    }
+    return TRUE;
+}
+
+
+static IV
+validate_pos(AV* p, AV* specs, HV* options, AV* ret) {
+    SV* buffer;
+    SV* value;
+    SV* spec = NULL;
+    SV** temp;
+    IV i;
+    IV complex_spec = 0;
+    IV allow_extra;
+    /* Index of highest-indexed required parameter known so far, or -1
+       if no required parameters are known yet.  */
+    IV min = -1;
+    AV* untaint_indexes = (AV*) sv_2mortal((SV*) newAV());
+
+    if (no_validation()) {
+        IV spec_count = av_len(specs);
+        IV p_count    = av_len(p);
+        IV max        = spec_count > p_count ? spec_count : p_count;
+
+        if (GIMME_V == G_VOID) {
+            return 1;
+        }
+
+        for (i = 0; i <= max; i++) {
+            if (i <= spec_count) {
+                spec = *av_fetch(specs, i, 1);
+                SvGETMAGIC(spec);
+                complex_spec = (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV);
+            }
+
+            if (i <= av_len(p)) {
+                value = *av_fetch(p, i, 1);
+                SvGETMAGIC(value);
+                av_push(ret, SvREFCNT_inc(value));
+            } else if (complex_spec &&
+            (temp = hv_fetch((HV*) SvRV(spec), "default", 7, 0))) {
+                SvGETMAGIC(*temp);
+                av_push(ret, SvREFCNT_inc(*temp));
+            }
+        }
+        return 1;
+    }
+
+    /* iterate through all parameters and validate them */
+    for (i = 0; i <= av_len(specs); i++) {
+        spec = *av_fetch(specs, i, 1);
+        SvGETMAGIC(spec);
+        complex_spec = (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV);
+
+        /* Unless the current spec refers to an optional argument, update
+           our notion of the index of the highest-idexed required
+           parameter.  */
+        if (! spec_says_optional(spec, complex_spec) ) {
+            min = i;
+        }
+
+        if (i <= av_len(p)) {
+            value = *av_fetch(p, i, 1);
+            SvGETMAGIC(value);
+
+            if (complex_spec) {
+                IV untaint = 0;
+
+                buffer = sv_2mortal(newSVpvf("Parameter #%d (", (int) i + 1));
+                cat_string_representation(buffer, value);
+                sv_catpv(buffer, ")");
+
+                if (! validate_one_param(value, (SV*) p, (HV*) SvRV(spec),
+                buffer, options, &untaint)) {
+                    return 0;
+                }
+
+                if (untaint) {
+                    av_push(untaint_indexes, newSViv(i));
+                }
+            }
+
+            if (GIMME_V != G_VOID) {
+                av_push(ret, SvREFCNT_inc(value));
+            }
+
+        } else if (complex_spec &&
+        (temp = hv_fetch((HV*) SvRV(spec), "default", 7, 0))) {
+            SvGETMAGIC(*temp);
+
+            if (GIMME_V != G_VOID) {
+                av_push(ret, SvREFCNT_inc(*temp));
+            }
+
+        }
+        else {
+            if (i == min) {
+                /* We don't have as many arguments as the arg spec requires.  */
+                SV* buffer;
+
+                /* Look forward through remaining argument specifications to
+                   find the last non-optional one, so we can correctly report the
+                   number of arguments required.  */
+                for (i++ ; i <= av_len(specs); i++) {
+                    spec = *av_fetch(specs, i, 1);
+                    SvGETMAGIC(spec);
+                    complex_spec = (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV);
+                    if (! spec_says_optional(spec, complex_spec)) {
+                        min = i;
+                    }
+                    if (min != i)
+                        break;
+                }
+
+                buffer = validate_pos_failure(av_len(p), min, av_len(specs), options);
+
+                FAIL(buffer, options);
+            }
+        }
+    }
+
+    validate_pos_depends(p, specs, options);
+
+    /* test for extra parameters */
+    if (av_len(p) > av_len(specs)) {
+        if ((temp = hv_fetch(options, "allow_extra", 11, 0))) {
+            SvGETMAGIC(*temp);
+            allow_extra = SvTRUE(*temp);
+        }
+        else {
+            allow_extra = 0;
+        }
+        if (allow_extra) {
+            /* put all additional parameters into return array */
+            if (GIMME_V != G_VOID) {
+                for(i = av_len(specs) + 1; i <= av_len(p); i++) {
+                    value = *av_fetch(p, i, 1);
+                    SvGETMAGIC(value);
+
+                    av_push(ret, SvREFCNT_inc(value));
+                }
+            }
+        }
+        else {
+            SV* buffer;
+
+            buffer = validate_pos_failure(av_len(p), min, av_len(specs), options);
+
+            FAIL(buffer, options);
+        }
+    }
+
+    if (GIMME_V != G_VOID) {
+        for (i = 0; i <= av_len(untaint_indexes); i++) {
+            SvTAINTED_off(*av_fetch(p, SvIV(*av_fetch(untaint_indexes, i, 0)), 0));
+        }
+    }
+
+    return 1;
+}
+
+
+MODULE = Params::Validate               PACKAGE = Params::Validate
+
+BOOT:
+    bootinit();
+
+void
+_validate(p, specs)
+    SV* p
+    SV* specs
+
+    PROTOTYPE: \@$
+
+    PPCODE:
+
+    HV* ret = NULL;
+    AV* pa;
+    HV* ph;
+    HV* options;
+
+    if (no_validation() && GIMME_V == G_VOID) {
+        XSRETURN(0);
+    }
+
+    SvGETMAGIC(p);
+    if (! (SvROK(p) && SvTYPE(SvRV(p)) == SVt_PVAV)) {
+        croak("Expecting array reference as first parameter");
+    }
+
+    SvGETMAGIC(specs);
+    if (! (SvROK(specs) && SvTYPE(SvRV(specs)) == SVt_PVHV)) {
+        croak("Expecting hash reference as second parameter");
+    }
+
+    pa = (AV*) SvRV(p);
+    ph = NULL;
+    if (av_len(pa) == 0) {
+        /* we were called as validate( @_, ... ) where @_ has a
+           single element, a hash reference */
+        SV* value;
+
+        value = *av_fetch(pa, 0, 1);
+        SvGETMAGIC(value);
+        if (SvROK(value) && SvTYPE(SvRV(value)) == SVt_PVHV) {
+            ph = (HV*) SvRV(value);
+        }
+    }
+
+    options = get_options(NULL);
+
+    if (! ph) {
+        ph = (HV*) sv_2mortal((SV*) newHV());
+
+        if (! convert_array2hash(pa, options, ph) ) {
+            XSRETURN(0);
+        }
+    }
+    if (GIMME_V != G_VOID) {
+        ret = (HV*) sv_2mortal((SV*) newHV());
+    }
+    if (! validate(ph, (HV*) SvRV(specs), options, ret)) {
+        XSRETURN(0);
+    }
+    RETURN_HASH(ret);
+
+void
+_validate_pos(p, ...)
+SV* p
+
+    PROTOTYPE: \@@
+
+    PPCODE:
+
+    AV* specs;
+    AV* ret = NULL;
+    IV i;
+
+    if (no_validation() && GIMME_V == G_VOID) {
+        XSRETURN(0);
+    }
+
+
+    SvGETMAGIC(p);
+    if (!SvROK(p) || !(SvTYPE(SvRV(p)) == SVt_PVAV)) {
+        croak("Expecting array reference as first parameter");
+    }
+
+
+    specs = (AV*) sv_2mortal((SV*) newAV());
+    av_extend(specs, items);
+    for(i = 1; i < items; i++) {
+        if (!av_store(specs, i - 1, SvREFCNT_inc(ST(i)))) {
+            SvREFCNT_dec(ST(i));
+            croak("Cannot store value in array");
+        }
+    }
+
+
+    if (GIMME_V != G_VOID) {
+        ret = (AV*) sv_2mortal((SV*) newAV());
+    }
+
+
+    if (! validate_pos((AV*) SvRV(p), specs, get_options(NULL), ret)) {
+        XSRETURN(0);
+    }
+
+
+    RETURN_ARRAY(ret);
+
+void
+_validate_with(...)
+
+    PPCODE:
+
+    HV* p;
+    SV* params;
+    SV* spec;
+    IV i;
+
+    if (no_validation() && GIMME_V == G_VOID) XSRETURN(0);
+
+    /* put input list into hash */
+    p = (HV*) sv_2mortal((SV*) newHV());
+    for(i = 0; i < items; i += 2) {
+        SV* key;
+        SV* value;
+
+        key = ST(i);
+        if (i + 1 < items) {
+            value = ST(i + 1);
+        }
+        else {
+            value = &PL_sv_undef;
+        }
+        if (! hv_store_ent(p, key, SvREFCNT_inc(value), 0)) {
+            SvREFCNT_dec(value);
+            croak("Cannot add new key to hash");
+        }
+    }
+
+    params = *hv_fetch(p, "params", 6, 1);
+    SvGETMAGIC(params);
+    spec = *hv_fetch(p, "spec", 4, 1);
+    SvGETMAGIC(spec);
+
+    if (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVAV) {
+        if (SvROK(params) && SvTYPE(SvRV(params)) == SVt_PVAV) {
+            AV* ret = NULL;
+
+            if (GIMME_V != G_VOID) {
+                ret = (AV*) sv_2mortal((SV*) newAV());
+            }
+
+            if (! validate_pos((AV*) SvRV(params), (AV*) SvRV(spec),
+            get_options(p), ret)) {
+                XSRETURN(0);
+            }
+
+            RETURN_ARRAY(ret);
+        }
+        else {
+            croak("Expecting array reference in 'params'");
+        }
+    }
+    else if (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV) {
+        HV* hv;
+        HV* ret = NULL;
+        HV* options;
+
+        options = get_options(p);
+
+        if (SvROK(params) && SvTYPE(SvRV(params)) == SVt_PVHV) {
+            hv = (HV*) SvRV(params);
+        }
+        else if (SvROK(params) && SvTYPE(SvRV(params)) == SVt_PVAV) {
+            I32 hv_set = 0;
+
+            /* Check to see if we have a one element array
+               containing a hash reference */
+            if (av_len((AV*) SvRV(params)) == 0) {
+                SV** first_elem;
+
+                first_elem = av_fetch((AV*) SvRV(params), 0, 0);
+
+                if (first_elem && SvROK(*first_elem) &&
+                SvTYPE(SvRV(*first_elem)) == SVt_PVHV) {
+
+                    hv = (HV*) SvRV(*first_elem);
+                    hv_set = 1;
+                }
+            }
+
+            if (! hv_set) {
+                hv = (HV*) sv_2mortal((SV*) newHV());
+
+                if (! convert_array2hash((AV*) SvRV(params), options, hv))
+                    XSRETURN(0);
+            }
+        }
+        else {
+            croak("Expecting array or hash reference in 'params'");
+        }
+
+        if (GIMME_V != G_VOID) {
+            ret = (HV*) sv_2mortal((SV*) newHV());
+        }
+
+        if (! validate(hv, (HV*) SvRV(spec), options, ret)) {
+            XSRETURN(0);
+        }
+
+        RETURN_HASH(ret);
+    }
+    else {
+        croak("Expecting array or hash reference in 'spec'");
+    }
Index: /rdnap/lib/Params/ValidatePP.pm
===================================================================
--- /rdnap/lib/Params/ValidatePP.pm	(revision 203)
+++ /rdnap/lib/Params/ValidatePP.pm	(revision 203)
@@ -0,0 +1,714 @@
+package Params::Validate;
+
+use strict;
+use warnings;
+
+use Scalar::Util ();
+
+# suppress subroutine redefined warnings if we tried to load the XS
+# version and failed.
+no warnings 'redefine';
+
+BEGIN {
+    sub SCALAR ()    {1}
+    sub ARRAYREF ()  {2}
+    sub HASHREF ()   {4}
+    sub CODEREF ()   {8}
+    sub GLOB ()      {16}
+    sub GLOBREF ()   {32}
+    sub SCALARREF () {64}
+    sub UNKNOWN ()   {128}
+    sub UNDEF ()     {256}
+    sub OBJECT ()    {512}
+
+    sub HANDLE ()  { 16 | 32 }
+    sub BOOLEAN () { 1 | 256 }
+}
+
+# Various internals notes (for me and any future readers of this
+# monstrosity):
+#
+# - A lot of the weirdness is _intentional_, because it optimizes for
+#   the _success_ case.  It does not really matter how slow the code is
+#   after it enters a path that leads to reporting failure.  But the
+#   "success" path should be as fast as possible.
+#
+# -- We only calculate $called as needed for this reason, even though it
+#    means copying code all over.
+#
+# - All the validation routines need to be careful never to alter the
+#   references that are passed.
+#
+# -- The code assumes that _most_ callers will not be using the
+#    skip_leading or ignore_case features.  In order to not alter the
+#    references passed in, we copy them wholesale when normalizing them
+#    to make these features work.  This is slower but lets us be faster
+#    when not using them.
+
+# Matt Sergeant came up with this prototype, which slickly takes the
+# first array (which should be the caller's @_), and makes it a
+# reference.  Everything after is the parameters for validation.
+sub validate_pos (\@@) {
+    return if $NO_VALIDATION && !defined wantarray;
+
+    my $p = shift;
+
+    my @specs = @_;
+
+    my @p = @$p;
+    if ($NO_VALIDATION) {
+
+        # if the spec is bigger that's where we can start adding
+        # defaults
+        for ( my $x = $#p + 1; $x <= $#specs; $x++ ) {
+            $p[$x] = $specs[$x]->{default}
+                if ref $specs[$x] && exists $specs[$x]->{default};
+        }
+
+        return wantarray ? @p : \@p;
+    }
+
+    # I'm too lazy to pass these around all over the place.
+    local $options ||= _get_options( ( caller(0) )[0] )
+        unless defined $options;
+
+    my $min = 0;
+
+    while (1) {
+        last
+            unless (
+            ref $specs[$min]
+            ? !( exists $specs[$min]->{default} || $specs[$min]->{optional} )
+            : $specs[$min]
+            );
+
+        $min++;
+    }
+
+    my $max = scalar @specs;
+
+    my $actual = scalar @p;
+    unless ( $actual >= $min
+        && ( $options->{allow_extra} || $actual <= $max ) ) {
+        my $minmax = (
+            $options->{allow_extra}
+            ? "at least $min"
+            : ( $min != $max ? "$min - $max" : $max )
+        );
+
+        my $val = $options->{allow_extra} ? $min : $max;
+        $minmax .= $val != 1 ? ' were' : ' was';
+
+        my $called = _get_called();
+
+        $options->{on_fail}->( "$actual parameter"
+                . ( $actual != 1 ? 's'    : '' ) . " "
+                . ( $actual != 1 ? 'were' : 'was' )
+                . " passed to $called but $minmax expected\n" );
+    }
+
+    my $bigger = $#p > $#specs ? $#p : $#specs;
+    foreach ( 0 .. $bigger ) {
+        my $spec = $specs[$_];
+
+        next unless ref $spec;
+
+        if ( $_ <= $#p ) {
+            my $value = defined $p[$_] ? qq|"$p[$_]"| : 'undef';
+            _validate_one_param( $p[$_], \@p, $spec,
+                "Parameter #" . ( $_ + 1 ) . " ($value)" );
+        }
+
+        $p[$_] = $spec->{default} if $_ > $#p && exists $spec->{default};
+    }
+
+    _validate_pos_depends( \@p, \@specs );
+
+    foreach (
+        grep {
+                   defined $p[$_]
+                && !ref $p[$_]
+                && ref $specs[$_]
+                && $specs[$_]{untaint}
+        } 0 .. $bigger
+        ) {
+        ( $p[$_] ) = $p[$_] =~ /(.+)/;
+    }
+
+    return wantarray ? @p : \@p;
+}
+
+sub _validate_pos_depends {
+    my ( $p, $specs ) = @_;
+
+    for my $p_idx ( 0 .. $#$p ) {
+        my $spec = $specs->[$p_idx];
+
+        next
+            unless $spec
+                && UNIVERSAL::isa( $spec, 'HASH' )
+                && exists $spec->{depends};
+
+        my $depends = $spec->{depends};
+
+        if ( ref $depends ) {
+            require Carp;
+            local $Carp::CarpLevel = 2;
+            Carp::croak(
+                "Arguments to 'depends' for validate_pos() must be a scalar");
+        }
+
+        my $p_size = scalar @$p;
+        if ( $p_size < $depends - 1 ) {
+            my $error
+                = (   "Parameter #"
+                    . ( $p_idx + 1 )
+                    . " depends on parameter #"
+                    . $depends
+                    . ", which was not given" );
+
+            $options->{on_fail}->($error);
+        }
+    }
+    return 1;
+}
+
+sub _validate_named_depends {
+    my ( $p, $specs ) = @_;
+
+    foreach my $pname ( keys %$p ) {
+        my $spec = $specs->{$pname};
+
+        next
+            unless $spec
+                && UNIVERSAL::isa( $spec, 'HASH' )
+                && $spec->{depends};
+
+        unless ( UNIVERSAL::isa( $spec->{depends}, 'ARRAY' )
+            || !ref $spec->{depends} ) {
+            require Carp;
+            local $Carp::CarpLevel = 2;
+            Carp::croak(
+                "Arguments to 'depends' must be a scalar or arrayref");
+        }
+
+        foreach my $depends_name (
+            ref $spec->{depends}
+            ? @{ $spec->{depends} }
+            : $spec->{depends}
+            ) {
+            unless ( exists $p->{$depends_name} ) {
+                my $error
+                    = (   "Parameter '$pname' depends on parameter '"
+                        . $depends_name
+                        . "', which was not given" );
+
+                $options->{on_fail}->($error);
+            }
+        }
+    }
+}
+
+sub validate (\@$) {
+    return if $NO_VALIDATION && !defined wantarray;
+
+    my $p = $_[0];
+
+    my $specs = $_[1];
+    local $options = _get_options( ( caller(0) )[0] ) unless defined $options;
+
+    if ( ref $p eq 'ARRAY' ) {
+
+        # we were called as validate( @_, ... ) where @_ has a
+        # single element, a hash reference
+        if ( ref $p->[0] ) {
+            $p = { %{ $p->[0] } };
+        }
+        elsif ( @$p % 2 ) {
+            my $called = _get_called();
+
+            $options->{on_fail}
+                ->(   "Odd number of parameters in call to $called "
+                    . "when named parameters were expected\n" );
+        }
+        else {
+            $p = {@$p};
+        }
+    }
+
+    if ( $options->{normalize_keys} ) {
+        $specs = _normalize_callback( $specs, $options->{normalize_keys} );
+        $p     = _normalize_callback( $p,     $options->{normalize_keys} );
+    }
+    elsif ( $options->{ignore_case} || $options->{strip_leading} ) {
+        $specs = _normalize_named($specs);
+        $p     = _normalize_named($p);
+    }
+
+    if ($NO_VALIDATION) {
+        return (
+            wantarray
+            ? (
+
+                # this is a hash containing just the defaults
+                (
+                    map { $_ => $specs->{$_}->{default} }
+                        grep {
+                        ref $specs->{$_} && exists $specs->{$_}->{default}
+                        }
+                        keys %$specs
+                ),
+                (
+                    ref $p eq 'ARRAY'
+                    ? (
+                        ref $p->[0]
+                        ? %{ $p->[0] }
+                        : @$p
+                        )
+                    : %$p
+                )
+                )
+            : do {
+                my $ref = (
+                    ref $p eq 'ARRAY'
+                    ? (
+                        ref $p->[0]
+                        ? $p->[0]
+                        : {@$p}
+                        )
+                    : $p
+                );
+
+                foreach (
+                    grep {
+                        ref $specs->{$_}
+                            && exists $specs->{$_}->{default}
+                    }
+                    keys %$specs
+                    ) {
+                    $ref->{$_} = $specs->{$_}->{default}
+                        unless exists $ref->{$_};
+                }
+
+                return $ref;
+                }
+        );
+    }
+
+    _validate_named_depends( $p, $specs );
+
+    unless ( $options->{allow_extra} ) {
+        if ( my @unmentioned = grep { !exists $specs->{$_} } keys %$p ) {
+            my $called = _get_called();
+
+            $options->{on_fail}->( "The following parameter"
+                    . ( @unmentioned > 1 ? 's were' : ' was' )
+                    . " passed in the call to $called but "
+                    . ( @unmentioned > 1 ? 'were' : 'was' )
+                    . " not listed in the validation options: @unmentioned\n"
+            );
+        }
+    }
+
+    my @missing;
+
+    # the iterator needs to be reset in case the same hashref is being
+    # passed to validate() on successive calls, because we may not go
+    # through all the hash's elements
+    keys %$specs;
+OUTER:
+    while ( my ( $key, $spec ) = each %$specs ) {
+        if (
+            !exists $p->{$key}
+            && (
+                ref $spec
+                ? !(
+                    do {
+
+                        # we want to short circuit the loop here if we
+                        # can assign a default, because there's no need
+                        # check anything else at all.
+                        if ( exists $spec->{default} ) {
+                            $p->{$key} = $spec->{default};
+                            next OUTER;
+                        }
+                    }
+                    || do {
+
+                        # Similarly, an optional parameter that is
+                        # missing needs no additional processing.
+                        next OUTER if $spec->{optional};
+                    }
+                )
+                : $spec
+            )
+            ) {
+            push @missing, $key;
+        }
+
+        # Can't validate a non hashref spec beyond the presence or
+        # absence of the parameter.
+        elsif ( ref $spec ) {
+            my $value = defined $p->{$key} ? qq|"$p->{$key}"| : 'undef';
+            _validate_one_param( $p->{$key}, $p, $spec,
+                "The '$key' parameter ($value)" );
+        }
+    }
+
+    if (@missing) {
+        my $called = _get_called();
+
+        my $missing = join ', ', map {"'$_'"} @missing;
+        $options->{on_fail}->( "Mandatory parameter"
+                . ( @missing > 1 ? 's' : '' )
+                . " $missing missing in call to $called\n" );
+    }
+
+    # do untainting after we know everything passed
+    foreach my $key (
+        grep {
+                   defined $p->{$_}
+                && !ref $p->{$_}
+                && ref $specs->{$_}
+                && $specs->{$_}{untaint}
+        }
+        keys %$p
+        ) {
+        ( $p->{$key} ) = $p->{$key} =~ /(.+)/;
+    }
+
+    return wantarray ? %$p : $p;
+}
+
+sub validate_with {
+    return if $NO_VALIDATION && !defined wantarray;
+
+    my %p = @_;
+
+    local $options = _get_options( ( caller(0) )[0], %p );
+
+    unless ($NO_VALIDATION) {
+        unless ( exists $options->{called} ) {
+            $options->{called} = ( caller( $options->{stack_skip} ) )[3];
+        }
+
+    }
+
+    if ( UNIVERSAL::isa( $p{spec}, 'ARRAY' ) ) {
+        return validate_pos( @{ $p{params} }, @{ $p{spec} } );
+    }
+    else {
+
+        # intentionally ignore the prototype because this contains
+        # either an array or hash reference, and validate() will
+        # handle either one properly
+        return &validate( $p{params}, $p{spec} );
+    }
+}
+
+sub _normalize_callback {
+    my ( $p, $func ) = @_;
+
+    my %new;
+
+    foreach my $key ( keys %$p ) {
+        my $new_key = $func->($key);
+
+        unless ( defined $new_key ) {
+            die
+                "The normalize_keys callback did not return a defined value when normalizing the key '$key'";
+        }
+
+        if ( exists $new{$new_key} ) {
+            die
+                "The normalize_keys callback returned a key that already exists, '$new_key', when normalizing the key '$key'";
+        }
+
+        $new{$new_key} = $p->{$key};
+    }
+
+    return \%new;
+}
+
+sub _normalize_named {
+
+    # intentional copy so we don't destroy original
+    my %h = ( ref $_[0] ) =~ /ARRAY/ ? @{ $_[0] } : %{ $_[0] };
+
+    if ( $options->{ignore_case} ) {
+        $h{ lc $_ } = delete $h{$_} for keys %h;
+    }
+
+    if ( $options->{strip_leading} ) {
+        foreach my $key ( keys %h ) {
+            my $new;
+            ( $new = $key ) =~ s/^\Q$options->{strip_leading}\E//;
+            $h{$new} = delete $h{$key};
+        }
+    }
+
+    return \%h;
+}
+
+sub _validate_one_param {
+    my ( $value, $params, $spec, $id ) = @_;
+
+    if ( exists $spec->{type} ) {
+        unless ( defined $spec->{type}
+            && Scalar::Util::looks_like_number( $spec->{type} )
+            && $spec->{type} > 0 ) {
+            my $msg
+                = "$id has a type specification which is not a number. It is ";
+            if ( defined $spec->{type} ) {
+                $msg .= "a string - $spec->{type}";
+            }
+            else {
+                $msg .= "undef";
+            }
+
+            $msg
+                .= ".\n Use the constants exported by Params::Validate to declare types.";
+
+            $options->{on_fail}->($msg);
+        }
+
+        unless ( _get_type($value) & $spec->{type} ) {
+            my $type = _get_type($value);
+
+            my @is      = _typemask_to_strings($type);
+            my @allowed = _typemask_to_strings( $spec->{type} );
+            my $article = $is[0] =~ /^[aeiou]/i ? 'an' : 'a';
+
+            my $called = _get_called(1);
+
+            $options->{on_fail}->( "$id to $called was $article '@is', which "
+                    . "is not one of the allowed types: @allowed\n" );
+        }
+    }
+
+    # short-circuit for common case
+    return
+        unless ( $spec->{isa}
+        || $spec->{can}
+        || $spec->{callbacks}
+        || $spec->{regex} );
+
+    if ( exists $spec->{isa} ) {
+        foreach ( ref $spec->{isa} ? @{ $spec->{isa} } : $spec->{isa} ) {
+            unless ( eval { $value->isa($_) } ) {
+                my $is = ref $value ? ref $value : 'plain scalar';
+                my $article1 = $_  =~ /^[aeiou]/i ? 'an' : 'a';
+                my $article2 = $is =~ /^[aeiou]/i ? 'an' : 'a';
+
+                my $called = _get_called(1);
+
+                $options->{on_fail}
+                    ->(   "$id to $called was not $article1 '$_' "
+                        . "(it is $article2 $is)\n" );
+            }
+        }
+    }
+
+    if ( exists $spec->{can} ) {
+        foreach ( ref $spec->{can} ? @{ $spec->{can} } : $spec->{can} ) {
+            unless ( eval { $value->can($_) } ) {
+                my $called = _get_called(1);
+
+                $options->{on_fail}
+                    ->("$id to $called does not have the method: '$_'\n");
+            }
+        }
+    }
+
+    if ( $spec->{callbacks} ) {
+        unless ( UNIVERSAL::isa( $spec->{callbacks}, 'HASH' ) ) {
+            my $called = _get_called(1);
+
+            $options->{on_fail}->(
+                "'callbacks' validation parameter for $called must be a hash reference\n"
+            );
+        }
+
+        foreach ( keys %{ $spec->{callbacks} } ) {
+            unless ( UNIVERSAL::isa( $spec->{callbacks}{$_}, 'CODE' ) ) {
+                my $called = _get_called(1);
+
+                $options->{on_fail}->(
+                    "callback '$_' for $called is not a subroutine reference\n"
+                );
+            }
+
+            unless ( $spec->{callbacks}{$_}->( $value, $params ) ) {
+                my $called = _get_called(1);
+
+                $options->{on_fail}
+                    ->("$id to $called did not pass the '$_' callback\n");
+            }
+        }
+    }
+
+    if ( exists $spec->{regex} ) {
+        unless ( ( defined $value ? $value : '' ) =~ /$spec->{regex}/ ) {
+            my $called = _get_called(1);
+
+            $options->{on_fail}
+                ->("$id to $called did not pass regex check\n");
+        }
+    }
+}
+
+{
+
+    # if it UNIVERSAL::isa the string on the left then its the type on
+    # the right
+    my %isas = (
+        'ARRAY'  => ARRAYREF,
+        'HASH'   => HASHREF,
+        'CODE'   => CODEREF,
+        'GLOB'   => GLOBREF,
+        'SCALAR' => SCALARREF,
+    );
+    my %simple_refs = map { $_ => 1 } keys %isas;
+
+    sub _get_type {
+        return UNDEF unless defined $_[0];
+
+        my $ref = ref $_[0];
+        unless ($ref) {
+
+            # catches things like:  my $fh = do { local *FH; };
+            return GLOB if UNIVERSAL::isa( \$_[0], 'GLOB' );
+            return SCALAR;
+        }
+
+        return $isas{$ref} if $simple_refs{$ref};
+
+        foreach ( keys %isas ) {
+            return $isas{$_} | OBJECT if UNIVERSAL::isa( $_[0], $_ );
+        }
+
+        # I really hope this never happens.
+        return UNKNOWN;
+    }
+}
+
+{
+    my %type_to_string = (
+        SCALAR()    => 'scalar',
+        ARRAYREF()  => 'arrayref',
+        HASHREF()   => 'hashref',
+        CODEREF()   => 'coderef',
+        GLOB()      => 'glob',
+        GLOBREF()   => 'globref',
+        SCALARREF() => 'scalarref',
+        UNDEF()     => 'undef',
+        OBJECT()    => 'object',
+        UNKNOWN()   => 'unknown',
+    );
+
+    sub _typemask_to_strings {
+        my $mask = shift;
+
+        my @types;
+        foreach (
+            SCALAR,    ARRAYREF, HASHREF, CODEREF, GLOB, GLOBREF,
+            SCALARREF, UNDEF,    OBJECT,  UNKNOWN
+            ) {
+            push @types, $type_to_string{$_} if $mask & $_;
+        }
+        return @types ? @types : ('unknown');
+    }
+}
+
+{
+    my %defaults = (
+        ignore_case   => 0,
+        strip_leading => 0,
+        allow_extra   => 0,
+        on_fail       => sub {
+            require Carp;
+            Carp::confess( $_[0] );
+        },
+        stack_skip     => 1,
+        normalize_keys => undef,
+    );
+
+    *set_options = \&validation_options;
+
+    sub validation_options {
+        my %opts = @_;
+
+        my $caller = caller;
+
+        foreach ( keys %defaults ) {
+            $opts{$_} = $defaults{$_} unless exists $opts{$_};
+        }
+
+        $OPTIONS{$caller} = \%opts;
+    }
+
+    sub _get_options {
+        my $caller = shift;
+
+        if (@_) {
+
+            return (
+                $OPTIONS{$caller}
+                ? {
+                    %{ $OPTIONS{$caller} },
+                    @_
+                    }
+                : { %defaults, @_ }
+            );
+        }
+        else {
+            return (
+                exists $OPTIONS{$caller}
+                ? $OPTIONS{$caller}
+                : \%defaults
+            );
+        }
+    }
+}
+
+sub _get_called {
+    my $extra_skip = $_[0] || 0;
+
+    # always add one more for this sub
+    $extra_skip++;
+
+    my $called = (
+        exists $options->{called}
+        ? $options->{called}
+        : ( caller( $options->{stack_skip} + $extra_skip ) )[3]
+    );
+
+    $called = 'N/A' unless defined $called;
+
+    return $called;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Params::ValidatePP - pure Perl implementation of Params::Validate
+
+=head1 SYNOPSIS
+
+  See Params::Validate
+
+=head1 DESCRIPTION
+
+This is a pure Perl implementation of Params::Validate.  See the
+Params::Validate documentation for details.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004-2007 David Rolsky.  All rights reserved.  This
+program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Index: /rdnap/lib/Params/ValidateXS.pm
===================================================================
--- /rdnap/lib/Params/ValidateXS.pm	(revision 203)
+++ /rdnap/lib/Params/ValidateXS.pm	(revision 203)
@@ -0,0 +1,160 @@
+package Params::Validate;
+
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load( 'Params::Validate', $Params::Validate::VERSION );
+
+
+my $default_fail = sub { require Carp;
+                         Carp::confess($_[0]) };
+
+{
+    my %defaults = ( ignore_case   => 0,
+		     strip_leading => 0,
+		     allow_extra   => 0,
+		     on_fail       => $default_fail,
+		     stack_skip    => 1,
+                     normalize_keys => undef,
+		   );
+
+    *set_options = \&validation_options;
+    sub validation_options
+    {
+	my %opts = @_;
+
+	my $caller = caller;
+
+	foreach ( keys %defaults )
+	{
+	    $opts{$_} = $defaults{$_} unless exists $opts{$_};
+	}
+
+	$OPTIONS{$caller} = \%opts;
+    }
+}
+
+sub _check_regex_from_xs { return ( defined $_[0] ? $_[0] : '' ) =~ /$_[1]/ ? 1 : 0 }
+
+BEGIN
+{
+    if ( $] >= 5.006 && $] < 5.007 )
+    {
+        eval <<'EOF';
+sub check_for_error
+{
+    if ( defined $Params::Validate::ERROR )
+    {
+        $Params::Validate::ON_FAIL ||= sub { require Carp; Carp::croak( $_[0] ) };
+
+        $Params::Validate::ON_FAIL->($Params::Validate::ERROR)
+    }
+}
+
+sub validate_pos (\@@)
+{
+    local $Params::Validate::ERROR;
+    local $Params::Validate::ON_FAIL;
+    local $Params::Validate::CALLER = caller;
+
+    my $r;
+    if (defined wantarray)
+    {
+        $r = &_validate_pos;
+    }
+    else
+    {
+        &_validate_pos;
+    }
+
+    check_for_error();
+
+    return wantarray ? @$r : $r if defined wantarray;
+}
+
+sub validate (\@$)
+{
+    local $Params::Validate::ERROR;
+    local $Params::Validate::ON_FAIL;
+    local $Params::Validate::CALLER = caller;
+
+    my $r;
+    if (defined wantarray)
+    {
+        $r = &_validate;
+    }
+    else
+    {
+        &_validate;
+    }
+
+    check_for_error();
+
+    return wantarray ? %$r : $r if defined wantarray;
+}
+
+sub validate_with
+{
+    local $Params::Validate::ERROR;
+    local $Params::Validate::ON_FAIL;
+    local $Params::Validate::CALLER = caller;
+
+    my $r;
+    if (defined wantarray)
+    {
+        $r = &_validate_with;
+    }
+    else
+    {
+        &_validate_with;
+    }
+
+    check_for_error();
+
+    my %p = @_;
+    if ( UNIVERSAL::isa( $p{spec}, 'ARRAY' ) )
+    {
+        return wantarray ? @$r : $r if defined wantarray;
+    }
+    else
+    {
+        return wantarray ? %$r : $r if defined wantarray;
+    }
+}
+EOF
+
+        die $@ if $@;
+    }
+    else
+    {
+        *validate      = \&_validate;
+        *validate_pos  = \&_validate_pos;
+        *validate_with = \&_validate_with;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Params::ValidateXS - XS implementation of Params::Validate
+
+=head1 SYNOPSIS
+
+  See Params::Validate
+
+=head1 DESCRIPTION
+
+This is an XS implementation of Params::Validate.  See the
+Params::Validate documentation for details.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004-2007 David Rolsky.  All rights reserved.  This
+program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Index: /rdnap/rdnap.pl
===================================================================
--- /rdnap/rdnap.pl	(revision 203)
+++ /rdnap/rdnap.pl	(revision 203)
@@ -0,0 +1,42 @@
+#!/usr/bin/perl 
+#
+# Little wrapper around the usefull Geo::Coordinates::RDNAP cause the Dutch
+# Cadaster Organisation decided to take down their usefull one.
+#
+# License: BSDLike - http://rickvanderzwet.nl/LICENSE
+#
+# Rick van der Zwet <info@rickvanderzwet.nl>
+use lib 'lib';
+use strict;
+use Geo::Coordinates::RDNAP qw/from_rd to_rd dms/;
+
+print "Content-type: text/plain\n\n";
+my @uri = split /\//, $ENV{'REQUEST_URI'};
+if ($#uri lt 5) {
+  print "ERROR in parameters size (example /rdnap/rd2etrs/150.000/480.000/0)\n";
+  exit 1;
+}
+shift(@uri);
+my ($script, $command, $raw1, $raw2, $raw3) = @uri;
+$raw1 =~ tr/_//d;
+$raw2 =~ tr/_//d;
+
+my ($res1, $res2, $res3) = 0;
+
+if ($command eq "rd2etrs") {
+  ($res1, $res2, $res3) = from_rd($raw1, $raw2, $raw3);
+  $res1 = sprintf("%.2f", $res1);
+  $res2 = sprintf("%.2f", $res2);
+  $res3 = sprintf("%.2f", $res3);
+} elsif( $command eq "etrs2rd") {
+  ($res1, $res2, $res3) = to_rd($raw1, $raw2, $raw3);
+  $res1 = sprintf("%.0f", $res1);
+  $res2 = sprintf("%.0f", $res2);
+  $res3 = sprintf("%.2f", $res3);
+} else {
+  print "ERROR in parameters size (example /rdnap/rd2etrs/150.000/480.000/0)\n";
+  exit 1;
+}
+
+print join("/",($res1, $res2, $res3));
+print "\n";
