#!/usr/bin/perl -w # Overall test for esmith::db use File::Copy; use esmith::TestUtils; use Test::More 'no_plan'; use_ok('esmith::db'); my %Expect = ( Foo => ['Bar', {}], Night => ['Day', {}], Squid => ['cephalopod', { arms => 10, species => 'Loligo', } ], # Ensure that empty values are read in properly. Octopus => ['cephalopod', { arms => 8, species => '', } ], # Ensure that escaped pipes are read in properly. Pipe => ['art', { pipe => 'this is not a \| got that?'}], # Ensure that escaped newlines are handled properly. Haiku => ['poem', { words => "Damian Conway\n". "God damn! Damian Conway\n". "Damian Conway" } ] ); my $Scratch_Conf = '10e-smith-lib/db_scratch.conf'; copy '10e-smith-lib/db_dummy.conf', $Scratch_Conf; END { unlink $Scratch_Conf } my %config; tie %config, 'esmith::config', $Scratch_Conf; ok( tied %config, 'tied to the dummy config file' ); isnt( keys %config, 0, ' and theres something in there' ); is( db_get_type(\%config, 'Foo'), 'Bar', 'simple db_get_type' ); my @keys = db_get(\%config); is_deeply( [sort @keys], [sort keys %Expect], 'db_get() all keys' ); foreach my $key (@keys) { my($type, %properties) = db_get(\%config, $key); my($exp_type, $exp_properties) = @{$Expect{$key}}; is( $type, $exp_type, "db_get - type - $key" ); is( db_get_type(\%config, $key), $exp_type, "db_get_type" ); is_deeply( \%properties, $exp_properties, "db_get - prop" ); is_deeply( {db_get_prop(\%config, $key)}, $exp_properties, "db_get_prop - all properties"); while( my($prop, $val) = each %properties ) { is( db_get_prop(\%config, $key, $prop), $val, "db_get_prop - single prop - $prop"); } } is( db_get_type(\%config, 'I_dont_exist'), undef, 'db_get_type on non-existent key' ); is( db_get_prop(\%config, 'I_dont_exist'), undef, ' db_get_prop' ); is( db_get_prop(\%config, 'Squid', 'feet'), undef, 'db_get_prop on non-existent prop' ); is( db_delete_prop(\%config, 'I_dont_exist', 'feet'), undef, 'db_delete_prop on non-existent key' ); is( db_get(\%config, 'Squid'), 'cephalopod|arms|10|species|Loligo', 'db_get a raw value'); { package TieOut; sub TIEHANDLE { bless( \(my $scalar), $_[0]); } sub PRINT { my $self = shift; $$self .= join('', @_); } sub read { my $self = shift; return substr($$self, 0, length($$self), ''); } } my $out = tie *STDOUT, 'TieOut'; db_show(\%config); is( $out->read, <read, <read, <read, <read, <read, <read, <read, < 'hop' }, ' again' ); db_set(\%config, 'Wibble', 'word', { thingy => 'yep' }); ($type, %props) = db_get(\%config, 'Wibble'); is( $type, 'word', 'db_set'); is_deeply( \%props, { thingy => 'yep' } ); db_set_type(\%config, 'Wibble', 'yibble'); is( db_get_type(\%config, 'Wibble'), 'yibble', 'db_set_type' ); db_set_prop(\%config, 'Wibble', har => 'far'); is( db_get_prop(\%config, 'Wibble', 'har'), 'far', 'db_set_prop' ); ### Test read-only open() my $scratch = scratch_copy('10e-smith-lib/configuration.conf'); ok( chmod 0444, $scratch ); my $ro_db = esmith::DB::db->open_ro($scratch); eval { $ro_db->new_record('wibble', { type => 'something' }) }; like( $@, qr/read-only/ ); my $sshd = $ro_db->get('sshd'); eval { $sshd->set_prop('foo', 'bar') }; like( $@, qr/read-only/ ); is( $sshd->prop('foo'), undef ); eval { $sshd->delete_prop('status') }; like( $@, qr/read-only/ ); isnt( $sshd->prop('status'), undef ); eval { $sshd->merge_props(foo => 'bar') }; like( $@, qr/read-only/ ); is( $sshd->prop('foo'), undef ); eval { $sshd->reset_props(foo => 'bar') }; like( $@, qr/read-only/ ); is( $sshd->prop('foo'), undef ); eval { $sshd->delete }; like( $@, qr/read-only/ ); ok( $ro_db->get('sshd') );