view release on metacpan or  search on metacpan

t/lib/api.pm  view on Meta::CPAN

} #test_stow_and_fetch_and_delete

sub test_locks {
    my( $cls, $rs_factory ) = @_;
    
    my $store = $rs_factory->new_rs;
    $store->lock( "FOO", "BAR", "BAZ", "BAZ" );
    eval {
        $store->lock( "SOMETHING" );
        fail( "lock called twice in a row" );
    };
    like( $@, qr/cannot be called twice in a row/, 'Data::RecordStore->lock called twice in a row error message' );
    $store->unlock;
    $store->lock( "SOMETHING" );
    pass( "Store was able to lock after unlocking" );
}

sub test_recordstore {
    my( $cls, $rs_factory ) = @_;

    my $store = $rs_factory->new_rs;
    is( $store->entry_count, 0, 'no entries in new store' );

    my $id  = $store->stow( "FOO FOO" );

    my $id2 = $store->stow( "BAR BAR" );

    my $id3 = $store->stow( "Käse essen" );

    # store with 3 entries
    is( $store->entry_count, 3, "store 3 entries" );
    $store = $rs_factory->reopen( $store );
    is( $id2, $id + 1, "Incremental object ids" );
    is( $store->fetch( $id ), "FOO FOO", "first item saved" );
    is( $store->fetch( $id2 ), "BAR BAR", "second item saved" );
    is( $store->fetch( $id3 ), "Käse essen", "third item saved" );

    #
    # Try testing the moving of a record
    #
    $store = $rs_factory->new_rs;

    # 12 is 4096 - 5 = 4091, 13 is 8192 - 5 = 8187
    $id = $store->stow( "x" x 4087 ); #12
    $store->stow( "x" x 8187 ); # 13

    is( $store->entry_count, 2, "two entry count in store" );
#    is( $store->record_count, 2, "two record count in store" );

    my $yid = $store->stow( "y" ); #real small, should still be in 12 which is the minimum
    is( $yid, 3, "Third ID" );

    is( $store->entry_count, 3, "3 entry count in store" );
#    is( $store->record_count, 3, "3 record count in store" );

    $store->stow( "x" x 8188, $id );  # 12 is max 4092, 13 is max 8187

    is( $store->entry_count, 3, "still 3 entry count in store" );
#    is( $store->record_count, 3, "still 3 record count in store" );

    is( $store->fetch( $yid ), "y", "correctly relocated data" );

    # try for a much smaller relocation

    $store->stow( "x" x 90, $id );

    is( $store->entry_count, 3, "yet still 3 entry count in store" );
#    is( $store->record_count, 3, "yet still 3 record count in store" );

    my $xid = $store->stow( "x" x 90 );

    is( $store->entry_count, 4, "now 4 entry count in store" );
#    is( $store->record_count, 4, "now 4 record count in store" );

    $store->delete_record( $id );

    is( $store->entry_count, 4, "still 4 entry count in store after delete" );
#    is( $store->record_count, 3, "now 3 record count in store after delete" );

    $store = $rs_factory->new_rs;
    
    is( $store->entry_count, 0, "empty then no entries" );
#    is( $store->record_count, 0, "empty then no records" );

    $store->stow( "BOOGAH", 4 );
    is( $store->next_id, '5', "next id is 5" );
    is( $store->entry_count, 5, "5 entries after skipping ids plus asking to generate the next one" );
#    is( $store->record_count, 1, "one record at id 4" );

    is( $store->fetch( 4 ), "BOOGAH", "record hasnt changed" );

    $store->stow( "TEN", 10 );
    is( $store->entry_count, 10, "entry count explicitly set" );
#    is( $store->record_count, 2, "now 2 record count in store after delete after explicit set" );
    is( $store->fetch( 10 ), "TEN", "got the 10 stow" );
    is( $store->next_id, 11, 'after entry count being set' );
    is( $store->entry_count, 11, "entry count explicitly set" );
    is( $store->next_id, 12, 'next again' );
    is( $store->entry_count, 12, "entry count explicitly set" );


    $store->stow( "x" x 90 );
    is( $store->entry_count, 13, "now 13 entry count in store after stow" );
#    is( $store->record_count, 3, "now 3 record count in store after stow" );

    $xid = $store->stow( "x" x 90 );

    is( $store->entry_count, 14, "now 14 entry count in store after stow" );
#    is( $store->record_count, 4, "now 4 record count in store after stow" );


} #test suite

sub test_suite_objectstore {
    my( $cls, $rs_factory ) = @_;

    $cls->test_no_auto_clean( $rs_factory );
    $cls->test_autoload( $rs_factory );
    $cls->test_overload( $rs_factory );
    $cls->test_subclass( $rs_factory );
    $cls->test_vol( $rs_factory );
    $cls->test_lock( $rs_factory );
    $cls->test_objectstore( $rs_factory );