use 5.006;
use strict;
use warnings;
package Metabase::Test::Archive;
# ABSTRACT: Test::Routine role for testing Metabase::Archive implementations
our $VERSION = '1.003'; # VERSION
use Metabase::Fact;
use Metabase::Test::Factory;
use Test::Deep qw/cmp_deeply/;
use Test::More 0.92;
use Test::Routine; # a Moose::Role
use MooseX::Types::Moose qw/Str ClassName/;
use MooseX::Types::Structured qw/Map/;
use Moose::Util::TypeConstraints;
#--------------------------------------------------------------------------#
# requirements from composing class
#--------------------------------------------------------------------------#
requires '_build_archive';
#--------------------------------------------------------------------------#
# fixtures
#--------------------------------------------------------------------------#
with 'Metabase::Test::Factory';
has archive => (
is => 'ro',
does => 'Metabase::Archive',
lazy_build => 1,
);
sub store_all {
my $self = shift;
my @keys = $self->keys_test_fact;
for my $k ( @keys ) {
ok( $self->archive->store( $self->get_test_fact($k)->as_struct ),
"stored $k"
);
}
return scalar @keys;
}
#--------------------------------------------------------------------------#
# tests
#--------------------------------------------------------------------------#
test "store and retrieve" => sub {
my $self = shift;
$self->clear_archive;
my $fact = $self->get_test_fact('fact1');
my $guid = $self->archive->store( $fact->as_struct );
is( $fact->guid, $guid, "GUID returned matched GUID in fact" );
my $copy_struct = $self->archive->extract( $guid );
my $class = Metabase::Fact->class_from_type($copy_struct->{metadata}{core}{type});
ok( my $copy = $class->from_struct( $copy_struct ),
"got a fact from archive"
);
cmp_deeply( $copy, $fact, "Extracted fact matches original" );
};
test "iteration" => sub {
my $self = shift;
$self->clear_archive;
my $n_facts = $self->store_all;
my $iter = $self->archive->iterator;
my @facts;
while( my $block = $iter->next ) {
foreach my $item ( @$block ) {
push @facts, $item;
}
}
is( scalar @facts, $n_facts, "iterator found all facts" );
};
test "deletion" => sub {
my $self = shift;
$self->clear_archive;
my $n_facts = $self->store_all;
my $fact = $self->get_test_fact('fact1');
ok( $self->archive->delete( $fact->guid ), "deleted fact1" );
my $iter = $self->archive->iterator;
my @facts;
while( my $block = $iter->next ) {
foreach my $item ( @$block ) {
push @facts, $item;
}
}
is( scalar @facts, $n_facts-1, "iterator found one less fact" );
};
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Metabase::Test::Archive - Test::Routine role for testing Metabase::Archive implementations
=head1 VERSION
version 1.003
=for Pod::Coverage store_all
=head1 AUTHORS
=over 4
=item *
David Golden <dagolden@cpan.org>
=item *
Ricardo Signes <rjbs@cpan.org>
=item *
Leon Brocard <acme@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2013 by David Golden.
This is free software, licensed under:
The Apache License, Version 2.0, January 2004
=cut