[gitmo/Moose.git] / t / 008_basic.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

BEGIN {
    eval "use DBM::Deep;";
    plan skip_all => "DBM::Deep required for this test" if $@;        
    plan 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,
            locking   => 1,
        });
        $db->{root} = [] unless exists $db->{root};
        
        sub _reload_db {
            $db = undef;
            $db = DBM::Deep->new({
                file      => "newswriter.db",
                autobless => 1,
                locking   => 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 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 Moose;
    use Moose::Util::TypeConstraints;  
      
    use DateTime::Format::MySQL;
    
    extends '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';
Commit	Line	Data
fcec2383	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
047248f9	6	use Test::More;
	7
	8	BEGIN {
	9	eval "use DBM::Deep;";
	10	plan skip_all => "DBM::Deep required for this test" if $@;
	11	plan tests => 63;
	12	}
	13
fcec2383	14	use Test::Exception;
	15
	16	BEGIN {
	17	use_ok('Moose');
	18	}
	19
	20	BEGIN {
	21
	22	package Newswriter::Meta::Instance;
	23	use strict;
	24	use warnings;
	25	use Moose;
	26
	27	use DBM::Deep;
	28
	29	extends 'Moose::Meta::Instance';
	30
	31	{
	32	my $instance_counter = -1;
	33
	34	my $db = DBM::Deep->new({
047248f9	35	file => "newswriter.db",
	36	autobless => 1,
	37	locking => 1,
fcec2383	38	});
	39	$db->{root} = [] unless exists $db->{root};
	40
fcec2383	41	sub _reload_db {
047248f9	42	$db = undef;
fcec2383	43	$db = DBM::Deep->new({
047248f9	44	file => "newswriter.db",
	45	autobless => 1,
	46	locking => 1,
	47	});
fcec2383	48	}
	49
	50	sub create_instance {
	51	my $self = shift;
	52	$instance_counter++;
	53	$db->{root}->[$instance_counter] = {};
	54
	55	$self->bless_instance_structure({
	56	oid => $instance_counter,
	57	instance => $db->{root}->[$instance_counter]
	58	});
	59	}
	60
	61	sub find_instance {
	62	my ($self, $oid) = @_;
	63	my $instance_struct = $db->{root}->[$oid];
	64
	65	$self->bless_instance_structure({
	66	oid => $oid,
	67	instance => $instance_struct
	68	});
	69	}
	70	}
	71
	72	sub get_instance_oid {
	73	my ($self, $instance) = @_;
	74	$instance->{oid};
	75	}
	76
	77	sub clone_instance {
	78	confess "&clone_instance is left as an exercise for the user";
	79	}
	80
	81	sub get_slot_value {
	82	my ($self, $instance, $slot_name) = @_;
	83	return $instance->{instance}->{$slot_name};
	84	}
	85
	86	sub set_slot_value {
	87	my ($self, $instance, $slot_name, $value) = @_;
	88	$instance->{instance}->{$slot_name} = $value;
	89	}
	90
	91	sub is_slot_initialized {
	92	my ($self, $instance, $slot_name, $value) = @_;
	93	exists $instance->{instance}->{$slot_name} ? 1 : 0;
	94	}
	95
	96	sub weaken_slot_value {
	97	confess "Not sure how well DBM::Deep plays with weak refs, Rob says 'Writer a test'";
	98	}
	99
	100	sub inline_slot_access {
	101	my ($self, $instance, $slot_name) = @_;
	102	sprintf "%s->{instance}->{%s}", $instance, $slot_name;
	103	}
	104
	105	package Newswriter::Meta::Class;
	106	use strict;
	107	use warnings;
	108	use Moose;
	109
	110	extends 'Moose::Meta::Class';
	111
112	override 'construct_instance' => sub {
113	my ($class, %params) = @_;
114	return $class->get_meta_instance->find_instance($params{oid})
115	if $params{oid};
116	super();
117	};
118	}
119
120	{
121	package Newswriter::Base;
122	use strict;
123	use warnings;
124	use metaclass 'Newswriter::Meta::Class' => (
125	':instance_metaclass' => 'Newswriter::Meta::Instance'
126	);
127	use Moose;
128
129	sub oid {
130	my $self = shift;
131	$self->meta
132	->get_meta_instance
133	->get_instance_oid($self);
134	}
135
136	package Newswriter::Author;
137	use strict;
be33e4f3	138	use warnings;
fcec2383	139	use Moose;
	140
	141	extends 'Newswriter::Base';
	142
	143	has 'first_name' => (is => 'rw', isa => 'Str');
	144	has 'last_name' => (is => 'rw', isa => 'Str');
	145
	146	package Newswriter::Article;
	147	use strict;
	148	use warnings;
fcec2383	149	use Moose;
	150	use Moose::Util::TypeConstraints;
	151
	152	use DateTime::Format::MySQL;
	153
047248f9	154	extends 'Newswriter::Base';
fcec2383	155
	156	subtype 'Headline'
	157	=> as 'Str'
	158	=> where { length($_) < 100 };
	159
	160	subtype 'Summary'
	161	=> as 'Str'
	162	=> where { length($_) < 255 };
	163
	164	subtype 'DateTimeFormatString'
	165	=> as 'Str'
	166	=> where { DateTime::Format::MySQL->parse_datetime($_) };
	167
	168	enum 'Status' => qw(draft posted pending archive);
	169
	170	has 'headline' => (is => 'rw', isa => 'Headline');
	171	has 'summary' => (is => 'rw', isa => 'Summary');
	172	has 'article' => (is => 'rw', isa => 'Str');
	173
	174	has 'start_date' => (is => 'rw', isa => 'DateTimeFormatString');
	175	has 'end_date' => (is => 'rw', isa => 'DateTimeFormatString');
	176
	177	has 'author' => (is => 'rw', isa => 'Newswriter::Author');
	178
	179	has 'status' => (is => 'rw', isa => 'Status');
	180
	181	around 'start_date', 'end_date' => sub {
	182	my $c = shift;
	183	my $self = shift;
	184	$c->($self, DateTime::Format::MySQL->format_datetime($_[0])) if @_;
	185	DateTime::Format::MySQL->parse_datetime($c->($self));
	186	};
	187	}
	188
	189	{ # check the meta stuff first
	190	isa_ok(Newswriter::Base->meta, 'Newswriter::Meta::Class');
	191	isa_ok(Newswriter::Base->meta, 'Moose::Meta::Class');
	192	isa_ok(Newswriter::Base->meta, 'Class::MOP::Class');
	193
	194	is(Newswriter::Base->meta->instance_metaclass,
	195	'Newswriter::Meta::Instance',
	196	'... got the right instance metaclass name');
	197
	198	isa_ok(Newswriter::Base->meta->get_meta_instance, 'Newswriter::Meta::Instance');
	199
	200	my $base = Newswriter::Base->new;
	201	isa_ok($base, 'Newswriter::Base');
	202	isa_ok($base, 'Moose::Object');
	203
	204	isa_ok($base->meta, 'Newswriter::Meta::Class');
	205	isa_ok($base->meta, 'Moose::Meta::Class');
	206	isa_ok($base->meta, 'Class::MOP::Class');
	207
	208	is($base->meta->instance_metaclass,
	209	'Newswriter::Meta::Instance',
	210	'... got the right instance metaclass name');
	211
	212	isa_ok($base->meta->get_meta_instance, 'Newswriter::Meta::Instance');
	213	}
	214
	215	my $article_oid;
	216	my $article_ref;
	217	{
	218	my $article;
219	lives_ok {
220	$article = Newswriter::Article->new(
221	headline => 'Home Office Redecorated',
222	summary => 'The home office was recently redecorated to match the new company colors',
223	article => '...',
224
225	author => Newswriter::Author->new(
226	first_name => 'Truman',
227	last_name => 'Capote'
228	),
229
230	status => 'pending'
231	);
232	} '... created my article successfully';
233	isa_ok($article, 'Newswriter::Article');
234	isa_ok($article, 'Newswriter::Base');
235
236	lives_ok {
237	$article->start_date(DateTime->new(year => 2006, month => 6, day => 10));
238	$article->end_date(DateTime->new(year => 2006, month => 6, day => 17));
239	} '... add the article date-time stuff';
240
241	## check some meta stuff
242
243	isa_ok($article->meta, 'Newswriter::Meta::Class');
244	isa_ok($article->meta, 'Moose::Meta::Class');
245	isa_ok($article->meta, 'Class::MOP::Class');
246
247	is($article->meta->instance_metaclass,
248	'Newswriter::Meta::Instance',
249	'... got the right instance metaclass name');
250
251	isa_ok($article->meta->get_meta_instance, 'Newswriter::Meta::Instance');
252
253	ok($article->oid, '... got a oid for the article');
254
255	$article_oid = $article->oid;
256	$article_ref = "$article";
257
258	is($article->headline,
259	'Home Office Redecorated',
260	'... got the right headline');
261	is($article->summary,
262	'The home office was recently redecorated to match the new company colors',
263	'... got the right summary');
264	is($article->article, '...', '... got the right article');
265
266	isa_ok($article->start_date, 'DateTime');
267	isa_ok($article->end_date, 'DateTime');
268
269	isa_ok($article->author, 'Newswriter::Author');
270	is($article->author->first_name, 'Truman', '... got the right author first name');
271	is($article->author->last_name, 'Capote', '... got the right author last name');
272
273	is($article->status, 'pending', '... got the right status');
274	}
275
276	Newswriter::Meta::Instance->_reload_db();
277
278	{
279	my $article;
280	lives_ok {
281	$article = Newswriter::Article->new(oid => $article_oid);
282	} '... (re)-created my article successfully';
283	isa_ok($article, 'Newswriter::Article');
284	isa_ok($article, 'Newswriter::Base');
285
286	is($article->oid, $article_oid, '... got a oid for the article');
287	isnt($article_ref, "$article", '... got a new article instance');
288
289	is($article->headline,
290	'Home Office Redecorated',
291	'... got the right headline');
292	is($article->summary,
293	'The home office was recently redecorated to match the new company colors',
294	'... got the right summary');
295	is($article->article, '...', '... got the right article');
296
297	isa_ok($article->start_date, 'DateTime');
298	isa_ok($article->end_date, 'DateTime');
299
300	isa_ok($article->author, 'Newswriter::Author');
301	is($article->author->first_name, 'Truman', '... got the right author first name');
302	is($article->author->last_name, 'Capote', '... got the right author last name');
303
304	lives_ok {
305	$article->author->first_name('Dan');
306	$article->author->last_name('Rather');
307	} '... changed the value ok';
308
309	is($article->author->first_name, 'Dan', '... got the changed author first name');
310	is($article->author->last_name, 'Rather', '... got the changed author last name');
311
312	is($article->status, 'pending', '... got the right status');
313	}
314
315	Newswriter::Meta::Instance->_reload_db();
316
317	{
318	my $article;
319	lives_ok {
320	$article = Newswriter::Article->new(oid => $article_oid);
321	} '... (re)-created my article successfully';
322	isa_ok($article, 'Newswriter::Article');
323	isa_ok($article, 'Newswriter::Base');
324
325	is($article->oid, $article_oid, '... got a oid for the article');
326	isnt($article_ref, "$article", '... got a new article instance');
327
328	is($article->headline,
329	'Home Office Redecorated',
330	'... got the right headline');
331	is($article->summary,
332	'The home office was recently redecorated to match the new company colors',
333	'... got the right summary');
334	is($article->article, '...', '... got the right article');
335
336	isa_ok($article->start_date, 'DateTime');
337	isa_ok($article->end_date, 'DateTime');
338
339	isa_ok($article->author, 'Newswriter::Author');
340	is($article->author->first_name, 'Dan', '... got the changed author first name');
341	is($article->author->last_name, 'Rather', '... got the changed author last name');
342
343	is($article->status, 'pending', '... got the right status');
344	}
345
346	unlink('newswriter.db') if -e 'newswriter.db';