[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 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;
    
    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;
138	use warnings;
139	use metaclass 'Newswriter::Meta::Class' => (
140	':instance_metaclass' => 'Newswriter::Meta::Instance'
141	);
142	use Moose;
143
144	extends 'Newswriter::Base';
145
146	has 'first_name' => (is => 'rw', isa => 'Str');
147	has 'last_name' => (is => 'rw', isa => 'Str');
148
149	package Newswriter::Article;
150	use strict;
151	use warnings;
152	use metaclass 'Newswriter::Meta::Class' => (
153	':instance_metaclass' => 'Newswriter::Meta::Instance'
154	);
155	use Moose;
156	use Moose::Util::TypeConstraints;
157
158	use DateTime::Format::MySQL;
159
047248f9	160	extends 'Newswriter::Base';
fcec2383	161
	162	subtype 'Headline'
	163	=> as 'Str'
	164	=> where { length($_) < 100 };
	165
	166	subtype 'Summary'
	167	=> as 'Str'
	168	=> where { length($_) < 255 };
	169
	170	subtype 'DateTimeFormatString'
	171	=> as 'Str'
	172	=> where { DateTime::Format::MySQL->parse_datetime($_) };
	173
	174	enum 'Status' => qw(draft posted pending archive);
	175
	176	has 'headline' => (is => 'rw', isa => 'Headline');
	177	has 'summary' => (is => 'rw', isa => 'Summary');
	178	has 'article' => (is => 'rw', isa => 'Str');
	179
	180	has 'start_date' => (is => 'rw', isa => 'DateTimeFormatString');
	181	has 'end_date' => (is => 'rw', isa => 'DateTimeFormatString');
	182
	183	has 'author' => (is => 'rw', isa => 'Newswriter::Author');
	184
	185	has 'status' => (is => 'rw', isa => 'Status');
	186
	187	around 'start_date', 'end_date' => sub {
	188	my $c = shift;
	189	my $self = shift;
	190	$c->($self, DateTime::Format::MySQL->format_datetime($_[0])) if @_;
	191	DateTime::Format::MySQL->parse_datetime($c->($self));
	192	};
	193	}
	194
	195	{ # check the meta stuff first
	196	isa_ok(Newswriter::Base->meta, 'Newswriter::Meta::Class');
	197	isa_ok(Newswriter::Base->meta, 'Moose::Meta::Class');
	198	isa_ok(Newswriter::Base->meta, 'Class::MOP::Class');
	199
	200	is(Newswriter::Base->meta->instance_metaclass,
	201	'Newswriter::Meta::Instance',
	202	'... got the right instance metaclass name');
	203
	204	isa_ok(Newswriter::Base->meta->get_meta_instance, 'Newswriter::Meta::Instance');
	205
	206	my $base = Newswriter::Base->new;
	207	isa_ok($base, 'Newswriter::Base');
	208	isa_ok($base, 'Moose::Object');
	209
	210	isa_ok($base->meta, 'Newswriter::Meta::Class');
	211	isa_ok($base->meta, 'Moose::Meta::Class');
	212	isa_ok($base->meta, 'Class::MOP::Class');
	213
	214	is($base->meta->instance_metaclass,
	215	'Newswriter::Meta::Instance',
	216	'... got the right instance metaclass name');
	217
	218	isa_ok($base->meta->get_meta_instance, 'Newswriter::Meta::Instance');
	219	}
	220
	221	my $article_oid;
	222	my $article_ref;
	223	{
	224	my $article;
225	lives_ok {
226	$article = Newswriter::Article->new(
227	headline => 'Home Office Redecorated',
228	summary => 'The home office was recently redecorated to match the new company colors',
229	article => '...',
230
231	author => Newswriter::Author->new(
232	first_name => 'Truman',
233	last_name => 'Capote'
234	),
235
236	status => 'pending'
237	);
238	} '... created my article successfully';
239	isa_ok($article, 'Newswriter::Article');
240	isa_ok($article, 'Newswriter::Base');
241
242	lives_ok {
243	$article->start_date(DateTime->new(year => 2006, month => 6, day => 10));
244	$article->end_date(DateTime->new(year => 2006, month => 6, day => 17));
245	} '... add the article date-time stuff';
246
247	## check some meta stuff
248
249	isa_ok($article->meta, 'Newswriter::Meta::Class');
250	isa_ok($article->meta, 'Moose::Meta::Class');
251	isa_ok($article->meta, 'Class::MOP::Class');
252
253	is($article->meta->instance_metaclass,
254	'Newswriter::Meta::Instance',
255	'... got the right instance metaclass name');
256
257	isa_ok($article->meta->get_meta_instance, 'Newswriter::Meta::Instance');
258
259	ok($article->oid, '... got a oid for the article');
260
261	$article_oid = $article->oid;
262	$article_ref = "$article";
263
264	is($article->headline,
265	'Home Office Redecorated',
266	'... got the right headline');
267	is($article->summary,
268	'The home office was recently redecorated to match the new company colors',
269	'... got the right summary');
270	is($article->article, '...', '... got the right article');
271
272	isa_ok($article->start_date, 'DateTime');
273	isa_ok($article->end_date, 'DateTime');
274
275	isa_ok($article->author, 'Newswriter::Author');
276	is($article->author->first_name, 'Truman', '... got the right author first name');
277	is($article->author->last_name, 'Capote', '... got the right author last name');
278
279	is($article->status, 'pending', '... got the right status');
280	}
281
282	Newswriter::Meta::Instance->_reload_db();
283
284	{
285	my $article;
286	lives_ok {
287	$article = Newswriter::Article->new(oid => $article_oid);
288	} '... (re)-created my article successfully';
289	isa_ok($article, 'Newswriter::Article');
290	isa_ok($article, 'Newswriter::Base');
291
292	is($article->oid, $article_oid, '... got a oid for the article');
293	isnt($article_ref, "$article", '... got a new article instance');
294
295	is($article->headline,
296	'Home Office Redecorated',
297	'... got the right headline');
298	is($article->summary,
299	'The home office was recently redecorated to match the new company colors',
300	'... got the right summary');
301	is($article->article, '...', '... got the right article');
302
303	isa_ok($article->start_date, 'DateTime');
304	isa_ok($article->end_date, 'DateTime');
305
306	isa_ok($article->author, 'Newswriter::Author');
307	is($article->author->first_name, 'Truman', '... got the right author first name');
308	is($article->author->last_name, 'Capote', '... got the right author last name');
309
310	lives_ok {
311	$article->author->first_name('Dan');
312	$article->author->last_name('Rather');
313	} '... changed the value ok';
314
315	is($article->author->first_name, 'Dan', '... got the changed author first name');
316	is($article->author->last_name, 'Rather', '... got the changed author last name');
317
318	is($article->status, 'pending', '... got the right status');
319	}
320
321	Newswriter::Meta::Instance->_reload_db();
322
323	{
324	my $article;
325	lives_ok {
326	$article = Newswriter::Article->new(oid => $article_oid);
327	} '... (re)-created my article successfully';
328	isa_ok($article, 'Newswriter::Article');
329	isa_ok($article, 'Newswriter::Base');
330
331	is($article->oid, $article_oid, '... got a oid for the article');
332	isnt($article_ref, "$article", '... got a new article instance');
333
334	is($article->headline,
335	'Home Office Redecorated',
336	'... got the right headline');
337	is($article->summary,
338	'The home office was recently redecorated to match the new company colors',
339	'... got the right summary');
340	is($article->article, '...', '... got the right article');
341
342	isa_ok($article->start_date, 'DateTime');
343	isa_ok($article->end_date, 'DateTime');
344
345	isa_ok($article->author, 'Newswriter::Author');
346	is($article->author->first_name, 'Dan', '... got the changed author first name');
347	is($article->author->last_name, 'Rather', '... got the changed author last name');
348
349	is($article->status, 'pending', '... got the right status');
350	}
351
352	unlink('newswriter.db') if -e 'newswriter.db';