diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm index 18b7ec1..dc31a91 100644 --- a/lib/Class/Tiny.pm +++ b/lib/Class/Tiny.pm @@ -31,7 +31,7 @@ sub prepare_class { sub create_attributes { my ( $class, $pkg, @spec ) = @_; my %defaults = map { ref $_ eq 'HASH' ? %$_ : ( $_ => undef ) } @spec; - my @attr = grep { + my @attr = grep { defined and !ref and /^[^\W\d]\w*$/s or Carp::croak "Invalid accessor name '$_'" } keys %defaults; @@ -140,7 +140,7 @@ my $_PRECACHE = sub { }; sub new { - my $class = shift; + my $class = shift; my $valid_attrs = $ATTR_CACHE{$class} || $_PRECACHE->($class); # handle hash ref or key/value arguments @@ -458,6 +458,18 @@ and various subroutine references are cached for speed. Ensure that all inheritance and methods are in place before creating objects. (You don't want to be changing that once you create objects anyway, right?) +=head2 Type constraints (C relationships) + +Class::Tiny does not natively apply type constraints to any attributes. +For example, there is no equivalent of the Moose C (e.g., +C<< has 'birth_date' => ( isa => 'DateTime'); >>). You can apply constraints +manually by providing custom accessors (see L). + +One shortcut is separately-distributed package +L. This package can create a custom accessor +that will apply a L, L, L, +L, or L type constraint. + =head1 RATIONALE =head2 Why this instead of Object::Tiny or Class::Accessor or something else? diff --git a/t/alfa.t b/t/alfa.t index b293590..5babe43 100644 --- a/t/alfa.t +++ b/t/alfa.t @@ -46,7 +46,7 @@ subtest "both attributes set as hash ref" => sub { subtest "constructor makes shallow copy" => sub { my $fake = bless { foo => 23, bar => 42 }, "Fake"; - my $obj = new_ok( "Alfa", [$fake] ); + my $obj = new_ok( "Alfa", [$fake] ); is( ref $fake, "Fake", "object passed to constructor is original class" ); is( $obj->foo, 23, "foo is set" ); is( $obj->bar, 42, "bar is set" ); diff --git a/t/hotel.t b/t/hotel.t index 543d6d9..c7db858 100644 --- a/t/hotel.t +++ b/t/hotel.t @@ -11,7 +11,7 @@ require_ok("Hotel"); subtest "attribute list" => sub { my $attributes = [ sort Class::Tiny->get_all_attributes_for("Hotel") ]; is_deeply( - $attributes, + $attributes, [ sort qw/foo bar wibble wobble zig zag/ ], "attribute list correct", ) or diag explain $attributes; @@ -19,17 +19,17 @@ subtest "attribute list" => sub { subtest "attribute defaults" => sub { my $def = Class::Tiny->get_all_attribute_defaults_for("Hotel"); - is( keys %$def, 6, "defaults hashref size" ); - is( $def->{foo}, undef, "foo default is undef" ); - is( $def->{bar}, undef, "bar default is undef" ); - is( $def->{wibble}, 23, "wibble default overrides" ); + is( keys %$def, 6, "defaults hashref size" ); + is( $def->{foo}, undef, "foo default is undef" ); + is( $def->{bar}, undef, "bar default is undef" ); + is( $def->{wibble}, 23, "wibble default overrides" ); }; subtest "attribute set as list" => sub { my $obj = new_ok( "Hotel", [ foo => 42, bar => 23 ] ); - is( $obj->foo, 42, "foo is set" ); - is( $obj->bar, 23, "bar is set" ); - is( $obj->wibble, 23, "wibble is set" ); + is( $obj->foo, 42, "foo is set" ); + is( $obj->bar, 23, "bar is set" ); + is( $obj->wibble, 23, "wibble is set" ); is( ref $obj->wobble, 'HASH', "wobble default overrides" ); }; diff --git a/t/lib/Foxtrot.pm b/t/lib/Foxtrot.pm index b757d47..1f955eb 100644 --- a/t/lib/Foxtrot.pm +++ b/t/lib/Foxtrot.pm @@ -5,6 +5,9 @@ use warnings; package Foxtrot; use Class::Tiny 'foo'; -use Class::Tiny { bar => 42, baz => sub { time } }; +use Class::Tiny { + bar => 42, + baz => sub { time } +}; 1; diff --git a/t/lib/Golf.pm b/t/lib/Golf.pm index 5e07438..d522463 100644 --- a/t/lib/Golf.pm +++ b/t/lib/Golf.pm @@ -4,9 +4,11 @@ use warnings; package Golf; -use Class::Tiny qw/foo bar/, { +use Class::Tiny qw/foo bar/, + { wibble => 42, wobble => sub { [] }, -}, qw/zig zag/; + }, + qw/zig zag/; 1; diff --git a/t/lib/TestUtils.pm b/t/lib/TestUtils.pm index c66b8b3..7f03bf1 100644 --- a/t/lib/TestUtils.pm +++ b/t/lib/TestUtils.pm @@ -1,14 +1,15 @@ use 5.006; use strict; use warnings; + package TestUtils; use Carp; use Exporter; -our @ISA = qw/Exporter/; +our @ISA = qw/Exporter/; our @EXPORT = qw( - exception + exception ); # If we have Test::FailWarnings, use it @@ -17,9 +18,9 @@ BEGIN { } sub exception(&) { - my $code = shift; + my $code = shift; my $success = eval { $code->(); 1 }; - my $err = $@; + my $err = $@; return '' if $success; croak "Execution died, but the error was lost" unless $@; return $@;