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