The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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