Moose-t-failing/200_examples/002_example_Mouse_POOP.t

   1 #!/usr/bin/perl
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 $TODO = q{Mouse is not yet completed};
  11
  12 use Test::Requires {
  13     'DBM::Deep' => '1.0003', # skip all if not installed
  14     'DateTime::Format::MySQL' => '0.01',
  15 };
  16
  17 use Test::Exception;
  18
  19 BEGIN {
  20     # in case there are leftovers
  21     unlink('newswriter.db') if -e 'newswriter.db';
  22 }
  23
  24 END {
  25     unlink('newswriter.db') if -e 'newswriter.db';
  26 }
  27
  28
  29 =pod
  30
  31 This example creates a very basic Object Database which
  32 links in the instances created with a backend store
  33 (a DBM::Deep hash). It is by no means to be taken seriously
  34 as a real-world ODB, but is a proof of concept of the flexibility
  35 of the ::Instance protocol.
  36
  37 =cut
  38
  39 BEGIN {
  40
  41     package Mouse::POOP::Meta::Instance;
  42     use Mouse;
  43
  44     use DBM::Deep;
  45
  46     extends 'Mouse::Meta::Instance';
  47
  48     {
  49         my %INSTANCE_COUNTERS;
  50
  51         my $db = DBM::Deep->new({
  52             file      => "newswriter.db",
  53             autobless => 1,
  54             locking   => 1,
  55         });
  56
  57         sub _reload_db {
  58             #use Data::Dumper;
  59             #warn Dumper $db;
  60             $db = undef;
  61             $db = DBM::Deep->new({
  62                 file      => "newswriter.db",
  63                 autobless => 1,
  64                 locking   => 1,
  65             });
  66         }
  67
  68         sub create_instance {
  69             my $self  = shift;
  70             my $class = $self->associated_metaclass->name;
  71             my $oid   = ++$INSTANCE_COUNTERS{$class};
  72
  73             $db->{$class}->[($oid - 1)] = {};
  74
  75             bless {
  76                 oid      => $oid,
  77                 instance => $db->{$class}->[($oid - 1)]
  78             }, $class;
  79         }
  80
  81         sub find_instance {
  82             my ($self, $oid) = @_;
  83             my $instance = $db->{$self->associated_metaclass->name}->[($oid - 1)];
  84
  85             bless {
  86                 oid      => $oid,
  87                 instance => $instance,
  88             }, $self->associated_metaclass->name;
  89         }
  90
  91         sub clone_instance {
  92             my ($self, $instance) = @_;
  93
  94             my $class = $self->{meta}->name;
  95             my $oid   = ++$INSTANCE_COUNTERS{$class};
  96
  97             my $clone = tied($instance)->clone;
  98
  99             bless {
 100                 oid      => $oid,
 101                 instance => $clone,
 102             }, $class;
 103         }
 104     }
 105
 106     sub get_instance_oid {
 107         my ($self, $instance) = @_;
 108         $instance->{oid};
 109     }
 110
 111     sub get_slot_value {
 112         my ($self, $instance, $slot_name) = @_;
 113         return $instance->{instance}->{$slot_name};
 114     }
 115
 116     sub set_slot_value {
 117         my ($self, $instance, $slot_name, $value) = @_;
 118         $instance->{instance}->{$slot_name} = $value;
 119     }
 120
 121     sub is_slot_initialized {
 122         my ($self, $instance, $slot_name, $value) = @_;
 123         exists $instance->{instance}->{$slot_name} ? 1 : 0;
 124     }
 125
 126     sub weaken_slot_value {
 127         confess "Not sure how well DBM::Deep plays with weak refs, Rob says 'Write a test'";
 128     }
 129
 130     sub inline_slot_access {
 131         my ($self, $instance, $slot_name) = @_;
 132         sprintf "%s->{instance}->{%s}", $instance, $slot_name;
 133     }
 134
 135     package Mouse::POOP::Meta::Class;
 136     use Mouse;
 137
 138     extends 'Mouse::Meta::Class';
 139
 140     override '_construct_instance' => sub {
 141         my $class = shift;
 142         my $params = @_ == 1 ? $_[0] : {@_};
 143         return $class->get_meta_instance->find_instance($params->{oid})
 144             if $params->{oid};
 145         super();
 146     };
 147
 148 }
 149 {
 150     package Mouse::POOP::Object;
 151     use metaclass 'Mouse::POOP::Meta::Class' => (
 152         instance_metaclass => 'Mouse::POOP::Meta::Instance'
 153     );
 154     use Mouse;
 155
 156     sub oid {
 157         my $self = shift;
 158         $self->meta
 159              ->get_meta_instance
 160              ->get_instance_oid($self);
 161     }
 162
 163 }
 164 {
 165     package Newswriter::Author;
 166     use Mouse;
 167
 168     extends 'Mouse::POOP::Object';
 169
 170     has 'first_name' => (is => 'rw', isa => 'Str');
 171     has 'last_name'  => (is => 'rw', isa => 'Str');
 172
 173     package Newswriter::Article;
 174     use Mouse;
 175     use Mouse::Util::TypeConstraints;
 176
 177     use DateTime::Format::MySQL;
 178
 179     extends 'Mouse::POOP::Object';
 180
 181     subtype 'Headline'
 182         => as 'Str'
 183         => where { length($_) < 100 };
 184
 185     subtype 'Summary'
 186         => as 'Str'
 187         => where { length($_) < 255 };
 188
 189     subtype 'DateTimeFormatString'
 190         => as 'Str'
 191         => where { DateTime::Format::MySQL->parse_datetime($_) };
 192
 193     enum 'Status' => qw(draft posted pending archive);
 194
 195     has 'headline' => (is => 'rw', isa => 'Headline');
 196     has 'summary'  => (is => 'rw', isa => 'Summary');
 197     has 'article'  => (is => 'rw', isa => 'Str');
 198
 199     has 'start_date' => (is => 'rw', isa => 'DateTimeFormatString');
 200     has 'end_date'   => (is => 'rw', isa => 'DateTimeFormatString');
 201
 202     has 'author' => (is => 'rw', isa => 'Newswriter::Author');
 203
 204     has 'status' => (is => 'rw', isa => 'Status');
 205
 206     around 'start_date', 'end_date' => sub {
 207         my $c    = shift;
 208         my $self = shift;
 209         $c->($self, DateTime::Format::MySQL->format_datetime($_[0])) if @_;
 210         DateTime::Format::MySQL->parse_datetime($c->($self) || return undef);
 211     };
 212 }
 213
 214 { # check the meta stuff first
 215     isa_ok(Mouse::POOP::Object->meta, 'Mouse::POOP::Meta::Class');
 216     isa_ok(Mouse::POOP::Object->meta, 'Mouse::Meta::Class');
 217     isa_ok(Mouse::POOP::Object->meta, 'Mouse::Meta::Class');
 218
 219     is(Mouse::POOP::Object->meta->instance_metaclass,
 220       'Mouse::POOP::Meta::Instance',
 221       '... got the right instance metaclass name');
 222
 223     isa_ok(Mouse::POOP::Object->meta->get_meta_instance, 'Mouse::POOP::Meta::Instance');
 224
 225     my $base = Mouse::POOP::Object->new;
 226     isa_ok($base, 'Mouse::POOP::Object');
 227     isa_ok($base, 'Mouse::Object');
 228
 229     isa_ok($base->meta, 'Mouse::POOP::Meta::Class');
 230     isa_ok($base->meta, 'Mouse::Meta::Class');
 231     isa_ok($base->meta, 'Mouse::Meta::Class');
 232
 233     is($base->meta->instance_metaclass,
 234       'Mouse::POOP::Meta::Instance',
 235       '... got the right instance metaclass name');
 236
 237     isa_ok($base->meta->get_meta_instance, 'Mouse::POOP::Meta::Instance');
 238 }
 239
 240 my $article_oid;
 241 my $article_ref;
 242 {
 243     my $article;
 244     lives_ok {
 245         $article = Newswriter::Article->new(
 246             headline => 'Home Office Redecorated',
 247             summary  => 'The home office was recently redecorated to match the new company colors',
 248             article  => '...',
 249
 250             author => Newswriter::Author->new(
 251                 first_name => 'Truman',
 252                 last_name  => 'Capote'
 253             ),
 254
 255             status => 'pending'
 256         );
 257     } '... created my article successfully';
 258     isa_ok($article, 'Newswriter::Article');
 259     isa_ok($article, 'Mouse::POOP::Object');
 260
 261     lives_ok {
 262         $article->start_date(DateTime->new(year => 2006, month => 6, day => 10));
 263         $article->end_date(DateTime->new(year => 2006, month => 6, day => 17));
 264     } '... add the article date-time stuff';
 265
 266     ## check some meta stuff
 267
 268     isa_ok($article->meta, 'Mouse::POOP::Meta::Class');
 269     isa_ok($article->meta, 'Mouse::Meta::Class');
 270     isa_ok($article->meta, 'Mouse::Meta::Class');
 271
 272     is($article->meta->instance_metaclass,
 273       'Mouse::POOP::Meta::Instance',
 274       '... got the right instance metaclass name');
 275
 276     isa_ok($article->meta->get_meta_instance, 'Mouse::POOP::Meta::Instance');
 277
 278     ok($article->oid, '... got a oid for the article');
 279
 280     $article_oid = $article->oid;
 281     $article_ref = "$article";
 282
 283     is($article->headline,
 284        'Home Office Redecorated',
 285        '... got the right headline');
 286     is($article->summary,
 287        'The home office was recently redecorated to match the new company colors',
 288        '... got the right summary');
 289     is($article->article, '...', '... got the right article');
 290
 291     isa_ok($article->start_date, 'DateTime');
 292     isa_ok($article->end_date,   'DateTime');
 293
 294     isa_ok($article->author, 'Newswriter::Author');
 295     is($article->author->first_name, 'Truman', '... got the right author first name');
 296     is($article->author->last_name, 'Capote', '... got the right author last name');
 297
 298     is($article->status, 'pending', '... got the right status');
 299 }
 300
 301 Mouse::POOP::Meta::Instance->_reload_db();
 302
 303 my $article2_oid;
 304 my $article2_ref;
 305 {
 306     my $article2;
 307     lives_ok {
 308         $article2 = Newswriter::Article->new(
 309             headline => 'Company wins Lottery',
 310             summary  => 'An email was received today that informed the company we have won the lottery',
 311             article  => 'WoW',
 312
 313             author => Newswriter::Author->new(
 314                 first_name => 'Katie',
 315                 last_name  => 'Couric'
 316             ),
 317
 318             status => 'posted'
 319         );
 320     } '... created my article successfully';
 321     isa_ok($article2, 'Newswriter::Article');
 322     isa_ok($article2, 'Mouse::POOP::Object');
 323
 324     $article2_oid = $article2->oid;
 325     $article2_ref = "$article2";
 326
 327     is($article2->headline,
 328        'Company wins Lottery',
 329        '... got the right headline');
 330     is($article2->summary,
 331        'An email was received today that informed the company we have won the lottery',
 332        '... got the right summary');
 333     is($article2->article, 'WoW', '... got the right article');
 334
 335     ok(!$article2->start_date, '... these two dates are unassigned');
 336     ok(!$article2->end_date,   '... these two dates are unassigned');
 337
 338     isa_ok($article2->author, 'Newswriter::Author');
 339     is($article2->author->first_name, 'Katie', '... got the right author first name');
 340     is($article2->author->last_name, 'Couric', '... got the right author last name');
 341
 342     is($article2->status, 'posted', '... got the right status');
 343
 344     ## orig-article
 345
 346     my $article;
 347     lives_ok {
 348         $article = Newswriter::Article->new(oid => $article_oid);
 349     } '... (re)-created my article successfully';
 350     isa_ok($article, 'Newswriter::Article');
 351     isa_ok($article, 'Mouse::POOP::Object');
 352
 353     is($article->oid, $article_oid, '... got a oid for the article');
 354     isnt($article_ref, "$article", '... got a new article instance');
 355
 356     is($article->headline,
 357        'Home Office Redecorated',
 358        '... got the right headline');
 359     is($article->summary,
 360        'The home office was recently redecorated to match the new company colors',
 361        '... got the right summary');
 362     is($article->article, '...', '... got the right article');
 363
 364     isa_ok($article->start_date, 'DateTime');
 365     isa_ok($article->end_date,   'DateTime');
 366
 367     isa_ok($article->author, 'Newswriter::Author');
 368     is($article->author->first_name, 'Truman', '... got the right author first name');
 369     is($article->author->last_name, 'Capote', '... got the right author last name');
 370
 371     lives_ok {
 372         $article->author->first_name('Dan');
 373         $article->author->last_name('Rather');
 374     } '... changed the value ok';
 375
 376     is($article->author->first_name, 'Dan', '... got the changed author first name');
 377     is($article->author->last_name, 'Rather', '... got the changed author last name');
 378
 379     is($article->status, 'pending', '... got the right status');
 380 }
 381
 382 Mouse::POOP::Meta::Instance->_reload_db();
 383
 384 {
 385     my $article;
 386     lives_ok {
 387         $article = Newswriter::Article->new(oid => $article_oid);
 388     } '... (re)-created my article successfully';
 389     isa_ok($article, 'Newswriter::Article');
 390     isa_ok($article, 'Mouse::POOP::Object');
 391
 392     is($article->oid, $article_oid, '... got a oid for the article');
 393     isnt($article_ref, "$article", '... got a new article instance');
 394
 395     is($article->headline,
 396        'Home Office Redecorated',
 397        '... got the right headline');
 398     is($article->summary,
 399        'The home office was recently redecorated to match the new company colors',
 400        '... got the right summary');
 401     is($article->article, '...', '... got the right article');
 402
 403     isa_ok($article->start_date, 'DateTime');
 404     isa_ok($article->end_date,   'DateTime');
 405
 406     isa_ok($article->author, 'Newswriter::Author');
 407     is($article->author->first_name, 'Dan', '... got the changed author first name');
 408     is($article->author->last_name, 'Rather', '... got the changed author last name');
 409
 410     is($article->status, 'pending', '... got the right status');
 411
 412     my $article2;
 413     lives_ok {
 414         $article2 = Newswriter::Article->new(oid => $article2_oid);
 415     } '... (re)-created my article successfully';
 416     isa_ok($article2, 'Newswriter::Article');
 417     isa_ok($article2, 'Mouse::POOP::Object');
 418
 419     is($article2->oid, $article2_oid, '... got a oid for the article');
 420     isnt($article2_ref, "$article2", '... got a new article instance');
 421
 422     is($article2->headline,
 423        'Company wins Lottery',
 424        '... got the right headline');
 425     is($article2->summary,
 426        'An email was received today that informed the company we have won the lottery',
 427        '... got the right summary');
 428     is($article2->article, 'WoW', '... got the right article');
 429
 430     ok(!$article2->start_date, '... these two dates are unassigned');
 431     ok(!$article2->end_date,   '... these two dates are unassigned');
 432
 433     isa_ok($article2->author, 'Newswriter::Author');
 434     is($article2->author->first_name, 'Katie', '... got the right author first name');
 435     is($article2->author->last_name, 'Couric', '... got the right author last name');
 436
 437     is($article2->status, 'posted', '... got the right status');
 438
 439 }
 440
 441 done_testing;