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