lib/MooseX/Params/Validate.pm

   1 package MooseX::Params::Validate;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp 'confess';
   7 use Devel::Caller 'caller_cv';
   8 use Scalar::Util 'blessed', 'refaddr';
   9
  10 use Moose::Util::TypeConstraints qw( find_type_constraint class_type role_type );
  11 use Params::Validate             ();
  12 use Sub::Exporter -setup => {
  13     exports => [
  14         qw( validated_hash validated_list pos_validated_list validate validatep )
  15     ],
  16     groups => {
  17         default => [qw( validated_hash validated_list pos_validated_list )],
  18         deprecated => [qw( validate validatep )],
  19     },
  20 };
  21
  22 our $AUTHORITY = 'cpan:STEVAN';
  23
  24 my %CACHED_SPECS;
  25
  26 sub validated_hash {
  27     my ( $args, %spec ) = @_;
  28
  29     my $cache_key = _cache_key( \%spec );
  30
  31     my $allow_extra = delete $spec{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
  32
  33     if ( exists $CACHED_SPECS{$cache_key} ) {
  34         ( ref $CACHED_SPECS{$cache_key} eq 'HASH' )
  35             || confess
  36             "I was expecting a HASH-ref in the cached $cache_key parameter"
  37             . " spec, you are doing something funky, stop it!";
  38         %spec = %{ $CACHED_SPECS{$cache_key} };
  39     }
  40     else {
  41         my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
  42
  43         $spec{$_} = _convert_to_param_validate_spec( $spec{$_} )
  44             foreach keys %spec;
  45
  46         $CACHED_SPECS{$cache_key} = \%spec
  47             if $should_cache;
  48     }
  49
  50     my $instance;
  51     $instance = shift @$args if blessed $args->[0];
  52
  53     my %args = @$args;
  54
  55     $args{$_} = $spec{$_}{constraint}->coerce( $args{$_} )
  56         for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
  57
  58     %args = Params::Validate::validate_with(
  59         params      => \%args,
  60         spec        => \%spec,
  61         allow_extra => $allow_extra,
  62         called      => _caller_name(),
  63     );
  64
  65     return ( ( defined $instance ? $instance : () ), %args );
  66 }
  67
  68 *validate = \&validated_hash;
  69
  70 sub validated_list {
  71     my ( $args, @spec ) = @_;
  72
  73     my %spec = @spec;
  74
  75     my $cache_key = _cache_key( \%spec );
  76
  77     my $allow_extra = delete $spec{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
  78
  79     my @ordered_spec;
  80     if ( exists $CACHED_SPECS{$cache_key} ) {
  81         ( ref $CACHED_SPECS{$cache_key} eq 'ARRAY' )
  82             || confess
  83             "I was expecting a ARRAY-ref in the cached $cache_key parameter"
  84             . " spec, you are doing something funky, stop it!";
  85         %spec         = %{ $CACHED_SPECS{$cache_key}->[0] };
  86         @ordered_spec = @{ $CACHED_SPECS{$cache_key}->[1] };
  87     }
  88     else {
  89         my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
  90
  91         @ordered_spec = grep { exists $spec{$_} } @spec;
  92
  93         $spec{$_} = _convert_to_param_validate_spec( $spec{$_} )
  94             foreach keys %spec;
  95
  96         $CACHED_SPECS{$cache_key} = [ \%spec, \@ordered_spec ]
  97             if $should_cache;
  98     }
  99
 100     my $instance;
 101     $instance = shift @$args if blessed $args->[0];
 102
 103     my %args = @$args;
 104
 105     $args{$_} = $spec{$_}{constraint}->coerce( $args{$_} )
 106         for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
 107
 108     %args = Params::Validate::validate_with(
 109         params      => \%args,
 110         spec        => \%spec,
 111         allow_extra => $allow_extra,
 112         called      => _caller_name(),
 113     );
 114
 115     return (
 116         ( defined $instance ? $instance : () ),
 117         @args{@ordered_spec}
 118     );
 119 }
 120
 121 *validatep = \&validated_list;
 122
 123 sub pos_validated_list {
 124     my $args = shift;
 125
 126     my @spec;
 127     push @spec, shift while ref $_[0];
 128
 129     my %extra = @_;
 130
 131     my $cache_key = _cache_key( \%extra );
 132
 133     my $allow_extra = delete $extra{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
 134
 135     my @pv_spec;
 136     if ( exists $CACHED_SPECS{$cache_key} ) {
 137         ( ref $CACHED_SPECS{$cache_key} eq 'ARRAY' )
 138             || confess
 139             "I was expecting an ARRAY-ref in the cached $cache_key parameter"
 140             . " spec, you are doing something funky, stop it!";
 141         @pv_spec = @{ $CACHED_SPECS{$cache_key} };
 142     }
 143     else {
 144         my $should_cache = exists $extra{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
 145
 146         # prepare the parameters ...
 147         @pv_spec = map { _convert_to_param_validate_spec($_) } @spec;
 148
 149         $CACHED_SPECS{$cache_key} = \@pv_spec
 150             if $should_cache;
 151     }
 152
 153     my @args = @{$args};
 154
 155     $args[$_] = $pv_spec[$_]{constraint}->coerce( $args[$_] )
 156         for grep { $pv_spec[$_] && $pv_spec[$_]{coerce} } 0 .. $#args;
 157
 158     @args = Params::Validate::validate_with(
 159         params      => \@args,
 160         spec        => \@pv_spec,
 161         allow_extra => $allow_extra,
 162         called      => _caller_name(),
 163     );
 164
 165     return @args;
 166 }
 167
 168 sub _cache_key {
 169     my $spec = shift;
 170
 171     if ( exists $spec->{MX_PARAMS_VALIDATE_CACHE_KEY} ) {
 172         return delete $spec->{MX_PARAMS_VALIDATE_CACHE_KEY};
 173     }
 174     else {
 175         return refaddr( caller_cv(2) );
 176     }
 177 }
 178
 179 sub _convert_to_param_validate_spec {
 180     my ($spec) = @_;
 181     my %pv_spec;
 182
 183     $pv_spec{optional} = $spec->{optional}
 184         if exists $spec->{optional};
 185
 186     $pv_spec{default} = $spec->{default}
 187         if exists $spec->{default};
 188
 189     $pv_spec{coerce} = $spec->{coerce}
 190         if exists $spec->{coerce};
 191
 192     my $constraint;
 193     if ( defined $spec->{isa} ) {
 194         $constraint
 195              = _is_tc( $spec->{isa} )
 196             || Moose::Util::TypeConstraints::find_or_parse_type_constraint(
 197             $spec->{isa} )
 198             || class_type( $spec->{isa} );
 199     }
 200     elsif ( defined $spec->{does} ) {
 201         $constraint
 202             = _is_tc( $spec->{isa} )
 203             || find_type_constraint( $spec->{does} )
 204             || role_type( $spec->{does} );
 205     }
 206
 207     $pv_spec{callbacks} = $spec->{callbacks}
 208         if exists $spec->{callbacks};
 209
 210     if ($constraint) {
 211         $pv_spec{constraint} = $constraint;
 212
 213         $pv_spec{callbacks}
 214             { 'checking type constraint for ' . $constraint->name }
 215             = sub { $constraint->check( $_[0] ) };
 216     }
 217
 218     delete $pv_spec{coerce}
 219         unless $pv_spec{constraint} && $pv_spec{constraint}->has_coercion;
 220
 221     return \%pv_spec;
 222 }
 223
 224 sub _is_tc {
 225     my $maybe_tc = shift;
 226
 227     return $maybe_tc
 228         if defined $maybe_tc
 229             && blessed $maybe_tc
 230             && $maybe_tc->isa('Moose::Meta::TypeConstraint');
 231 }
 232
 233 sub _caller_name {
 234     my $depth = shift || 0;
 235
 236     return ( caller( 2 + $depth ) )[3];
 237 }
 238
 239 1;
 240
 241 # ABSTRACT: an extension of Params::Validate using Moose's types
 242
 243 __END__
 244
 245 =pod
 246
 247 =head1 SYNOPSIS
 248
 249   package Foo;
 250   use Moose;
 251   use MooseX::Params::Validate;
 252
 253   sub foo {
 254       my ( $self, %params ) = validated_hash(
 255           \@_,
 256           bar => { isa => 'Str', default => 'Moose' },
 257       );
 258       return "Hooray for $params{bar}!";
 259   }
 260
 261   sub bar {
 262       my $self = shift;
 263       my ( $foo, $baz, $gorch ) = validated_list(
 264           \@_,
 265           foo   => { isa => 'Foo' },
 266           baz   => { isa => 'ArrayRef | HashRef', optional => 1 },
 267           gorch => { isa => 'ArrayRef[Int]', optional => 1 }
 268       );
 269       [ $foo, $baz, $gorch ];
 270   }
 271
 272 =head1 DESCRIPTION
 273
 274 This module fills a gap in Moose by adding method parameter validation
 275 to Moose. This is just one of many developing options, it should not
 276 be considered the "official" one by any means though.
 277
 278 You might also want to explore C<MooseX::Method::Signatures> and
 279 C<MooseX::Declare>.
 280
 281 =head1 CAVEATS
 282
 283 It is not possible to introspect the method parameter specs; they are
 284 created as needed when the method is called and cached for subsequent
 285 calls.
 286
 287 =head1 EXPORTS
 288
 289 =over 4
 290
 291 =item B<validated_hash( \@_, %parameter_spec )>
 292
 293 This behaves similarly to the standard Params::Validate C<validate>
 294 function and returns the captured values in a HASH. The one exception
 295 is where if it spots an instance in the C<@_>, then it will handle
 296 it appropriately (unlike Params::Validate which forces you to shift
 297 you C<$self> first).
 298
 299 The C<%parameter_spec> accepts the following options:
 300
 301 =over 4
 302
 303 =item I<isa>
 304
 305 The C<isa> option can be either; class name, Moose type constraint
 306 name or an anon Moose type constraint.
 307
 308 =item I<does>
 309
 310 The C<does> option can be either; role name or an anon Moose type
 311 constraint.
 312
 313 =item I<default>
 314
 315 This is the default value to be used if the value is not supplied.
 316
 317 =item I<optional>
 318
 319 As with Params::Validate, all options are considered required unless
 320 otherwise specified. This option is passed directly to
 321 Params::Validate.
 322
 323 =item I<coerce>
 324
 325 If this is true and the parameter has a type constraint which has
 326 coercions, then the coercion will be called for this parameter. If the
 327 type does have coercions, then this parameter is ignored.
 328
 329 =back
 330
 331 This function is also available under its old name, C<validate>.
 332
 333 =item B<validated_list( \@_, %parameter_spec )>
 334
 335 The C<%parameter_spec> accepts the same options as above, but returns
 336 the parameters as positional values instead of a HASH. This is best
 337 explained by example:
 338
 339   sub foo {
 340       my ( $self, $foo, $bar ) = validated_list(
 341           \@_,
 342           foo => { isa => 'Foo' },
 343           bar => { isa => 'Bar' },
 344       );
 345       $foo->baz($bar);
 346   }
 347
 348 We capture the order in which you defined the parameters and then
 349 return them as a list in the same order. If a param is marked optional
 350 and not included, then it will be set to C<undef>.
 351
 352 Like C<validated_hash>, if it spots an object instance as the first
 353 parameter of C<@_>, it will handle it appropriately, returning it as
 354 the first argument.
 355
 356 This function is also available under its old name, C<validatep>.
 357
 358 =item B<pos_validated_list( \@_, $spec, $spec, ... )>
 359
 360 This function validates a list of positional parameters. Each C<$spec>
 361 should validate one of the parameters in the list:
 362
 363   sub foo {
 364       my $self = shift;
 365       my ( $foo, $bar ) = pos_validated_list(
 366           \@_,
 367           { isa => 'Foo' },
 368           { isa => 'Bar' },
 369       );
 370
 371       ...
 372   }
 373
 374 Unlike the other functions, this function I<cannot> find C<$self> in
 375 the argument list. Make sure to shift it off yourself before doing
 376 validation.
 377
 378 If a parameter is marked as optional and is not present, it will
 379 simply not be returned.
 380
 381 If you want to pass in any of the cache control parameters described
 382 below, simply pass them after the list of parameter validation specs:
 383
 384   sub foo {
 385       my $self = shift;
 386       my ( $foo, $bar ) = pos_validated_list(
 387           \@_,
 388           { isa => 'Foo' },
 389           { isa => 'Bar' },
 390           MX_PARAMS_VALIDATE_NO_CACHE => 1,
 391       );
 392
 393       ...
 394   }
 395
 396 =back
 397
 398 =head1 ALLOWING EXTRA PARAMETERS
 399
 400 By default, any parameters not mentioned in the parameter spec cause this
 401 module to throw an error. However, you can have have this module simply ignore
 402 them by setting C<MX_PARAMS_VALIDATE_ALLOW_EXTRA> to a true value when calling
 403 a validation subroutine.
 404
 405 When calling C<validated_hash> or C<pos_validated_list> the extra parameters
 406 are simply returned in the hash or list as appropriate. However, when you call
 407 C<validated_list> the extra parameters will not be returned at all. You can
 408 get them by looking at the original value of C<@_>.
 409
 410 =head1 EXPORTS
 411
 412 By default, this module exports the C<validated_hash>,
 413 C<validated_list>, and C<pos_validated_list>.
 414
 415 If you would prefer to import the now deprecated functions C<validate>
 416 and C<validatep> instead, you can use the C<:deprecated> tag to import
 417 them.
 418
 419 =head1 IMPORTANT NOTE ON CACHING
 420
 421 When a validation subroutine is called the first time, the parameter spec is
 422 prepared and cached to avoid unnecessary regeneration. It uses the fully
 423 qualified name of the subroutine (package + subname) as the cache key.  In
 424 99.999% of the use cases for this module, that will be the right thing to do.
 425
 426 However, I have (ab)used this module occasionally to handle dynamic
 427 sets of parameters. In this special use case you can do a couple
 428 things to better control the caching behavior.
 429
 430 =over 4
 431
 432 =item *
 433
 434 Passing in the C<MX_PARAMS_VALIDATE_NO_CACHE> flag in the parameter
 435 spec this will prevent the parameter spec from being cached.
 436
 437   sub foo {
 438       my ( $self, %params ) = validated_hash(
 439           \@_,
 440           foo                         => { isa => 'Foo' },
 441           MX_PARAMS_VALIDATE_NO_CACHE => 1,
 442       );
 443
 444   }
 445
 446 =item *
 447
 448 Passing in C<MX_PARAMS_VALIDATE_CACHE_KEY> with a value to be used as
 449 the cache key will bypass the normal cache key generation.
 450
 451   sub foo {
 452       my ( $self, %params ) = validated_hash(
 453           \@_,
 454           foo                          => { isa => 'Foo' },
 455           MX_PARAMS_VALIDATE_CACHE_KEY => 'foo-42',
 456       );
 457
 458   }
 459
 460 =back
 461
 462 =head1 MAINTAINER
 463
 464 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 465
 466 =head1 BUGS
 467
 468 Please submit bugs to the CPAN RT system at
 469 http://rt.cpan.org/NoAuth/ReportBug.html?Queue=moosex-params-validate or via
 470 email at bug-moosex-params-validate@rt.cpan.org.
 471
 472 =cut