#!/usr/bin/perl -w
use strict;
use warnings;
use Data::Dumper;
use Test::More tests => 19;
use File::stat; # an OO-ish module that has been in the core since forever
my $obj = stat('Makefile.PL');
BEGIN { use_ok('Data::Transactional') }
# NB some tests are done in parallel on tied and untied data structures
# as a sanity check
my $tied;
my $untied;
# create correct types of transactional whatsit
ok($tied = Data::Transactional->new(), "create obj with all defaults");
ok($tied->{pie} = 'meat', "... which we can use as a hash");
$tied = Data::Transactional->new();
ok(!eval { $tied->[0] = 'meat' }, "... and not as an array");
ok($tied = Data::Transactional->new(type => 'hash'), "specifically create a hash");
ok($tied->{pie} = 'meat', "... which we can use as a hash");
ok(!eval { $tied->{chips} = $obj }, "can't store objects in a hash");
# tests for a hash
$tied = Data::Transactional->new();
$untied = {};
$untied->{llama} = $tied->{llama} = 'Lama glama';
$untied->{alpaca} = $tied->{alpaca} = 'Lama pacos';
$untied->{guanaco} = $tied->{guanaco} = 'Lama guanicoe';
$untied->{vicuna} = $tied->{vicuna} = 'Vicugna vicugna';
ok($tied->{llama} eq 'Lama glama', "retrieve a record correctly");
ok(join('', sort keys %{$tied}) eq join('', sort keys %{$untied}), "keys works");
ok(join('', sort values %{$tied}) eq join('', sort values %{$untied}), "values works");
my($key, $value) = each(%{$tied});
ok(
($key eq 'llama' && $value eq 'Lama glama') ||
($key eq 'alpaca' && $value eq 'Lama pacos') ||
($key eq 'guanaco' && $value eq 'Lama guanicoe') ||
($key eq 'vicuna' && $value eq 'Vicugna vicugna'),
"each works");
# iterate to end
each(%{$tied});
each(%{$tied});
each(%{$tied});
each(%{$untied});each(%{$untied});each(%{$untied});each(%{$untied});
($key, $value) = each(%{$tied});
my ($key2, $value2) = each(%{$untied});
ok(!defined($key) && !defined($key2), "each fails correctly at the end");
($key, $value) = each(%{$tied});
ok(
($key eq 'llama' && $value eq 'Lama glama') ||
($key eq 'alpaca' && $value eq 'Lama pacos') ||
($key eq 'guanaco' && $value eq 'Lama guanicoe') ||
($key eq 'vicuna' && $value eq 'Vicugna vicugna'),
"each restarts correctly");
# put a hash into the hash
$tied->{'and in latin'} = { reverse %{$tied} };
ok(exists($tied->{'and in latin'}), "put a hash into the hash and it exists");
ok(join('', sort keys %{$tied->{'and in latin'}}) eq 'Lama glamaLama guanicoeLama pacosVicugna vicugna', "subhash has correct keys");
ok(join('', sort values %{$tied->{'and in latin'}}) eq 'alpacaguanacollamavicuna', "subhash has correct values");
ok(delete $tied->{llama} eq 'Lama glama' && delete $untied->{llama} eq 'Lama glama', "delete seems to work");
ok(!exists($tied->{llama}) && !exists($untied->{llama}), "... and the deleted value no longer exists (according to exists()!)");
ok(join('', sort keys %{$tied}) eq 'alpacaand in latinguanacovicuna', "... and according to keys");