[dbsrgits/DBM-Deep.git] / t / 17_import.t

##
# DBM::Deep Test
##
use strict;
use Test::More tests => 9;
use Test::Deep;
use t::common qw( new_fh );

use_ok( 'DBM::Deep' );

{
    my ($fh, $filename) = new_fh();
    my $db = DBM::Deep->new({
        file      => $filename,
        autobless => 1,
    });

##
# Create structure in memory
##
    my $struct = {
        key1 => "value1",
        key2 => "value2",
        array1 => [ "elem0", "elem1", "elem2" ],
        hash1 => {
            subkey1 => "subvalue1",
            subkey2 => "subvalue2",
            subkey3 => bless( {}, 'Foo' ),
        }
    };

##
# Import entire thing
##
    $db->import( $struct );

    cmp_deeply(
        $db,
        noclass({
            key1 => 'value1',
            key2 => 'value2',
            array1 => [ 'elem0', 'elem1', 'elem2', ],
            hash1 => {
                subkey1 => "subvalue1",
                subkey2 => "subvalue2",
                subkey3 => useclass( bless {}, 'Foo' ),
            },
        }),
        "Everything matches",
    );

    $struct->{foo} = 'bar';
    is( $struct->{foo}, 'bar', "\$struct has foo and it's 'bar'" );
    ok( !exists $db->{foo}, "\$db doesn't have the 'foo' key, so \$struct is not tied" );

    $struct->{hash1}->{foo} = 'bar';
    is( $struct->{hash1}->{foo}, 'bar', "\$struct->{hash1} has foo and it's 'bar'" );
    ok( !exists $db->{hash1}->{foo}, "\$db->{hash1} doesn't have the 'foo' key, so \$struct->{hash1} is not tied" );
}

{
    my ($fh, $filename) = new_fh();
    my $db = DBM::Deep->new({
        file => $filename,
        type => DBM::Deep->TYPE_ARRAY,
    });

    my $struct = [
        1 .. 3,
        [ 2, 4, 6 ],
        bless( [], 'Bar' ),
        { foo => [ 2 .. 4 ] },
    ];

##
# Import entire thing
##
    $db->import( $struct );

    cmp_deeply(
        $db,
        noclass([
            1 .. 3,
            [ 2, 4, 6 ],
            useclass( bless( [], 'Bar' ) ),
            { foo => [ 2 .. 4 ] },
        ]),
        "Everything matches",
    );

    push @$struct, 'bar';
    is( $struct->[-1], 'bar', "\$struct has 'bar' at the end" );
    ok( $db->[-1], "\$db doesn't have the 'bar' value at the end, so \$struct is not tied" );
}

__END__

Need to add tests for:
    - Failure case (have something tied or a glob or something like that)
    - Where we already have $db->{hash1} to make sure that it's not overwritten
Commit	Line	Data
ffed8b01	1	##
	2	# DBM::Deep Test
	3	##
	4	use strict;
be12c941	5	use Test::More tests => 9;
a3e62809	6	use Test::Deep;
fde3db1a	7	use t::common qw( new_fh );
ffed8b01	8
	9	use_ok( 'DBM::Deep' );
	10
be12c941	11	{
	12	my ($fh, $filename) = new_fh();
	13	my $db = DBM::Deep->new({
	14	file => $filename,
	15	autobless => 1,
	16	});
ffed8b01	17
	18	##
	19	# Create structure in memory
	20	##
be12c941	21	my $struct = {
	22	key1 => "value1",
	23	key2 => "value2",
	24	array1 => [ "elem0", "elem1", "elem2" ],
	25	hash1 => {
	26	subkey1 => "subvalue1",
	27	subkey2 => "subvalue2",
	28	subkey3 => bless( {}, 'Foo' ),
	29	}
	30	};
ffed8b01	31
	32	##
	33	# Import entire thing
	34	##
be12c941	35	$db->import( $struct );
ffed8b01	36
be12c941	37	cmp_deeply(
	38	$db,
	39	noclass({
	40	key1 => 'value1',
	41	key2 => 'value2',
	42	array1 => [ 'elem0', 'elem1', 'elem2', ],
	43	hash1 => {
	44	subkey1 => "subvalue1",
	45	subkey2 => "subvalue2",
	46	subkey3 => useclass( bless {}, 'Foo' ),
	47	},
	48	}),
	49	"Everything matches",
	50	);
	51
	52	$struct->{foo} = 'bar';
	53	is( $struct->{foo}, 'bar', "\$struct has foo and it's 'bar'" );
	54	ok( !exists $db->{foo}, "\$db doesn't have the 'foo' key, so \$struct is not tied" );
	55
	56	$struct->{hash1}->{foo} = 'bar';
	57	is( $struct->{hash1}->{foo}, 'bar', "\$struct->{hash1} has foo and it's 'bar'" );
	58	ok( !exists $db->{hash1}->{foo}, "\$db->{hash1} doesn't have the 'foo' key, so \$struct->{hash1} is not tied" );
	59	}
	60
	61	{
	62	my ($fh, $filename) = new_fh();
	63	my $db = DBM::Deep->new({
	64	file => $filename,
	65	type => DBM::Deep->TYPE_ARRAY,
	66	});
	67
	68	my $struct = [
	69	1 .. 3,
	70	[ 2, 4, 6 ],
	71	bless( [], 'Bar' ),
	72	{ foo => [ 2 .. 4 ] },
	73	];
	74
	75	##
	76	# Import entire thing
	77	##
	78	$db->import( $struct );
	79
	80	cmp_deeply(
	81	$db,
	82	noclass([
	83	1 .. 3,
	84	[ 2, 4, 6 ],
	85	useclass( bless( [], 'Bar' ) ),
	86	{ foo => [ 2 .. 4 ] },
	87	]),
	88	"Everything matches",
	89	);
	90
	91	push @$struct, 'bar';
	92	is( $struct->[-1], 'bar', "\$struct has 'bar' at the end" );
	93	ok( $db->[-1], "\$db doesn't have the 'bar' value at the end, so \$struct is not tied" );
	94	}
12b96196	95
	96	__END__
	97
	98	Need to add tests for:
	99	- Failure case (have something tied or a glob or something like that)
	100	- Where we already have $db->{hash1} to make sure that it's not overwritten