02core.t

source of perl for linux application,

    eval { $db->Filter_Key_Push('append_B') };
    is $@, '', "push 'append_B' filter" ;
    
    eval { $db->Filter_Key_Push('append_D') };
    is $@, '', "push 'append_D' filter" ;
    
    doPostData(\%h);
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    'BD'	=> '',
	    'alphaBD'	=> 'beta',
	    'greenBD'	=> 'blue';

}

{
    #diag "Test Set: Value only Filter, with stacking, no closure";

    my %h = () ;
    my $db = tie(%h, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
    ok $db, "tied to $db_file";
    
    doPreData(\%h);

    eval { $db->Filter_Value_Push('append_A') };
    is $@, '', "push 'append_A' filter" ;
    
    eval { $db->Filter_Value_Push('append_C') };
    is $@, '', "push 'append_C' filter" ;
    
    doPostData(\%h);
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    ''	=> 'AC',
	    'alpha'	=> 'betaAC',
	    'green'	=> 'blueAC';

}

{
    #diag "Test Set: Combination Key/Value + Key Filter != Value Filter, with stacking, no closure";

    my %h = () ;
    my $db = tie(%h, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
    ok $db, "tied to $db_file";
    
    doPreData(\%h);

    eval { $db->Filter_Push('append_A') };
    is $@, '', "push 'append_A' filter" ;
    
    eval { $db->Filter_Value_Push('append_C') };
    is $@, '', "push 'append_C' filter" ;
    
    eval { $db->Filter_Key_Push('append_D') };
    is $@, '', "push 'append_D' filter" ;
    
    doPostData(\%h);
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    'AD'	=> 'AC',
	    'alphaAD'	=> 'betaAC',
	    'greenAD'	=> 'blueAC';

}

{
    #diag "Test Set: Combination Key/Value + Key + Key/Value, no closure";

    my %h = () ;
    my $db = tie(%h, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
    ok $db, "tied to $db_file";
    
    doPreData(\%h);

    eval { $db->Filter_Push('append_A') };
    is $@, '', "push 'append_A' filter" ;
    
    eval { $db->Filter_Key_Push('append_B') };
    is $@, '', "push 'append_B' filter" ;
    
    eval { $db->Filter_Push('append_C') };
    is $@, '', "push 'append_C' filter" ;
    
    doPostData(\%h);
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    'ABC'	=> 'AC',
	    'alphaABC'	=> 'betaAC',
	    'greenABC'	=> 'blueAC';

}

{
    #diag "Test Set: Combination Key/Value + Key + Key/Value, with closure";

    my %h = () ;
    my $db = tie(%h, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
    ok $db, "tied to $db_file";
    
    doPreData(\%h);

    eval { $db->Filter_Push('append' => 'A') };
    is $@, '', "push 'append_A' filter" ;
    
    eval { $db->Filter_Key_Push('append' => 'B') };
    is $@, '', "push 'append_B' filter" ;
    
    eval { $db->Filter_Push('append' => 'C') };
    is $@, '', "push 'append_C' filter" ;
    
    doPostData(\%h);
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    'ABC'	=> 'AC',
	    'alphaABC'	=> 'betaAC',
	    'greenABC'	=> 'blueAC';

}

{
    #diag "Test Set: Combination Key/Value + Key + Key/Value, immediate";

    my %h = () ;
    my $db = tie(%h, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
    ok $db, "tied to $db_file";
    
    doPreData(\%h);

    eval { 
        $db->Filter_Push(
                Store => sub { $_ .= 'A' },
                Fetch => sub { s/A$//    }) };
    is $@, '', "push 'append_A' filter" ;
    
    eval { 
        $db->Filter_Key_Push(
                Store => sub { $_ .= 'B' },
                Fetch => sub { s/B$//    }) };
    is $@, '', "push 'append_B' filter" ;
    
    eval { 
        $db->Filter_Push(
                Store => sub { $_ .= 'C' },
                Fetch => sub { s/C$//    }) };
    is $@, '', "push 'append_C' filter" ;
    
    doPostData(\%h);
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    'ABC'	=> 'AC',
	    'alphaABC'	=> 'betaAC',
	    'greenABC'	=> 'blueAC';

}

{
    #diag "Test Set: Combination Key/Value + Key + Key/Value, immediate, closure";

    my %h = () ;
    my $db = tie(%h, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
    ok $db, "tied to $db_file";
    
    doPreData(\%h);

    eval { 
        $db->Filter_Push(
                Store => sub { $_ .= 'A' },
                Fetch => sub { s/A$//    }) };
    is $@, '', "push 'append_A' filter" ;
    
    eval { $db->Filter_Key_Push('append_B') };
    is $@, '', "push 'append_B' filter" ;
    
    eval { $db->Filter_Push('append' => 'C') };
    is $@, '', "push 'append_C' filter" ;
    
    doPostData(\%h);
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    'ABC'	=> 'AC',
	    'alphaABC'	=> 'betaAC',
	    'greenABC'	=> 'blueAC';

}

{
    #diag "Test Set: Filtered & Filter_Pop";

    my %h = () ;
    my $db = tie(%h, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
    ok $db, "tied to $db_file";
    
    doPreData(\%h);

    ok ! $db->Filtered, "not filtered" ;

    eval { 
        $db->Filter_Push(
                Store => sub { $_ .= 'A' },
                Fetch => sub { s/A$//    }) };
    is $@, '', "push 'append_A' filter" ;
    
    ok $db->Filtered, "is filtered" ;

    eval { $db->Filter_Key_Push('append_B') };
    is $@, '', "push 'append_B' filter" ;
    
    ok $db->Filtered, "is filtered" ;
    
    eval { $db->Filter_Push('append' => 'C') };
    is $@, '', "push 'append_C' filter" ;
    
    ok $db->Filtered, "is filtered" ;
    
    doPostData(\%h);
    
    eval { $db->Filter_Pop() };
    is $@, '', "Filter_Pop";
    
    ok $db->Filtered, "is filtered" ;

    $h{'after'} = 'noon';
    is $h{'after'}, 'noon', "read eq written";

    eval { $db->Filter_Pop() };
    is $@, '', "Filter_Pop";
    
    ok $db->Filtered, "is filtered" ;

    $h{'morning'} = 'after';
    is $h{'morning'}, 'after', "read eq written";

    eval { $db->Filter_Pop() };
    is $@, '', "Filter_Pop";
    
    ok ! $db->Filtered, "not filtered" ;

    $h{'and'} = 'finally';
    is $h{'and'}, 'finally', "read eq written";

    eval { $db->Filter_Pop() };
    is $@, '', "Filter_Pop";
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    'ABC'	=> 'AC',
	    'alphaABC'	=> 'betaAC',
	    'greenABC'	=> 'blueAC',
	    'afterAB'	=> 'noonA',
	    'morningA'	=> 'afterA',
	    'and'	=> 'finally';

}

{
    #diag "Test Set: define the filter package in-line";

    {
        package DBM_Filter::append_X;

        sub Store { $_ .= 'X' }
        sub Fetch { s/X$//    }
    }
    
    my %h = () ;
    my $db = tie(%h, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
    ok $db, "tied to $db_file";
    
    doPreData(\%h);

    eval { $db->Filter_Push('append_X') };
    is $@, '', "push 'append_X' filter" ;
    
    doPostData(\%h);
    
    undef $db;
    {
        use warnings FATAL => 'untie';
        eval { untie %h };
        is $@, '', "untie without inner references" ;
    }

    checkRaw 'Op_dbmx', 
	    'abc'	=> 'def',
	    '123'	=> '456',
	    'X'  	=> 'X',
	    'alphaX'	=> 'betaX',
	    'greenX'	=> 'blueX';

}