+package Moose::Cookbook::Basics::Recipe1;
-=pod
+# ABSTRACT: The (always classic) B<Point> example.
+
+__END__
-=head1 NAME
-Moose::Cookbook::Basics::Recipe1 - The (always classic) B<Point> example.
+=pod
=head1 SYNOPSIS
$self->z(0);
};
- ....
+ package main;
# hash or hashrefs are ok for the constructor
my $point1 = Point->new(x => 5, y => 7);
constraint for C<Int> (1). The accessor generated for this attribute
will be read-write.
-The C<< requires => 1 >> parameter means that this attribute must be
+The C<< required => 1 >> parameter means that this attribute must be
provided when a new object is created. A point object without
coordinates doesn't make much sense, so we don't allow it.
From here on, we can use C<$point> and C<$point3d> just as you would
any other Perl 5 object. For a more detailed example of what can be
-done, you can refer to the F<t/000_recipes/basic/001_point.t> test
-file.
+done, you can refer to the
+F<t/recipes/moose_cookbook_basics_recipe1.t> test file.
=head2 Moose Objects are Just Hashrefs
=head1 CONCLUSION
-This recipe demonstrates some basic Moose concepts. The next recipe
-will build upon the basics shown here with more complex attributes and
-methods. Please read on :)
+This recipe demonstrates some basic Moose concepts, attributes,
+subclassing, and a simple method modifier.
=head1 FOOTNOTES
=item (1)
-Moose provides a number of builtin type constraints are provided by,
-of which C<Int> is one. For more information on the type constraint
-system, see L<Moose::Util::TypeConstraints>.
+Moose provides a number of builtin type constraints, of which C<Int>
+is one. For more information on the type constraint system, see
+L<Moose::Util::TypeConstraints>.
=item (2)
-The C<extends> keyword support multiple inheritance. Simply pass all
+The C<extends> keyword supports multiple inheritance. Simply pass all
of your superclasses to C<extends> as a list:
extends 'Foo', 'Bar', 'Baz';
=item (3)
Moose supports using instance structures other than blessed hash
-references (such as in a glob reference - see
-L<MooseX::GlobRef::Object>).
+references (such as glob references - see L<MooseX::GlobRef>).
=back
=item Method Modifiers
-The concept of method modifiers is directly ripped off from CLOS. A
+The concept of method modifiers is directly ripped off from CLOS. A
great explanation of them can be found by following this link.
L<http://www.gigamonkeys.com/book/object-reorientation-generic-functions.html>
=back
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2008 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.
+=begin testing
+
+my $point = Point->new( x => 1, y => 2 );
+isa_ok( $point, 'Point' );
+isa_ok( $point, 'Moose::Object' );
+
+is( $point->x, 1, '... got the right value for x' );
+is( $point->y, 2, '... got the right value for y' );
+
+$point->y(10);
+is( $point->y, 10, '... got the right (changed) value for y' );
+
+isnt(
+ exception {
+ $point->y('Foo');
+ },
+ undef,
+ '... cannot assign a non-Int to y'
+);
+
+isnt(
+ exception {
+ Point->new();
+ },
+ undef,
+ '... must provide required attributes to new'
+);
+
+$point->clear();
+
+is( $point->x, 0, '... got the right (cleared) value for x' );
+is( $point->y, 0, '... got the right (cleared) value for y' );
+
+# check the type constraints on the constructor
+
+is(
+ exception {
+ Point->new( x => 0, y => 0 );
+ },
+ undef,
+ '... can assign a 0 to x and y'
+);
+
+isnt(
+ exception {
+ Point->new( x => 10, y => 'Foo' );
+ },
+ undef,
+ '... cannot assign a non-Int to y'
+);
+
+isnt(
+ exception {
+ Point->new( x => 'Foo', y => 10 );
+ },
+ undef,
+ '... cannot assign a non-Int to x'
+);
+
+# Point3D
+
+my $point3d = Point3D->new( { x => 10, y => 15, z => 3 } );
+isa_ok( $point3d, 'Point3D' );
+isa_ok( $point3d, 'Point' );
+isa_ok( $point3d, 'Moose::Object' );
+
+is( $point3d->x, 10, '... got the right value for x' );
+is( $point3d->y, 15, '... got the right value for y' );
+is( $point3d->{'z'}, 3, '... got the right value for z' );
+
+$point3d->clear();
+
+is( $point3d->x, 0, '... got the right (cleared) value for x' );
+is( $point3d->y, 0, '... got the right (cleared) value for y' );
+is( $point3d->z, 0, '... got the right (cleared) value for z' );
+
+isnt(
+ exception {
+ Point3D->new( x => 10, y => 'Foo', z => 3 );
+ },
+ undef,
+ '... cannot assign a non-Int to y'
+);
+
+isnt(
+ exception {
+ Point3D->new( x => 'Foo', y => 10, z => 3 );
+ },
+ undef,
+ '... cannot assign a non-Int to x'
+);
+
+isnt(
+ exception {
+ Point3D->new( x => 0, y => 10, z => 'Bar' );
+ },
+ undef,
+ '... cannot assign a non-Int to z'
+);
+
+isnt(
+ exception {
+ Point3D->new( x => 10, y => 3 );
+ },
+ undef,
+ '... z is a required attribute for Point3D'
+);
+
+# test some class introspection
+
+can_ok( 'Point', 'meta' );
+isa_ok( Point->meta, 'Moose::Meta::Class' );
+
+can_ok( 'Point3D', 'meta' );
+isa_ok( Point3D->meta, 'Moose::Meta::Class' );
+
+isnt(
+ Point->meta, Point3D->meta,
+ '... they are different metaclasses as well'
+);
+
+# poke at Point
+
+is_deeply(
+ [ Point->meta->superclasses ],
+ ['Moose::Object'],
+ '... Point got the automagic base class'
+);
+
+my @Point_methods = qw(meta x y clear);
+my @Point_attrs = ( 'x', 'y' );
+
+is_deeply(
+ [ sort @Point_methods ],
+ [ sort Point->meta->get_method_list() ],
+ '... we match the method list for Point'
+);
+
+is_deeply(
+ [ sort @Point_attrs ],
+ [ sort Point->meta->get_attribute_list() ],
+ '... we match the attribute list for Point'
+);
+
+foreach my $method (@Point_methods) {
+ ok( Point->meta->has_method($method),
+ '... Point has the method "' . $method . '"' );
+}
+
+foreach my $attr_name (@Point_attrs) {
+ ok( Point->meta->has_attribute($attr_name),
+ '... Point has the attribute "' . $attr_name . '"' );
+ my $attr = Point->meta->get_attribute($attr_name);
+ ok( $attr->has_type_constraint,
+ '... Attribute ' . $attr_name . ' has a type constraint' );
+ isa_ok( $attr->type_constraint, 'Moose::Meta::TypeConstraint' );
+ is( $attr->type_constraint->name, 'Int',
+ '... Attribute ' . $attr_name . ' has an Int type constraint' );
+}
+
+# poke at Point3D
+
+is_deeply(
+ [ Point3D->meta->superclasses ],
+ ['Point'],
+ '... Point3D gets the parent given to it'
+);
+
+my @Point3D_methods = qw( meta z clear );
+my @Point3D_attrs = ('z');
+
+is_deeply(
+ [ sort @Point3D_methods ],
+ [ sort Point3D->meta->get_method_list() ],
+ '... we match the method list for Point3D'
+);
+
+is_deeply(
+ [ sort @Point3D_attrs ],
+ [ sort Point3D->meta->get_attribute_list() ],
+ '... we match the attribute list for Point3D'
+);
+
+foreach my $method (@Point3D_methods) {
+ ok( Point3D->meta->has_method($method),
+ '... Point3D has the method "' . $method . '"' );
+}
+
+foreach my $attr_name (@Point3D_attrs) {
+ ok( Point3D->meta->has_attribute($attr_name),
+ '... Point3D has the attribute "' . $attr_name . '"' );
+ my $attr = Point3D->meta->get_attribute($attr_name);
+ ok( $attr->has_type_constraint,
+ '... Attribute ' . $attr_name . ' has a type constraint' );
+ isa_ok( $attr->type_constraint, 'Moose::Meta::TypeConstraint' );
+ is( $attr->type_constraint->name, 'Int',
+ '... Attribute ' . $attr_name . ' has an Int type constraint' );
+}
+
+=end testing
=cut
projects / gitmo/Moose.git / blobdiff