ValidateXS.pm   [plain text]

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