Permalink
Browse files

Tests and docs for return value validation

  • Loading branch information...
1 parent 2e7b5f0 commit 33f4bf8969261d057f4ee5b158ea9f33ab0977d9 Peter Shangov committed Jan 25, 2012
Showing with 164 additions and 103 deletions.
  1. +6 −0 Changes
  2. +41 −41 dist.ini
  3. +61 −54 lib/MooseX/Params.pm
  4. +55 −7 lib/MooseX/Params/Util.pm
  5. +1 −1 t/11-returns_scalar.t
View
@@ -1,5 +1,11 @@
Revision history for MooseX-Params
+0.008 25/01/2011
+ * Add return value validation
+
+0.007 17/01/2011
+ * Mitigation of incompatibility with Moose 2.0401
+
0.006 11/01/2011
* Switch from Attribute::Handlers to Attribute::Lexical
* Set minimum Moose version requirement
View
@@ -1,41 +1,41 @@
-name = MooseX-Params
-author = Peter Shangov <pshangov@yahoo.com>
-license = Perl_5
-copyright_holder = Peter Shangov
-version = 0.006
-abstract = Parameters with meta, laziness and %_
-
-[GatherDir]
-[PruneCruft]
-[ManifestSkip]
-[MetaYAML]
-[License]
-[ExtraTests]
-[ExecDir]
-[ShareDir]
-[MakeMaker]
-[Manifest]
-[TestRelease]
-[ConfirmRelease]
-[UploadToCPAN]
-[PodSyntaxTests]
-[AutoPrereqs]
-skip = TestParent
-[PkgVersion]
-;Make fails under Win32
-;[CheckChangesTests]
-[Test::Compile]
-[Bugtracker]
-[ReadmeFromPod]
-[GithubMeta]
-[PodWeaver]
-;Test::Spelling 0.12 no longer works on Win32
-;[PodSpellingTests]
-[EOLTests]
-[NoTabsTests]
-[PruneFiles]
-match = ^docs/*
-filename = TODO.mkd
-[Prereqs]
-Package::Stash = 0.18
-Moose = 1.24
+name = MooseX-Params
+author = Peter Shangov <pshangov@yahoo.com>
+license = Perl_5
+copyright_holder = Peter Shangov
+version = 0.008
+abstract = Parameters with meta, laziness and %_
+
+[GatherDir]
+[PruneCruft]
+[ManifestSkip]
+[MetaYAML]
+[License]
+[ExtraTests]
+[ExecDir]
+[ShareDir]
+[MakeMaker]
+[Manifest]
+[TestRelease]
+[ConfirmRelease]
+[UploadToCPAN]
+[PodSyntaxTests]
+[AutoPrereqs]
+skip = TestParent
+[PkgVersion]
+;Make fails under Win32
+;[CheckChangesTests]
+[Test::Compile]
+[Bugtracker]
+[ReadmeFromPod]
+[GithubMeta]
+[PodWeaver]
+;Test::Spelling 0.12 no longer works on Win32
+;[PodSpellingTests]
+[EOLTests]
+[NoTabsTests]
+[PruneFiles]
+match = ^docs/*
+filename = TODO.mkd
+[Prereqs]
+Package::Stash = 0.18
+Moose = 1.24
View
@@ -6,12 +6,7 @@ use strict;
use warnings;
use 5.010;
use MooseX::Params::Util;
-use MooseX::Params::Meta::Method;
use MooseX::Params::TypeConstraints;
-use Moose::Meta::Class;
-use Moose::Util::TypeConstraints qw();
-use Sub::Identify qw(sub_name);
-use Sub::Mutate qw(when_sub_bodied);
use Carp qw(croak);
sub import
@@ -21,7 +16,8 @@ sub import
my @handlers;
foreach my $attribute (@attrs)
{
- push @handlers, "CODE:$attribute", _prepare_handler($attribute);
+ push @handlers, "CODE:$attribute",
+ MooseX::Params::Util::prepare_attribute_handler($attribute);
}
require Attribute::Lexical;
@@ -64,53 +60,6 @@ sub ReturnsScalar
$method->returns_scalar($data);
}
-
-### PRIVATE FUNCTIONS ###
-
-sub _prepare_handler
-{
- my $handler = Moose::Meta::Class->initialize(__PACKAGE__)
- ->get_method(shift)
- ->body;
-
- return sub
- {
- my ($symbol, $attr, $data, $caller) = @_;
-
- my ($package, $filename, $line, $subroutine, $hasargs, $wantarray,
- $evaltext, $is_require, $hints, $bitmask, $hinthash) = @$caller;
-
- when_sub_bodied ( $symbol, sub
- {
- my $coderef = shift;
- my $name = sub_name($coderef);
-
- croak "MooseX::Params currently does not support anonymous subroutines"
- if $name eq "__ANON__";
-
- my $metaclass = Moose::Meta::Class->initialize($package);
- my $method = $metaclass->get_method($name);
-
- unless ( $method->isa('MooseX::Params::Meta::Method') )
- {
- my $wrapped_coderef = MooseX::Params::Util::wrap_method($package, $name, $coderef);
-
- my $wrapped_method = MooseX::Params::Meta::Method->wrap(
- $wrapped_coderef,
- name => $name,
- package_name => $package,
- );
-
- $metaclass->add_method($name, $wrapped_method);
-
- $method = $wrapped_method;
- }
-
- return $handler->($method, $data);
- });
- };
-}
-
1;
=pod
@@ -259,6 +208,21 @@ sub _prepare_handler
}
}
+ # return value validation
+ sub sum :Args(a, b) :Returns(Num) { ... }
+
+ # validate non-scalar return values
+ sub get_data :Returns(Array) { qw(foo bar baz) }
+ my ($foo, $bar, $baz) = get_data();
+
+ # force special behavior in sclar context
+ sub get_winners :Returns(Array) :ReturnsScalar(First) {
+ my @ordered_winners = ...;
+ return @ordered_winners;
+ }
+
+ my $first_place = get_winners();
+
# in a class
package User;
@@ -279,7 +243,7 @@ sub _prepare_handler
);
# note the shortcut invocant syntax
- sub login :Args(self: Str pw) {
+ sub login :Args(self: Str pw) :Returns(Bool) {
return 0 if $_{pw} ne $_{self}->password;
$_{self}->last_login( DateTime->now() );
@@ -482,6 +446,49 @@ If C<CheckArgs> is specified without a subroutine name, C<_checkargs_${subname}>
# is equivalent to
sub rank :Args(...) :CheckArgs(_checkargs_rank) { ... }
+=head1 RETURN VALUE VALIDATION
+
+=head2 Returns
+
+C<MooseX::Params> provids a basic mechanism for return value validation via the C<Returns> attribute.
+
+ sub add :Args(a, b) :Returns(Num) { return $_{a} + $_{b} }
+ my $five = add(2,3);
+
+Any Moose type name may be used as an arbument to C<Returns>. If your subroutine returns a list of values, you will need to use the special parametric types C<Array> and C<Hash>. They behave identically to C<ArrayRef> and C<HashRef>, except that they work with lists instead of references:
+
+ sub myreverse :Args(*items) :Returns(Array) { return reverse @{ $_{items} } }
+ my @list = qw(foo bar baz);
+ my @reversed = myreverse(@list);
+
+Note that C<wantarray> inside subroutines that use C<Returns> will always return true (see below).
+
+=head2 ReturnsScalar
+
+Return value validation does not play well with context magic. If you return different values depending on context, validation will break. Therefore, subroutines that use C<Returns> are always evaluated in list context to obrain their return value. The C<ResultScalar> attribute allows you to explicitly change how your subroutine will behave in scalar context. It accepts one of four options:
+
+=over
+
+=item Count (default)
+
+In scalar context return the number of items in the return value list.
+
+=item First
+
+In scalar context return the first item in the return value list.
+
+=item Last
+
+In scalar context return the last item in the return value list.
+
+=item ArrayRef
+
+In scalar context return a reference to the return value list.
+
+=back
+
+ sub results :Returns(Array[MyApp::Object]) :ReturnsScalar(ArrayRef) { ... }
+
=head1 META CLASSES
C<MooseX::Params> provides method and parameter metaroles, please see their sourcecode for details:
View
@@ -11,13 +11,15 @@ use List::Util qw(max first);
use Scalar::Util qw(isweak);
use Perl6::Caller qw(caller);
use B::Hooks::EndOfScope qw(on_scope_end); # magic fails without this, have to find out why ...
-use attributes qw();
+use Sub::Identify qw(sub_name);
+use Sub::Mutate qw(when_sub_bodied);
+use Carp qw(croak);
use Class::MOP::Class;
+use MooseX::Params::Meta::Method;
use Package::Stash;
use Text::CSV_XS;
use MooseX::Params::Meta::Parameter;
use MooseX::Params::Magic::Wizard;
-use Data::Dumper;
# DESCRIPTION: Build a parameter from either a default value or a builder
# USED BY: MooseX::Params::Util::process_args
@@ -67,6 +69,7 @@ sub wrap_method
{
my $meta = Class::MOP::Class->initialize($package_name);
my $method = $meta->get_method($method_name);
+ my $wantarray = wantarray;
local %_;
@@ -85,7 +88,7 @@ sub wrap_method
if ( $method->has_return_value_constraint)
{
- return process_return_values($method, $coderef->(@_));
+ return process_return_values($method, $wantarray, $coderef->(@_));
}
else
{
@@ -277,18 +280,19 @@ sub process_args
sub process_return_values
{
- my ( $method, @values ) = @_;
+ my ( $method, $wantarray, @values ) = @_;
return @values unless $method->has_return_value_constraint;
my $constraint =
Moose::Util::TypeConstraints::find_or_parse_type_constraint(
$method->returns
);
-
- if ( $constraint->is_subtype_of('Array'))
+
+ if ( $constraint->is_a_type_of('Array'))
{
$constraint->assert_valid(\@values);
+ return @values if $wantarray;
given ($method->returns_scalar)
{
@@ -299,9 +303,10 @@ sub process_return_values
default { return @values }
}
}
- elsif ( $constraint->is_subtype_of('Hash') )
+ elsif ( $constraint->is_a_type_of('Hash') )
{
$constraint->assert_valid({@values});
+ return @values if $wantarray;
given ($method->returns_scalar)
{
@@ -459,4 +464,47 @@ sub inflate_parameters
return \%inflated_parameters;
}
+sub prepare_attribute_handler
+{
+ my $handler = Moose::Meta::Class->initialize('MooseX::Params')
+ ->get_method(shift)
+ ->body;
+
+ return sub
+ {
+ my ($symbol, $attr, $data, $caller) = @_;
+
+ my ($package, $filename, $line, $subroutine, $hasargs, $wantarray,
+ $evaltext, $is_require, $hints, $bitmask, $hinthash) = @$caller;
+
+ when_sub_bodied ( $symbol, sub
+ {
+ my $coderef = shift;
+ my $name = sub_name($coderef);
+
+ croak "MooseX::Params currently does not support anonymous subroutines"
+ if $name eq "__ANON__";
+
+ my $metaclass = Moose::Meta::Class->initialize($package);
+ my $method = $metaclass->get_method($name);
+
+ unless ( $method->isa('MooseX::Params::Meta::Method') )
+ {
+ my $wrapped_coderef = MooseX::Params::Util::wrap_method($package, $name, $coderef);
+
+ my $wrapped_method = MooseX::Params::Meta::Method->wrap(
+ $wrapped_coderef,
+ name => $name,
+ package_name => $package,
+ );
+
+ $metaclass->add_method($name, $wrapped_method);
+
+ $method = $wrapped_method;
+ }
+
+ return $handler->($method, $data);
+ });
+ };
+}
1;
View
@@ -31,7 +31,7 @@ is_deeply \@res_last, $foo_bar_baz, 'last in list context';
is_deeply \@res_arrayref, $foo_bar_baz, 'arrayref in list context';
is_deeply \@res_count, $foo_bar_baz, 'count in list context';
-is_deeply $res_default, ['foo'], 'default in scalar context';
+is $res_default, 3, 'default in scalar context';
is $res_first, 'foo', 'first in scalar context';
is $res_last, 'baz', 'last in scalar context';
is_deeply $res_arrayref, $foo_bar_baz, 'arrayref in scalar context';

0 comments on commit 33f4bf8

Please sign in to comment.