use Scalar::Util qw( blessed reftype );
use Moose::Exporter;
-our $VERSION = '0.92';
+our $VERSION = '0.95';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
register_type_constraint
match_on_type )
],
- _export_to_main => 1,
);
## --------------------------------------------------------
@methods = @$type_name;
$type_name = undef;
}
+ if ( @methods == 1 && ref $methods[0] eq 'ARRAY' ) {
+ @methods = @{ $methods[0] };
+ }
register_type_constraint(
create_duck_type_constraint(
@values = @$type_name;
$type_name = undef;
}
+ if ( @values == 1 && ref $values[0] eq 'ARRAY' ) {
+ @values = @{ $values[0] };
+ }
( scalar @values >= 2 )
|| __PACKAGE__->_throw_error(
"You must have at least two values to enumerate through");
use re "eval";
my $valid_chars = qr{[\w:\.]};
- my $type_atom = qr{ $valid_chars+ };
+ my $type_atom = qr{ (?>$valid_chars+) }x;
+ my $ws = qr{ (?>\s*) }x;
my $any;
- my $type = qr{ $valid_chars+ (?: \[ \s* (??{$any}) \s* \] )? }x;
+ my $type = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x;
my $type_capture_parts
- = qr{ ($valid_chars+) (?: \[ \s* ((??{$any})) \s* \] )? }x;
+ = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x;
my $type_with_parameter
- = qr{ $valid_chars+ \[ \s* (??{$any}) \s* \] }x;
+ = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x;
- my $op_union = qr{ \s* \| \s* }x;
- my $union = qr{ $type (?: $op_union $type )+ }x;
+ my $op_union = qr{ $ws \| $ws }x;
+ my $union = qr{ $type (?> (?: $op_union $type )+ ) }x;
$any = qr{ $type | $union }x;
subtype 'Ref' => as 'Defined' => where { ref($_) } =>
optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
-subtype 'Str' => as 'Value' => where {1} =>
+subtype 'Str' => as 'Value' => where { ref(\$_) eq 'SCALAR' } =>
optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
subtype 'Num' => as 'Str' =>
Undef
Defined
Value
- Num
- Int
Str
+ Num
+ Int
ClassName
RoleName
Ref
Creates a type constraint for either C<undef> or something of the
given type.
-=item B<duck_type ($name, @methods)>
+=item B<duck_type ($name, \@methods)>
This will create a subtype of Object and test to make sure the value
-C<can()> do the methods in C<@methods>.
+C<can()> do the methods in C<\@methods>.
This is intended as an easy way to accept non-Moose objects that
provide a certain interface. If you're using Moose classes, we
=item B<duck_type (\@methods)>
-If passed an ARRAY reference instead of the C<$name>, C<@methods>
-pair, this will create an unnamed duck type. This can be used in an
-attribute definition like so:
+If passed an ARRAY reference as the only parameter instead of the
+C<$name>, C<\@methods> pair, this will create an unnamed duck type.
+This can be used in an attribute definition like so:
has 'cache' => (
is => 'ro',
isa => duck_type( [qw( get_set )] ),
);
-=item B<enum ($name, @values)>
+=item B<enum ($name, \@values)>
This will create a basic subtype for a given set of strings.
The resulting constraint will be a subtype of C<Str> and
-will match any of the items in C<@values>. It is case sensitive.
+will match any of the items in C<\@values>. It is case sensitive.
See the L<SYNOPSIS> for a simple example.
B<NOTE:> This is not a true proper enum type, it is simply
=item B<enum (\@values)>
-If passed an ARRAY reference instead of the C<$name>, C<@values> pair,
-this will create an unnamed enum. This can then be used in an attribute
-definition like so:
+If passed an ARRAY reference as the only parameter instead of the
+C<$name>, C<\@values> pair, this will create an unnamed enum. This
+can then be used in an attribute definition like so:
has 'sort_order' => (
is => 'ro',
=item B<< match_on_type $value => ( $type => \&action, ... ?\&default ) >>
-This is a utility function for doing simple type based dispatching
-similar to match/case in O'Caml and case/of in Haskell. It does not
-claim to be as featureful as either of those and does not support any
-kind of automatic destructuring bind. However it is suitable for a fair
-amount of your dispatching needs, for instance, here is a simple
-Perl pretty printer dispatching over the core Moose types.
+This is a utility function for doing simple type based dispatching similar to
+match/case in OCaml and case/of in Haskell. It is not as featureful as those
+languages, nor does not it support any kind of automatic destructuring
+bind. Here is a simple Perl pretty printer dispatching over the core Moose
+types.
sub ppprint {
my $x = shift;
- match_on_type $x =>
- HashRef => sub {
+ match_on_type $x => (
+ HashRef => sub {
my $hash = shift;
- '{ ' . (join ", " => map {
- $_ . ' => ' . ppprint( $hash->{ $_ } )
- } sort keys %$hash ) . ' }' },
- ArrayRef => sub {
+ '{ '
+ . (
+ join ", " => map { $_ . ' => ' . ppprint( $hash->{$_} ) }
+ sort keys %$hash
+ ) . ' }';
+ },
+ ArrayRef => sub {
my $array = shift;
- '[ '.(join ", " => map { ppprint( $_ ) } @$array ).' ]' },
- CodeRef => sub { 'sub { ... }' },
- RegexpRef => sub { 'qr/' . $_ . '/' },
- GlobRef => sub { '*' . B::svref_2object($_)->NAME },
+ '[ ' . ( join ", " => map { ppprint($_) } @$array ) . ' ]';
+ },
+ CodeRef => sub {'sub { ... }'},
+ RegexpRef => sub { 'qr/' . $_ . '/' },
+ GlobRef => sub { '*' . B::svref_2object($_)->NAME },
Object => sub { $_->can('to_string') ? $_->to_string : $_ },
- ScalarRef => sub { '\\' . ppprint( ${$_} ) },
- Num => sub { $_ },
- Str => sub { '"'. $_ . '"' },
- Undef => sub { 'undef' },
- => sub { die "I don't know what $_ is" };
+ ScalarRef => sub { '\\' . ppprint( ${$_} ) },
+ Num => sub {$_},
+ Str => sub { '"' . $_ . '"' },
+ Undef => sub {'undef'},
+ => sub { die "I don't know what $_ is" }
+ );
}
Or a simple JSON serializer:
sub to_json {
my $x = shift;
- match_on_type $x =>
- HashRef => sub {
+ match_on_type $x => (
+ HashRef => sub {
my $hash = shift;
- '{ ' . (join ", " => map {
- '"' . $_ . '" : ' . to_json( $hash->{ $_ } )
- } sort keys %$hash ) . ' }' },
- ArrayRef => sub {
+ '{ '
+ . (
+ join ", " =>
+ map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) }
+ sort keys %$hash
+ ) . ' }';
+ },
+ ArrayRef => sub {
my $array = shift;
- '[ ' . (join ", " => map { to_json( $_ ) } @$array ) . ' ]' },
- Num => sub { $_ },
- Str => sub { '"'. $_ . '"' },
- Undef => sub { 'null' },
- => sub { die "$_ is not acceptable json type" };
+ '[ ' . ( join ", " => map { to_json($_) } @$array ) . ' ]';
+ },
+ Num => sub {$_},
+ Str => sub { '"' . $_ . '"' },
+ Undef => sub {'null'},
+ => sub { die "$_ is not acceptable json type" }
+ );
}
-Based on a mapping of C<$type> to C<\&action>, where C<$type> can be
-either a string type or a L<Moose::Meta::TypeConstraint> object, and
-C<\&action> is a CODE ref, this function will dispatch on the first
-match for C<$value>. It is possible to have a catch-all at the end
-in the form of a C<\&default> CODE ref.
+The matcher is done by mapping a C<$type> to an C<\&action>. The C<$type> can
+be either a string type or a L<Moose::Meta::TypeConstraint> object, and
+C<\&action> is a subroutine reference. This function will dispatch on the
+first match for C<$value>. It is possible to have a catch-all by providing an
+additional subroutine reference as the final argument to C<match_on_type>.
=back
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
+See L<Moose/BUGS> for details on reporting bugs.
=head1 AUTHOR
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
projects / gitmo/Moose.git / blobdiff