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
 158         = @$args == 1
 159         && ref $args->[0]
 160         && reftype( $args->[0] ) eq 'ARRAY' ? @{ $args->[0] } : @$args;
 161
 162     $args[$_] = $pv_spec[$_]{constraint}->coerce( $args[$_] )
 163         for grep { $pv_spec[$_] && $pv_spec[$_]{coerce} } 0 .. $#args;
 164
 165     @args = Params::Validate::validate_with(
 166         params      => \@args,
 167         spec        => \@pv_spec,
 168         allow_extra => $allow_extra,
 169         called      => _caller_name(),
 170     );
 171
 172     return @args;
 173 }
 174
 175 sub _cache_key {
 176     my $spec = shift;
 177
 178     if ( exists $spec->{MX_PARAMS_VALIDATE_CACHE_KEY} ) {
 179         return delete $spec->{MX_PARAMS_VALIDATE_CACHE_KEY};
 180     }
 181     else {
 182         return refaddr( caller_cv(2) );
 183     }
 184 }
 185
 186 sub _convert_to_param_validate_spec {
 187     my ($spec) = @_;
 188     my %pv_spec;
 189
 190     $pv_spec{optional} = $spec->{optional}
 191         if exists $spec->{optional};
 192
 193     $pv_spec{default} = $spec->{default}
 194         if exists $spec->{default};
 195
 196     $pv_spec{coerce} = $spec->{coerce}
 197         if exists $spec->{coerce};
 198
 199     my $constraint;
 200     if ( defined $spec->{isa} ) {
 201         $constraint
 202              = _is_tc( $spec->{isa} )
 203             || Moose::Util::TypeConstraints::find_or_parse_type_constraint(
 204             $spec->{isa} )
 205             || class_type( $spec->{isa} );
 206     }
 207     elsif ( defined $spec->{does} ) {
 208         $constraint
 209             = _is_tc( $spec->{isa} )
 210             || find_type_constraint( $spec->{does} )
 211             || role_type( $spec->{does} );
 212     }
 213
 214     $pv_spec{callbacks} = $spec->{callbacks}
 215         if exists $spec->{callbacks};
 216
 217     if ($constraint) {
 218         $pv_spec{constraint} = $constraint;
 219
 220         $pv_spec{callbacks}
 221             { 'checking type constraint for ' . $constraint->name }
 222             = sub { $constraint->check( $_[0] ) };
 223     }
 224
 225     delete $pv_spec{coerce}
 226         unless $pv_spec{constraint} && $pv_spec{constraint}->has_coercion;
 227
 228     return \%pv_spec;
 229 }
 230
 231 sub _is_tc {
 232     my $maybe_tc = shift;
 233
 234     return $maybe_tc
 235         if defined $maybe_tc
 236             && blessed $maybe_tc
 237             && $maybe_tc->isa('Moose::Meta::TypeConstraint');
 238 }
 239
 240 sub _caller_name {
 241     my $depth = shift || 0;
 242
 243     return ( caller( 2 + $depth ) )[3];
 244 }
 245
 246 1;
 247
 248 # ABSTRACT: an extension of Params::Validate using Moose's types
 249
 250 __END__
 251
 252 =pod
 253
 254 =head1 SYNOPSIS
 255
 256   package Foo;
 257   use Moose;
 258   use MooseX::Params::Validate;
 259
 260   sub foo {
 261       my ( $self, %params ) = validated_hash(
 262           \@_,
 263           bar => { isa => 'Str', default => 'Moose' },
 264       );
 265       return "Hooray for $params{bar}!";
 266   }
 267
 268   sub bar {
 269       my $self = shift;
 270       my ( $foo, $baz, $gorch ) = validated_list(
 271           \@_,
 272           foo   => { isa => 'Foo' },
 273           baz   => { isa => 'ArrayRef | HashRef', optional => 1 },
 274           gorch => { isa => 'ArrayRef[Int]', optional => 1 }
 275       );
 276       [ $foo, $baz, $gorch ];
 277   }
 278
 279 =head1 DESCRIPTION
 280
 281 This module fills a gap in Moose by adding method parameter validation
 282 to Moose. This is just one of many developing options, it should not
 283 be considered the "official" one by any means though.
 284
 285 You might also want to explore C<MooseX::Method::Signatures> and
 286 C<MooseX::Declare>.
 287
 288 =head1 CAVEATS
 289
 290 It is not possible to introspect the method parameter specs; they are
 291 created as needed when the method is called and cached for subsequent
 292 calls.
 293
 294 =head1 EXPORTS
 295
 296 =over 4
 297
 298 =item B<validated_hash( \@_, %parameter_spec )>
 299
 300 This behaves similarly to the standard Params::Validate C<validate>
 301 function and returns the captured values in a HASH. The one exception
 302 is where if it spots an instance in the C<@_>, then it will handle
 303 it appropriately (unlike Params::Validate which forces you to shift
 304 you C<$self> first).
 305
 306 The values in C<@_> can either be a set of name-value pairs or a single hash
 307 reference.
 308
 309 The C<%parameter_spec> accepts the following options:
 310
 311 =over 4
 312
 313 =item I<isa>
 314
 315 The C<isa> option can be either; class name, Moose type constraint
 316 name or an anon Moose type constraint.
 317
 318 =item I<does>
 319
 320 The C<does> option can be either; role name or an anon Moose type
 321 constraint.
 322
 323 =item I<default>
 324
 325 This is the default value to be used if the value is not supplied.
 326
 327 =item I<optional>
 328
 329 As with Params::Validate, all options are considered required unless
 330 otherwise specified. This option is passed directly to
 331 Params::Validate.
 332
 333 =item I<coerce>
 334
 335 If this is true and the parameter has a type constraint which has
 336 coercions, then the coercion will be called for this parameter. If the
 337 type does have coercions, then this parameter is ignored.
 338
 339 =back
 340
 341 This function is also available under its old name, C<validate>.
 342
 343 =item B<validated_list( \@_, %parameter_spec )>
 344
 345 The C<%parameter_spec> accepts the same options as above, but returns
 346 the parameters as positional values instead of a HASH. This is best
 347 explained by example:
 348
 349   sub foo {
 350       my ( $self, $foo, $bar ) = validated_list(
 351           \@_,
 352           foo => { isa => 'Foo' },
 353           bar => { isa => 'Bar' },
 354       );
 355       $foo->baz($bar);
 356   }
 357
 358 We capture the order in which you defined the parameters and then
 359 return them as a list in the same order. If a param is marked optional
 360 and not included, then it will be set to C<undef>.
 361
 362 The values in C<@_> can either be a set of name-value pairs or a single hash
 363 reference.
 364
 365 Like C<validated_hash>, if it spots an object instance as the first
 366 parameter of C<@_>, it will handle it appropriately, returning it as
 367 the first argument.
 368
 369 This function is also available under its old name, C<validatep>.
 370
 371 =item B<pos_validated_list( \@_, $spec, $spec, ... )>
 372
 373 This function validates a list of positional parameters. Each C<$spec>
 374 should validate one of the parameters in the list:
 375
 376   sub foo {
 377       my $self = shift;
 378       my ( $foo, $bar ) = pos_validated_list(
 379           \@_,
 380           { isa => 'Foo' },
 381           { isa => 'Bar' },
 382       );
 383
 384       ...
 385   }
 386
 387 Unlike the other functions, this function I<cannot> find C<$self> in
 388 the argument list. Make sure to shift it off yourself before doing
 389 validation.
 390
 391 The values in C<@_> can either be a list of values or a single array
 392 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