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