From: Stevan Little Date: Wed, 3 May 2006 19:13:06 +0000 (+0000) Subject: foo X-Git-Tag: 0_09_03~46 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fcec2383ee10c48530d7b81d3cfd94e23724ca59;p=gitmo%2FMoose.git foo --- diff --git a/lib/Moose.pm b/lib/Moose.pm index a52784c..6917896 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -40,11 +40,21 @@ use Moose::Util::TypeConstraints; my $meta; if ($class->can('meta')) { + # NOTE: + # this is the case where the metaclass pragma + # was used before the 'use Moose' statement to + # override a specific class $meta = $class->meta(); (blessed($meta) && $meta->isa('Moose::Meta::Class')) || confess "Whoops, not møøsey enough"; } else { + # NOTE: + # this is broken currently, we actually need + # to allow the possiblity of an inherited + # meta, which will not be visible until the + # user 'extends' first. This needs to have + # more intelligence to it $meta = Moose::Meta::Class->initialize($class); $meta->add_method('meta' => sub { # re-initialize so it inherits properly diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 1f6e888..5c3cd69 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -15,7 +15,7 @@ use Moose::Meta::TypeCoercion; { require Sub::Exporter; - my @exports = qw[type subtype as where message coerce from via find_type_constraint]; + my @exports = qw[type subtype as where message coerce from via find_type_constraint enum]; Sub::Exporter->import( -setup => { @@ -110,6 +110,16 @@ sub where (&) { $_[0] } sub via (&) { $_[0] } sub message (&) { $_[0] } +sub enum { + my ($type_name, @values) = @_; + my $regexp = join '|' => @values; + _create_type_constraint( + $type_name, + 'Str', + sub { qr/^$regexp$/i } + ); +} + # define some basic types type 'Any' => where { 1 }; # meta-type including all @@ -257,6 +267,8 @@ This creates an unnamed subtype and will return the type constraint meta-object, which will be an instance of L. +=item B + =item B This is just sugar for the type constraint construction syntax. diff --git a/t/008_basic.t b/t/008_basic.t new file mode 100644 index 0000000..cc15071 --- /dev/null +++ b/t/008_basic.t @@ -0,0 +1,343 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 63; +use Test::Exception; + +BEGIN { + use_ok('Moose'); +} + +BEGIN { + + package Newswriter::Meta::Instance; + use strict; + use warnings; + use Moose; + + use DBM::Deep; + + extends 'Moose::Meta::Instance'; + + { + my $instance_counter = -1; + + my $db = DBM::Deep->new({ + file => "newswriter.db", + autobless => 1 + }); + $db->{root} = [] unless exists $db->{root}; + + sub _get_db { $db } + sub _reload_db { + $db = DBM::Deep->new({ + file => "newswriter.db", + autobless => 1 + }) + } + + sub create_instance { + my $self = shift; + $instance_counter++; + $db->{root}->[$instance_counter] = {}; + + $self->bless_instance_structure({ + oid => $instance_counter, + instance => $db->{root}->[$instance_counter] + }); + } + + sub find_instance { + my ($self, $oid) = @_; + my $instance_struct = $db->{root}->[$oid]; + + $self->bless_instance_structure({ + oid => $oid, + instance => $instance_struct + }); + } + } + + sub get_instance_oid { + my ($self, $instance) = @_; + $instance->{oid}; + } + + sub clone_instance { + confess "&clone_instance is left as an exercise for the user"; + } + + sub get_slot_value { + my ($self, $instance, $slot_name) = @_; + return $instance->{instance}->{$slot_name}; + } + + sub set_slot_value { + my ($self, $instance, $slot_name, $value) = @_; + $instance->{instance}->{$slot_name} = $value; + } + + sub is_slot_initialized { + my ($self, $instance, $slot_name, $value) = @_; + exists $instance->{instance}->{$slot_name} ? 1 : 0; + } + + sub weaken_slot_value { + confess "Not sure how well DBM::Deep plays with weak refs, Rob says 'Writer a test'"; + } + + sub inline_slot_access { + my ($self, $instance, $slot_name) = @_; + sprintf "%s->{instance}->{%s}", $instance, $slot_name; + } + + package Newswriter::Meta::Class; + use strict; + use warnings; + use Moose; + + extends 'Moose::Meta::Class'; + + override 'construct_instance' => sub { + my ($class, %params) = @_; + return $class->get_meta_instance->find_instance($params{oid}) + if $params{oid}; + super(); + }; +} + +{ + package Newswriter::Base; + use strict; + use warnings; + use metaclass 'Newswriter::Meta::Class' => ( + ':instance_metaclass' => 'Newswriter::Meta::Instance' + ); + use Moose; + + sub oid { + my $self = shift; + $self->meta + ->get_meta_instance + ->get_instance_oid($self); + } + + package Newswriter::Author; + use strict; + use warnings; + use metaclass 'Newswriter::Meta::Class' => ( + ':instance_metaclass' => 'Newswriter::Meta::Instance' + ); + use Moose; + + extends 'Newswriter::Base'; + + has 'first_name' => (is => 'rw', isa => 'Str'); + has 'last_name' => (is => 'rw', isa => 'Str'); + + package Newswriter::Article; + use strict; + use warnings; + use metaclass 'Newswriter::Meta::Class' => ( + ':instance_metaclass' => 'Newswriter::Meta::Instance' + ); + use Moose; + use Moose::Util::TypeConstraints; + + use DateTime::Format::MySQL; + + use base 'Newswriter::Base'; + + subtype 'Headline' + => as 'Str' + => where { length($_) < 100 }; + + subtype 'Summary' + => as 'Str' + => where { length($_) < 255 }; + + subtype 'DateTimeFormatString' + => as 'Str' + => where { DateTime::Format::MySQL->parse_datetime($_) }; + + enum 'Status' => qw(draft posted pending archive); + + has 'headline' => (is => 'rw', isa => 'Headline'); + has 'summary' => (is => 'rw', isa => 'Summary'); + has 'article' => (is => 'rw', isa => 'Str'); + + has 'start_date' => (is => 'rw', isa => 'DateTimeFormatString'); + has 'end_date' => (is => 'rw', isa => 'DateTimeFormatString'); + + has 'author' => (is => 'rw', isa => 'Newswriter::Author'); + + has 'status' => (is => 'rw', isa => 'Status'); + + around 'start_date', 'end_date' => sub { + my $c = shift; + my $self = shift; + $c->($self, DateTime::Format::MySQL->format_datetime($_[0])) if @_; + DateTime::Format::MySQL->parse_datetime($c->($self)); + }; +} + +{ # check the meta stuff first + isa_ok(Newswriter::Base->meta, 'Newswriter::Meta::Class'); + isa_ok(Newswriter::Base->meta, 'Moose::Meta::Class'); + isa_ok(Newswriter::Base->meta, 'Class::MOP::Class'); + + is(Newswriter::Base->meta->instance_metaclass, + 'Newswriter::Meta::Instance', + '... got the right instance metaclass name'); + + isa_ok(Newswriter::Base->meta->get_meta_instance, 'Newswriter::Meta::Instance'); + + my $base = Newswriter::Base->new; + isa_ok($base, 'Newswriter::Base'); + isa_ok($base, 'Moose::Object'); + + isa_ok($base->meta, 'Newswriter::Meta::Class'); + isa_ok($base->meta, 'Moose::Meta::Class'); + isa_ok($base->meta, 'Class::MOP::Class'); + + is($base->meta->instance_metaclass, + 'Newswriter::Meta::Instance', + '... got the right instance metaclass name'); + + isa_ok($base->meta->get_meta_instance, 'Newswriter::Meta::Instance'); +} + +my $article_oid; +my $article_ref; +{ + my $article; + lives_ok { + $article = Newswriter::Article->new( + headline => 'Home Office Redecorated', + summary => 'The home office was recently redecorated to match the new company colors', + article => '...', + + author => Newswriter::Author->new( + first_name => 'Truman', + last_name => 'Capote' + ), + + status => 'pending' + ); + } '... created my article successfully'; + isa_ok($article, 'Newswriter::Article'); + isa_ok($article, 'Newswriter::Base'); + + lives_ok { + $article->start_date(DateTime->new(year => 2006, month => 6, day => 10)); + $article->end_date(DateTime->new(year => 2006, month => 6, day => 17)); + } '... add the article date-time stuff'; + + ## check some meta stuff + + isa_ok($article->meta, 'Newswriter::Meta::Class'); + isa_ok($article->meta, 'Moose::Meta::Class'); + isa_ok($article->meta, 'Class::MOP::Class'); + + is($article->meta->instance_metaclass, + 'Newswriter::Meta::Instance', + '... got the right instance metaclass name'); + + isa_ok($article->meta->get_meta_instance, 'Newswriter::Meta::Instance'); + + ok($article->oid, '... got a oid for the article'); + + $article_oid = $article->oid; + $article_ref = "$article"; + + is($article->headline, + 'Home Office Redecorated', + '... got the right headline'); + is($article->summary, + 'The home office was recently redecorated to match the new company colors', + '... got the right summary'); + is($article->article, '...', '... got the right article'); + + isa_ok($article->start_date, 'DateTime'); + isa_ok($article->end_date, 'DateTime'); + + isa_ok($article->author, 'Newswriter::Author'); + is($article->author->first_name, 'Truman', '... got the right author first name'); + is($article->author->last_name, 'Capote', '... got the right author last name'); + + is($article->status, 'pending', '... got the right status'); +} + +Newswriter::Meta::Instance->_reload_db(); + +{ + my $article; + lives_ok { + $article = Newswriter::Article->new(oid => $article_oid); + } '... (re)-created my article successfully'; + isa_ok($article, 'Newswriter::Article'); + isa_ok($article, 'Newswriter::Base'); + + is($article->oid, $article_oid, '... got a oid for the article'); + isnt($article_ref, "$article", '... got a new article instance'); + + is($article->headline, + 'Home Office Redecorated', + '... got the right headline'); + is($article->summary, + 'The home office was recently redecorated to match the new company colors', + '... got the right summary'); + is($article->article, '...', '... got the right article'); + + isa_ok($article->start_date, 'DateTime'); + isa_ok($article->end_date, 'DateTime'); + + isa_ok($article->author, 'Newswriter::Author'); + is($article->author->first_name, 'Truman', '... got the right author first name'); + is($article->author->last_name, 'Capote', '... got the right author last name'); + + lives_ok { + $article->author->first_name('Dan'); + $article->author->last_name('Rather'); + } '... changed the value ok'; + + is($article->author->first_name, 'Dan', '... got the changed author first name'); + is($article->author->last_name, 'Rather', '... got the changed author last name'); + + is($article->status, 'pending', '... got the right status'); +} + +Newswriter::Meta::Instance->_reload_db(); + +{ + my $article; + lives_ok { + $article = Newswriter::Article->new(oid => $article_oid); + } '... (re)-created my article successfully'; + isa_ok($article, 'Newswriter::Article'); + isa_ok($article, 'Newswriter::Base'); + + is($article->oid, $article_oid, '... got a oid for the article'); + isnt($article_ref, "$article", '... got a new article instance'); + + is($article->headline, + 'Home Office Redecorated', + '... got the right headline'); + is($article->summary, + 'The home office was recently redecorated to match the new company colors', + '... got the right summary'); + is($article->article, '...', '... got the right article'); + + isa_ok($article->start_date, 'DateTime'); + isa_ok($article->end_date, 'DateTime'); + + isa_ok($article->author, 'Newswriter::Author'); + is($article->author->first_name, 'Dan', '... got the changed author first name'); + is($article->author->last_name, 'Rather', '... got the changed author last name'); + + is($article->status, 'pending', '... got the right status'); +} + +unlink('newswriter.db') if -e 'newswriter.db'; \ No newline at end of file