Revision history for Perl extension Moose
-0.04
+0.03_01
* Moose::Cookbook
- - added new Role recipe
+ - added new Role recipe (no content yet, only code)
* Moose
- added 'with' keyword for Role support
* Moose::Role
- Roles for Moose
- added test and docs
+
+ * Moose::Util::TypeConstraints
+ - added the message keyword to add custom
+ error messages to type constraints
* Moose::Meta::Role
- the meta role to support Moose::Role
- moved the attribute option macros here
instead of putting them in Moose.pm
+ * Moose::Meta::TypeConstraint
+ - added the message attributes and the
+ validate method
+ - added tests and docs for this
+
0.03 Thurs. March 30, 2006
* Moose::Cookbook
- added the Moose::Cookbook with 5 recipes,
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use lib './lib';
-
-use Moose;
-
-=pod
-
-=head1 ROADMAP
-
-This is the roadmap for the moosedoc utility. It is just a rough
-sketch of what I am thinking for this.
-
-First question, should it be source-file oriented? or class oriented?
-
-In other words, should I have to do this:
-
- > moosedoc --target ./my_project/lib/
-
-And have moosedoc traverse the ./my_project/lib/ directory looking for
-.pm files, loading each one and then creating a .pod for it based on the
-moose introspection?
-
-Or should it do this:
-
- > moosedoc --target ./my_project/script.pl
-
-And have moosedoc then ask Moose what classes/types/subtypes/etc. I
-loaded, and create some kind of .pod for them?
-
-Second question, should I create a large source repository like javadoc?
-or should it just be a file-per-file thing?
-
-If I do it like javadoc, then I would need an index file, a frameset, a
-file for all types/subtypes made, one for all classes, one for all roles,
-etc. At that point, POD may not make sense, and we are into pure HTML
-(for the hyperlinking of course). This then restricts the type of output.
-
-Hmmm,.. gotta do some thinking.
-
-=cut
use strict;
use warnings;
-our $VERSION = '0.04';
+our $VERSION = '0.03_01';
use Scalar::Util 'blessed', 'reftype';
use Carp 'confess';
=item B<with ($role)>
-This will apply a given C<$role> to the local class.
+This will apply a given C<$role> to the local class. Role support is
+currently very experimental, see L<Moose::Role> for more details.
=item B<has ($name, %options)>
use Sub::Name 'subname';
use Carp 'confess';
-our $VERSION = '0.01';
+our $VERSION = '0.02';
__PACKAGE__->meta->add_attribute('name' => (reader => 'name' ));
__PACKAGE__->meta->add_attribute('parent' => (reader => 'parent' ));
__PACKAGE__->meta->add_attribute('constraint' => (reader => 'constraint'));
+__PACKAGE__->meta->add_attribute('message' => (
+ accessor => 'message',
+ predicate => 'has_message'
+));
__PACKAGE__->meta->add_attribute('coercion' => (
accessor => 'coercion',
predicate => 'has_coercion'
sub check { $_[0]->_compiled_type_constraint->($_[1]) }
+sub validate {
+ my ($self, $value) = @_;
+ if ($self->_compiled_type_constraint->($value)) {
+ return undef;
+ }
+ else {
+ if ($self->has_message) {
+ local $_ = $value;
+ return $self->message->($value);
+ }
+ else {
+ return "Validation failed for '" . $self->name . "' failed.";
+ }
+ }
+}
+
1;
__END__
=item B<compile_type_constraint>
-=item B<check>
+=item B<check ($value)>
+
+This method will return a true (C<1>) if the C<$value> passes the
+constraint, and false (C<0>) otherwise.
+
+=item B<validate ($value)>
+
+This method is similar to C<check>, but it deals with the error
+message. If the C<$value> passes the constraint, C<undef> will be
+returned. If the C<$value> does B<not> pass the constraint, then
+the C<message> will be used to construct a custom error message.
=item B<name>
=item B<constraint>
+=item B<has_message>
+
+=item B<message>
+
=item B<has_coercion>
=item B<coercion>
Moose::Role - The Moose Role
+=head1 SYNOPSIS
+
+ package Eq;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ sub equal { confess "equal must be implemented" }
+
+ sub no_equal {
+ my ($self, $other) = @_;
+ !$self->equal($other);
+ }
+
+ # ... then in your classes
+
+ package Currency;
+ use strict;
+ use warnings;
+ use Moose;
+
+ with 'Eq';
+
+ sub equal {
+ my ($self, $other) = @_;
+ $other->as_float == $other->as_float;
+ }
+
=head1 DESCRIPTION
-=head1 METHODS
+This is currently a very early release of Perl 6 style Roles for
+Moose, it should be considered experimental and incomplete.
+
+This feature is being actively developed, but $work is currently
+preventing me from paying as much attention to it as I would like.
+So I am releasing it in hopes people will help me on this I<hint hint>.
+
+If you are interested in helping, please come to #moose on irc.perl.org
+and we can talk.
+
+=head1 CAVEATS
+
+Currently, the role support has a number of caveats. They are as follows:
=over 4
+=item *
+
+There is no support for Roles consuming other Roles. The details of this
+are not totally worked out yet, but it will mostly follow what is set out
+in the Perl 6 Synopsis 12.
+
+=item *
+
+At this time classes I<can> consume more than one Role, but they are simply
+applied one after another in the order you ask for them. This is incorrect
+behavior, the roles should be merged first, and conflicts determined, etc.
+However, if your roles do not have any conflicts, then things will work just
+fine.
+
+=item *
+
+I want to have B<required> methods, which is unlike Perl 6 roles, and more
+like the original Traits on which roles are based. This would be similar
+in behavior to L<Class::Trait>. These are not yet implemented or course.
+
+=item *
+
+Roles cannot use the C<extends> keyword, it will throw an exception for now.
+The same is true of the C<augment> and C<inner> keywords (not sure those
+really make sense for roles). All other Moose keywords will be I<deferred>
+so that they can be applied to the consuming class.
+
=back
+Basically thats all I can think of for now, I am sure there are more though.
+
=head1 BUGS
All complex software has bugs lurking in it, and this module is no
my $pkg = shift || caller();
return if $pkg eq '-no-export';
no strict 'refs';
- foreach my $export (qw(type subtype as where coerce from via find_type_constraint)) {
+ foreach my $export (qw(type subtype as where message coerce from via find_type_constraint)) {
*{"${pkg}::${export}"} = \&{"${export}"};
}
}
sub find_type_constraint { $TYPES{$_[0]}->[1] }
sub _create_type_constraint {
- my ($name, $parent, $check) = @_;
+ my ($name, $parent, $check, $message) = @_;
my $pkg_defined_in = scalar(caller(1));
($TYPES{$name}->[0] eq $pkg_defined_in)
|| confess "The type constraint '$name' has already been created"
my $constraint = Moose::Meta::TypeConstraint->new(
name => $name || '__ANON__',
parent => $parent,
- constraint => $check,
+ constraint => $check,
+ message => $message,
);
$TYPES{$name} = [ $pkg_defined_in, $constraint ] if defined $name;
return $constraint;
_create_type_constraint($name, undef, $check);
}
-sub subtype ($$;$) {
- unshift @_ => undef if scalar @_ == 2;
+sub subtype ($$;$$) {
+ unshift @_ => undef if scalar @_ <= 2;
_create_type_constraint(@_);
}
_install_type_coercions($type_name, \@coercion_map);
}
-sub as ($) { $_[0] }
-sub from ($) { $_[0] }
-sub where (&) { $_[0] }
-sub via (&) { $_[0] }
+sub as ($) { $_[0] }
+sub from ($) { $_[0] }
+sub where (&) { $_[0] }
+sub via (&) { $_[0] }
+sub message (&) { $_[0] }
# define some basic types
type 'Any' => where { 1 };
-type 'Value' => where { !ref($_) };
-type 'Ref' => where { ref($_) };
+subtype 'Value' => as 'Any' => where { !ref($_) };
+subtype 'Ref' => as 'Any' => where { ref($_) };
subtype 'Int' => as 'Value' => where { Scalar::Util::looks_like_number($_) };
subtype 'Str' => as 'Value' => where { !Scalar::Util::looks_like_number($_) };
This is just sugar for the type constraint construction syntax.
+=item B<message>
+
+This is just sugar for the type constraint construction syntax.
+
=back
=head2 Type Coercion Constructors
use strict;
use warnings;
-use Test::More tests => 17;
+use Test::More tests => 25;
use Test::Exception;
use Scalar::Util ();
subtype NaturalLessThanTen
=> as Natural
- => where { $_ < 10 };
+ => where { $_ < 10 }
+ => message { "The number '$_' is not less than 10" };
Moose::Util::TypeConstraints->export_type_contstraints_as_functions();
ok(!defined($negative->check(5)), '... this is not a negative number');
is($negative->check('Foo'), undef, '... this is not a negative number');
+# check some meta-details
+
+my $natural_less_than_ten = find_type_constraint('NaturalLessThanTen');
+isa_ok($natural_less_than_ten, 'Moose::Meta::TypeConstraint');
+
+ok($natural_less_than_ten->has_message, '... it has a message');
+
+ok(!defined($natural_less_than_ten->validate(5)), '... validated successfully (no error)');
+
+is($natural_less_than_ten->validate(15),
+ "The number '15' is not less than 10",
+ '... validated unsuccessfully (got error)');
+
+my $natural = find_type_constraint('Natural');
+isa_ok($natural, 'Moose::Meta::TypeConstraint');
+
+ok(!$natural->has_message, '... it does not have a message');
+
+ok(!defined($natural->validate(5)), '... validated successfully (no error)');
+
+is($natural->validate(-5),
+ "Validation failed for 'Natural' failed.",
+ '... validated unsuccessfully (got error)');
projects / gitmo/Moose.git / commitdiff