use warnings;
use metaclass;
+use B;
use Scalar::Util 'blessed';
use List::MoreUtils qw(all);
use Moose::Util 'english_list';
use Moose::Util::TypeConstraints ();
-our $VERSION = '1.18';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
use base 'Moose::Meta::TypeConstraint';
__PACKAGE__->meta->add_attribute('methods' => (
accessor => 'methods',
));
+my $inliner = sub {
+ my $self = shift;
+ my $val = shift;
+
+ return
+ "Scalar::Util::blessed($val)"
+ . qq{&& Scalar::Util::blessed($val) ne 'Regexp'}
+ . "&& &List::MoreUtils::all( sub { $val->can(\$_) }, "
+ . ( join ', ', map { B::perlstring($_) } @{ $self->methods } ) . ' )';
+};
+
sub new {
my ( $class, %args ) = @_;
- $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object');
+ $args{parent}
+ = Moose::Util::TypeConstraints::find_type_constraint('Object');
+
+ my @methods = @{ $args{methods} };
+ $args{constraint} = sub {
+ blessed( $_[0] ) ne 'Regexp'
+ && all { $_[0]->can($_) } @methods;
+ };
+
+ $args{inlined} = $inliner;
my $self = $class->_new(\%args);
1;
+# ABSTRACT: Type constraint for duck typing
+
__END__
=pod
-=head1 NAME
-
-Moose::Meta::TypeConstraint::DuckType - Type constraint for duck typing
-
=head1 DESCRIPTION
This class represents type constraints based on an enumerated list of
See L<Moose/BUGS> for details on reporting bugs.
-=head1 AUTHOR
-
-Chris Prather E<lt>chris@prather.orgE<gt>
-
-Shawn M Moore E<lt>sartak@gmail.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2010 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
=cut