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