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

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