view release on metacpan or  search on metacpan

lib/KiokuDB/Test/Fixture.pm  view on Meta::CPAN

    }
}

has get_directory => (
    isa => "CodeRef|Str",
    is  => "ro",
);

has directory => (
    is  => "ro",
    isa => "KiokuDB",
    lazy_build => 1,
    handles => [qw(
        lookup exists
        store
        insert update delete

        clear_live_objects

        backend
        linker
        collapser

        search
        simple_search
        backend_search

        is_root
        set_root
        unset_root

        all_objects
        root_set
        scan
        grep

        new_scope

        txn_do

        object_to_id
        objects_to_ids
    )],
);

sub _build_directory {
    my $self = shift;
    my $method = $self->get_directory or die "either 'directory' or 'get_directory' is required";
    return $self->$method;
}

sub live_objects {
    shift->directory->live_objects->live_objects
}

sub live_entries {
    shift->directory->live_objects->live_entries
}


sub update_live_objects {
    my $self = shift;

    _lives_and_ret { $self->update( $self->live_objects ) } "updated live objects";
}

sub store_ok {
    my ( $self, @objects ) = @_;

    local $Test::Builder::Level = 1;

    _lives_and_ret { $self->store( @objects ) } "stored " . scalar(grep { ref } @objects) . " objects";
}

sub update_ok {
    my ( $self, @objects ) = @_;

    _lives_and_ret { $self->update( @objects ) } "updated " . scalar(@objects) . " objects";
}

sub insert_ok {
    my ( $self, @objects ) = @_;

    _lives_and_ret { $self->insert( @objects ) } "inserted " . scalar(@objects) . " objects";
}

sub delete_ok {
    my ( $self, @objects ) = @_;

    _lives_and_ret { $self->delete( @objects ) } "deleted " . scalar(@objects) . " objects";
}

sub lookup_ok {
    my ( $self, @ids ) = @_;

    my @ret;
    _lives_and_ret { @ret = $self->lookup( @ids ) } "lookup " . scalar(@ids) . " objects";

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    is( scalar(grep { ref } @ret), scalar(@ids), "all lookups succeeded" );

    return ( ( @ret == 1 ) ? $ret[0] : @ret );
}

sub exists_ok {
    my ( $self, @ids ) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    is( scalar(grep { $_ } $self->exists(@ids)), scalar(@ids), "[@ids] exist in DB" );
}

sub root_ok {
    my ( $self, @objects ) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    is( scalar(grep { $_ } $self->is_root(@objects)), scalar(@objects), "[@{[ $self->objects_to_ids(@objects) ]}] are in the root set" );
}

sub not_root_ok {
    my ( $self, @objects ) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    is( scalar(grep { not $_ } $self->is_root(@objects)), scalar(@objects), "[@{[ $self->objects_to_ids(@objects) ]}] aren't in the root set" );
}

sub deleted_ok {
    my ( $self, @ids ) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    is( scalar(grep { !$_ } $self->exists(@ids)), scalar(@ids), "@ids do not exist in DB" );