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 __END__
 243
 244 =pod
 245
 246 =head1 NAME
 247
 248 MooseX::Params::Validate - an extension of Params::Validate for using Moose's types
 249
 250 =head1 SYNOPSIS
 251
 252   package Foo;
 253   use Moose;
 254   use MooseX::Params::Validate;
 255
 256   sub foo {
 257       my ( $self, %params ) = validated_hash(
 258           \@_,
 259           bar => { isa => 'Str', default => 'Moose' },
 260       );
 261       return "Hooray for $params{bar}!";
 262   }
 263
 264   sub bar {
 265       my $self = shift;
 266       my ( $foo, $baz, $gorch ) = validated_list(
 267           \@_,
 268           foo   => { isa => 'Foo' },
 269           baz   => { isa => 'ArrayRef | HashRef', optional => 1 },
 270           gorch => { isa => 'ArrayRef[Int]', optional => 1 }
 271       );
 272       [ $foo, $baz, $gorch ];
 273   }
 274
 275 =head1 DESCRIPTION
 276
 277 This module fills a gap in Moose by adding method parameter validation
 278 to Moose. This is just one of many developing options, it should not
 279 be considered the "official" one by any means though.
 280
 281 You might also want to explore C<MooseX::Method::Signatures> and
 282 C<MooseX::Declare>.
 283
 284 =head1 CAVEATS
 285
 286 It is not possible to introspect the method parameter specs; they are
 287 created as needed when the method is called and cached for subsequent
 288 calls.
 289
 290 =head1 EXPORTS
 291
 292 =over 4
 293
 294 =item B<validated_hash( \@_, %parameter_spec )>
 295
 296 This behaves similarly to the standard Params::Validate C<validate>
 297 function and returns the captured values in a HASH. The one exception
 298 is where if it spots an instance in the C<@_>, then it will handle
 299 it appropriately (unlike Params::Validate which forces you to shift
 300 you C<$self> first).
 301
 302 The C<%parameter_spec> accepts the following options:
 303
 304 =over 4
 305
 306 =item I<isa>
 307
 308 The C<isa> option can be either; class name, Moose type constraint
 309 name or an anon Moose type constraint.
 310
 311 =item I<does>
 312
 313 The C<does> option can be either; role name or an anon Moose type
 314 constraint.
 315
 316 =item I<default>
 317
 318 This is the default value to be used if the value is not supplied.
 319
 320 =item I<optional>
 321
 322 As with Params::Validate, all options are considered required unless
 323 otherwise specified. This option is passed directly to
 324 Params::Validate.
 325
 326 =item I<coerce>
 327
 328 If this is true and the parameter has a type constraint which has
 329 coercions, then the coercion will be called for this parameter. If the
 330 type does have coercions, then this parameter is ignored.
 331
 332 =back
 333
 334 This function is also available under its old name, C<validate>.
 335
 336 =item B<validated_list( \@_, %parameter_spec )>
 337
 338 The C<%parameter_spec> accepts the same options as above, but returns
 339 the parameters as positional values instead of a HASH. This is best
 340 explained by example:
 341
 342   sub foo {
 343       my ( $self, $foo, $bar ) = validated_list(
 344           \@_,
 345           foo => { isa => 'Foo' },
 346           bar => { isa => 'Bar' },
 347       );
 348       $foo->baz($bar);
 349   }
 350
 351 We capture the order in which you defined the parameters and then
 352 return them as a list in the same order. If a param is marked optional
 353 and not included, then it will be set to C<undef>.
 354
 355 Like C<validated_hash>, if it spots an object instance as the first
 356 parameter of C<@_>, it will handle it appropriately, returning it as
 357 the first argument.
 358
 359 This function is also available under its old name, C<validatep>.
 360
 361 =item B<pos_validated_list( \@_, $spec, $spec, ... )>
 362
 363 This function validates a list of positional parameters. Each C<$spec>
 364 should validate one of the parameters in the list:
 365
 366   sub foo {
 367       my $self = shift;
 368       my ( $foo, $bar ) = pos_validated_list(
 369           \@_,
 370           { isa => 'Foo' },
 371           { isa => 'Bar' },
 372       );
 373
 374       ...
 375   }
 376
 377 Unlike the other functions, this function I<cannot> find C<$self> in
 378 the argument list. Make sure to shift it off yourself before doing
 379 validation.
 380
 381 If a parameter is marked as optional and is not present, it will
 382 simply not be returned.
 383
 384 If you want to pass in any of the cache control parameters described
 385 below, simply pass them after the list of parameter validation specs:
 386
 387   sub foo {
 388       my $self = shift;
 389       my ( $foo, $bar ) = pos_validated_list(
 390           \@_,
 391           { isa => 'Foo' },
 392           { isa => 'Bar' },
 393           MX_PARAMS_VALIDATE_NO_CACHE => 1,
 394       );
 395
 396       ...
 397   }
 398
 399 =back
 400
 401 =head1 ALLOWING EXTRA PARAMETERS
 402
 403 By default, any parameters not mentioned in the parameter spec cause this
 404 module to throw an error. However, you can have have this module simply ignore
 405 them by setting C<MX_PARAMS_VALIDATE_ALLOW_EXTRA> to a true value when calling
 406 a validation subroutine.
 407
 408 When calling C<validated_hash> or C<pos_validated_list> the extra parameters
 409 are simply returned in the hash or list as appropriate. However, when you call
 410 C<validated_list> the extra parameters will not be returned at all. You can
 411 get them by looking at the original value of C<@_>.
 412
 413 =head1 EXPORTS
 414
 415 By default, this module exports the C<validated_hash>,
 416 C<validated_list>, and C<pos_validated_list>.
 417
 418 If you would prefer to import the now deprecated functions C<validate>
 419 and C<validatep> instead, you can use the C<:deprecated> tag to import
 420 them.
 421
 422 =head1 IMPORTANT NOTE ON CACHING
 423
 424 When a validation subroutine is called the first time, the parameter spec is
 425 prepared and cached to avoid unnecessary regeneration. It uses the fully
 426 qualified name of the subroutine (package + subname) as the cache key.  In
 427 99.999% of the use cases for this module, that will be the right thing to do.
 428
 429 However, I have (ab)used this module occasionally to handle dynamic
 430 sets of parameters. In this special use case you can do a couple
 431 things to better control the caching behavior.
 432
 433 =over 4
 434
 435 =item *
 436
 437 Passing in the C<MX_PARAMS_VALIDATE_NO_CACHE> flag in the parameter
 438 spec this will prevent the parameter spec from being cached.
 439
 440   sub foo {
 441       my ( $self, %params ) = validated_hash(
 442           \@_,
 443           foo                         => { isa => 'Foo' },
 444           MX_PARAMS_VALIDATE_NO_CACHE => 1,
 445       );
 446
 447   }
 448
 449 =item *
 450
 451 Passing in C<MX_PARAMS_VALIDATE_CACHE_KEY> with a value to be used as
 452 the cache key will bypass the normal cache key generation.
 453
 454   sub foo {
 455       my ( $self, %params ) = validated_hash(
 456           \@_,
 457           foo                          => { isa => 'Foo' },
 458           MX_PARAMS_VALIDATE_CACHE_KEY => 'foo-42',
 459       );
 460
 461   }
 462
 463 =back
 464
 465 =head1 BUGS
 466
 467 All complex software has bugs lurking in it, and this module is no
 468 exception. If you find a bug please either email me, or add the bug to
 469 cpan-RT.
 470
 471 =head1 AUTHORS
 472
 473 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 474
 475 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 476
 477 =head1 COPYRIGHT AND LICENSE
 478
 479 Copyright 2007-2009 by Infinity Interactive, Inc.
 480
 481 L<http://www.iinteractive.com>
 482
 483 This library is free software; you can redistribute it and/or modify
 484 it under the same terms as Perl itself.
 485
 486 =cut