local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Attribute/Params/Validate.pm

   1 package Attribute::Params::Validate;
   2
   3 use strict;
   4 use warnings; # ok to use cause Attribute::Handlers needs 5.6.0+ as well
   5
   6 use attributes;
   7
   8 use Attribute::Handlers;
   9
  10 # this will all be re-exported
  11 use Params::Validate qw(:all);
  12
  13 require Exporter;
  14
  15 use vars qw($VERSION);
  16
  17 our @ISA = qw(Exporter);
  18
  19 my %tags = ( types => [ qw( SCALAR ARRAYREF HASHREF CODEREF GLOB GLOBREF SCALARREF HANDLE UNDEF OBJECT ) ],
  20            );
  21
  22 our %EXPORT_TAGS = ( 'all' => [ qw( validation_options ), map { @{ $tags{$_} } } keys %tags ],
  23                      %tags,
  24                    );
  25 our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} }, 'validation_options' );
  26
  27 $VERSION = sprintf '%2d.%02d', q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
  28
  29
  30 sub UNIVERSAL::Validate : ATTR(CODE, INIT)
  31 {
  32     _wrap_sub('named', @_);
  33 }
  34
  35 sub UNIVERSAL::ValidatePos : ATTR(CODE, INIT)
  36 {
  37     _wrap_sub('positional', @_);
  38 }
  39
  40 sub _wrap_sub
  41 {
  42     my ($type, $package, $symbol, $referent, $attr, $params) = @_;
  43
  44     my @p = ref $params ? @{ $params } : $params;
  45
  46     my $subname = $package . '::' . *{$symbol}{NAME};
  47
  48     my %attributes = map { $_ => 1 } attributes::get($referent);
  49     my $is_method = $attributes{method};
  50
  51     {
  52         no warnings 'redefine';
  53         no strict 'refs';
  54
  55         # An unholy mixture of closure and eval.  This is done so that
  56         # the code to automatically create the relevant scalars from
  57         # the hash of params can create the scalars in the proper
  58         # place lexically.
  59
  60         my $code = <<"EOF";
  61 sub
  62 {
  63     package $package;
  64 EOF
  65
  66         $code .= "    my \$object = shift;\n" if $is_method;
  67
  68         if ($type eq 'named')
  69         {
  70             $params = {@p};
  71             $code .= "    Params::Validate::validate(\@_, \$params);\n";
  72         }
  73         else
  74         {
  75             $code .= "    Params::Validate::validate_pos(\@_, \@p);\n";
  76         }
  77
  78         $code .= "    unshift \@_, \$object if \$object;\n" if $is_method;
  79
  80         $code .= <<"EOF";
  81     \$referent->(\@_);
  82 }
  83 EOF
  84
  85         my $sub = eval $code;
  86         die $@ if $@;
  87
  88         *{$subname} = $sub;
  89     }
  90 }
  91
  92 1;
  93
  94
  95 =head1 NAME
  96
  97 Attribute::Params::Validate - Validate method/function parameters using attributes
  98
  99 =head1 SYNOPSIS
 100
 101   use Attribute::Params::Validate qw(:all);
 102
 103   # takes named params (hash or hashref)
 104   # foo is mandatory, bar is optional
 105   sub foo : Validate( foo => 1, bar => 0 )
 106   {
 107       ...
 108   }
 109
 110   # takes positional params
 111   # first two are mandatory, third is optional
 112   sub bar : ValidatePos( 1, 1, 0 )
 113   {
 114       ...
 115   }
 116
 117   # for some reason Perl insists that the entire attribute be on one line
 118   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 } } } )
 119   {
 120       ...
 121   }
 122
 123   # note that this is marked as a method.  This is very important!
 124   sub baz : Validate( foo => { type => ARRAYREF }, bar => { isa => 'Frobnicator' } ) method
 125   {
 126       ...
 127   }
 128
 129 =head1 DESCRIPTION
 130
 131
 132 The Attribute::Params::Validate module allows you to validate method
 133 or function call parameters just like Params::Validate does.  However,
 134 this module allows you to specify your validation spec as an
 135 attribute, rather than by calling the C<validate> routine.
 136
 137 Please see Params::Validate for more information on how you can
 138 specify what validation is performed.
 139
 140 =head2 EXPORT
 141
 142 This module exports everthing that Params::Validate does except for
 143 the C<validate> and C<validate_pos> subroutines.
 144
 145 =head2 ATTRIBUTES
 146
 147 =over 4
 148
 149 =item * Validate
 150
 151 This attribute corresponse to the C<validate> subroutine in
 152 Params::Validate.
 153
 154 =item * ValidatePos
 155
 156 This attribute corresponse to the C<validate_pos> subroutine in
 157 Params::Validate.
 158
 159 =back
 160
 161 =head2 OO
 162
 163 If you are using this module to mark B<methods> for validation, as
 164 opposed to subroutines, it is crucial that you mark these methods with
 165 the C<:method> attribute, as well as the C<Validate> or C<ValidatePos>
 166 attribute.
 167
 168 If you do not do this, then the object or class used in the method
 169 call will be passed to the validation routines, which is probably not
 170 what you want.
 171
 172 =head2 CAVEATS
 173
 174 You B<must> put all the arguments to the C<Validate> or C<ValidatePos>
 175 attribute on a single line, or Perl will complain.
 176
 177 =head1 SEE ALSO
 178
 179 Params::Validate
 180
 181 =head1 AUTHOR
 182
 183 Dave Rolsky, <autarch@urth.org>
 184
 185 =cut
 186