home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / ValidateXS.pm < prev    next >
Encoding:
Perl POD Document  |  2003-10-08  |  3.0 KB  |  169 lines
  1. # Copyright (c) 2000-2003 Dave Rolsky
  2. # All rights reserved.
  3. # This program is free software; you can redistribute it and/or
  4. # modify it under the same terms as Perl itself.  See the LICENSE
  5. # file that comes with this distribution for more details.
  6. package Params::Validate;
  7.  
  8. use strict;
  9.  
  10. require DynaLoader;
  11.  
  12. if ( $] >= 5.006 )
  13. {
  14.     require XSLoader;
  15.     XSLoader::load( 'Params::Validate', $Params::Validate::VERSION );
  16. }
  17. else
  18. {
  19.     require DynaLoader;
  20.     push @ISA, 'DynaLoader';
  21.     Params::Validate->bootstrap( $Params::Validate::VERSION );
  22. }
  23.  
  24. my $default_fail = sub { require Carp;
  25.                          Carp::confess($_[0]) };
  26.  
  27. {
  28.     my %defaults = ( ignore_case   => 0,
  29.              strip_leading => 0,
  30.              allow_extra   => 0,
  31.              on_fail       => $default_fail,
  32.              stack_skip    => 1,
  33.                      normalize_keys => undef,
  34.            );
  35.  
  36.     *set_options = \&validation_options;
  37.     sub validation_options
  38.     {
  39.     my %opts = @_;
  40.  
  41.     my $caller = caller;
  42.  
  43.     foreach ( keys %defaults )
  44.     {
  45.         $opts{$_} = $defaults{$_} unless exists $opts{$_};
  46.     }
  47.  
  48.     $OPTIONS{$caller} = \%opts;
  49.     }
  50. }
  51.  
  52. sub _check_regex_from_xs { return $_[0] =~ /$_[1]/ ? 1 : 0 }
  53.  
  54. BEGIN
  55. {
  56.     if ( $] >= 5.006 && $] < 5.007 )
  57.     {
  58.         eval <<'EOF';
  59. sub check_for_error
  60. {
  61.     if ( defined $Params::Validate::ERROR )
  62.     {
  63.         $Params::Validate::ON_FAIL ||= sub { require Carp; Carp::croak( $_[0] ) };
  64.  
  65.         $Params::Validate::ON_FAIL->($Params::Validate::ERROR)
  66.     }
  67. }
  68.  
  69. sub validate_pos (\@@)
  70. {
  71.     local $Params::Validate::ERROR;
  72.     local $Params::Validate::ON_FAIL;
  73.     local $Params::Validate::CALLER = caller;
  74.  
  75.     my $r;
  76.     if (defined wantarray)
  77.     {
  78.         $r = &_validate_pos;
  79.     }
  80.     else
  81.     {
  82.         &_validate_pos;
  83.     }
  84.  
  85.     check_for_error();
  86.  
  87.     return wantarray ? @$r : $r if defined wantarray;
  88. }
  89.  
  90. sub validate (\@$)
  91. {
  92.     local $Params::Validate::ERROR;
  93.     local $Params::Validate::ON_FAIL;
  94.     local $Params::Validate::CALLER = caller;
  95.  
  96.     my $r;
  97.     if (defined wantarray)
  98.     {
  99.         $r = &_validate;
  100.     }
  101.     else
  102.     {
  103.         &_validate;
  104.     }
  105.  
  106.     check_for_error();
  107.  
  108.     return wantarray ? %$r : $r if defined wantarray;
  109. }
  110.  
  111. sub validate_with
  112. {
  113.     local $Params::Validate::ERROR;
  114.     local $Params::Validate::ON_FAIL;
  115.     local $Params::Validate::CALLER = caller;
  116.  
  117.     my $r;
  118.     if (defined wantarray)
  119.     {
  120.         $r = &_validate_with;
  121.     }
  122.     else
  123.     {
  124.         &_validate_with;
  125.     }
  126.  
  127.     check_for_error();
  128.  
  129.     my %p = @_;
  130.     if ( UNIVERSAL::isa( $p{spec}, 'ARRAY' ) )
  131.     {
  132.         return wantarray ? @$r : $r if defined wantarray;
  133.     }
  134.     else
  135.     {
  136.         return wantarray ? %$r : $r if defined wantarray;
  137.     }
  138. }
  139. EOF
  140.  
  141.         die $@ if $@;
  142.     }
  143.     else
  144.     {
  145.         *validate      = \&_validate;
  146.         *validate_pos  = \&_validate_pos;
  147.         *validate_with = \&_validate_with;
  148.     }
  149. }
  150.  
  151. 1;
  152.  
  153. __END__
  154.  
  155. =head1 NAME
  156.  
  157. Params::ValidateXS - XS implementation of Params::Validate
  158.  
  159. =head1 SYNOPSIS
  160.  
  161.   See Params::Validate
  162.  
  163. =head1 DESCRIPTION
  164.  
  165. This is an XS implementation of Params::Validate.  See the
  166. Params::Validate documentation for details.
  167.  
  168. =cut
  169.