Checking in changes prior to tagging of version 0.21. Changelog diff is:

[gitmo/MooseX-Storage.git] / t / 008_do_not_serialize.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 13;
use Test::Exception;

BEGIN {
    use_ok('MooseX::Storage');
}

{
    package Foo;
    use Moose;
    use MooseX::Storage;

    with Storage;

    has 'bar' => (
        metaclass => 'DoNotSerialize',
        is        => 'rw',
        default   => sub { 'BAR' }        
    );
    
    has 'baz' => (
        traits  => [ 'DoNotSerialize' ],
        is      => 'rw',
        default => sub { 'BAZ' }        
    );    
    
    has 'gorch' => (
        is      => 'rw', 
        default => sub { 'GORCH' }
    );    

    1;
}

{   my $foo = Foo->new;
    isa_ok($foo, 'Foo');
    
    is($foo->bar, 'BAR', '... got the value we expected');
    is($foo->baz, 'BAZ', '... got the value we expected');
    is($foo->gorch, 'GORCH', '... got the value we expected');
    
    is_deeply(
        $foo->pack,
        {
            __CLASS__ => 'Foo',
            gorch     => 'GORCH'
        },
        '... got the right packed class data'
    );
}

### more involved test; required attribute that's not serialized
{   package Bar;
    use Moose;
    use MooseX::Storage;

    with Storage;

    has foo => (
        metaclass   => 'DoNotSerialize',
        required    => 1,
        is          => 'rw',
        isa         => 'Object',        # type constraint is important
    );
    
    has zot => (
        default     => sub { $$ },
        is          => 'rw',
    );        
}

{   my $obj = bless {};
    my $bar = Bar->new( foo => $obj );
    
    ok( $bar,                   "New object created" );
    is( $bar->foo, $obj,        "   ->foo => $obj" );
    is( $bar->zot, $$,          "   ->zot => $$" );
    
    my $bpack = $bar->pack;
    is_deeply(
        $bpack,
        {   __CLASS__   => 'Bar',
            zot         => $$,
        },                      "   Packed correctly" );
        
    eval { Bar->unpack( $bpack ) };
    ok( $@,                     "   Unpack without required attribute fails" );
    like( $@, qr/foo/,          "       Proper error recorded" );
        
    my $bar2 = Bar->unpack( $bpack, inject => { foo => bless {} } );
    ok( $bar2,                  "   Unpacked correctly with foo => Object"); 
}