fuckit
[gitmo/Moose.git] / t / 008_basic.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
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
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({
35             file      => "newswriter.db",
36             autobless => 1,
37             locking   => 1,
38         });
39         $db->{root} = [] unless exists $db->{root};
40         
41         sub _reload_db {
42             $db = undef;
43             $db = DBM::Deep->new({
44                 file      => "newswriter.db",
45                 autobless => 1,
46                 locking   => 1,
47             }); 
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     
160     extends 'Newswriter::Base';    
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';