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