File Coverage

blib/lib/Muldis/DB/Validator.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

use 5.008001;
use utf8;
use strict;
use warnings FATAL => 'all';

use Muldis::DB::Interface;

###########################################################################
###########################################################################

{ package Muldis::DB::Validator; # module
    our $VERSION = 0.004000;

    use Test::More;

###########################################################################

sub main {
    my ($args) = @_;
    my ($engine_name, $dbms_config)
        = @{$args}{'engine_name', 'dbms_config'};

    plan( 'tests' => 12 );

    print
        "#### Muldis::DB::Validator starting test of $engine_name ####\n";

    # Instantiate a Muldis DB DBMS / virtual machine.
    my $dbms = Muldis::DB::Interface::new_dbms({
        'engine_name' => $engine_name, 'dbms_config' => $dbms_config });
    does_ok( $dbms, 'Muldis::DB::Interface::DBMS' );

    _scenario_foods_suppliers_shipments_v1( $dbms );

    print
        "#### Muldis::DB::Validator finished test of $engine_name ####\n";

    return;
}

###########################################################################

sub _scenario_foods_suppliers_shipments_v1 {
    my ($dbms) = @_;

    # Declare our Perl-lexical variables to use for source data.

    my $src_suppliers
        = $dbms->new_var({ 'decl_type' => 'sys.Core.Relation.Relation' });
    does_ok( $src_suppliers, 'Muldis::DB::Interface::Var' );
    my $src_foods
        = $dbms->new_var({ 'decl_type' => 'sys.Core.Relation.Relation' });
    does_ok( $src_foods, 'Muldis::DB::Interface::Var' );
    my $src_shipments
        = $dbms->new_var({ 'decl_type' => 'sys.Core.Relation.Relation' });
    does_ok( $src_shipments, 'Muldis::DB::Interface::Var' );

    # Load our example literal source data sets into said Perl-lexicals.

    $src_suppliers->store_ast({
        'ast' => [ 'Relation', 'sys.Core.Relation.Relation', [
            {
                'farm'    => [ 'NEText', 'Hodgesons' ],
                'country' => [ 'NEText', 'Canada' ],
            },
            {
                'farm'    => [ 'NEText', 'Beckers' ],
                'country' => [ 'NEText', 'England' ],
            },
            {
                'farm'    => [ 'NEText', 'Wickets' ],
                'country' => [ 'NEText', 'Canada' ],
            },
        ] ],
    });
    pass( 'no death from loading example suppliers data into VM' );

    $src_foods->store_ast({
        'ast' => [ 'Relation', 'sys.Core.Relation.Relation', [
            {
                'food'   => [ 'NEText', 'Bananas' ],
                'colour' => [ 'NEText', 'yellow' ],
            },
            {
                'food'   => [ 'NEText', 'Carrots' ],
                'colour' => [ 'NEText', 'orange' ],
            },
            {
                'food'   => [ 'NEText', 'Oranges' ],
                'colour' => [ 'NEText', 'orange' ],
            },
            {
                'food'   => [ 'NEText', 'Kiwis' ],
                'colour' => [ 'NEText', 'green' ],
            },
            {
                'food'   => [ 'NEText', 'Lemons' ],
                'colour' => [ 'NEText', 'yellow' ],
            },
        ] ],
    });
    pass( 'no death from loading example foods data into VM' );

    $src_shipments->store_ast({
        'ast' => [ 'Relation', 'sys.Core.Relation.Relation', [
            {
                'farm' => [ 'NEText', 'Hodgesons' ],
                'food' => [ 'NEText', 'Kiwis' ],
                'qty'  => [ 'PInt', 'perl_pint', 100 ],
            },
            {
                'farm' => [ 'NEText', 'Hodgesons' ],
                'food' => [ 'NEText', 'Lemons' ],
                'qty'  => [ 'PInt', 'perl_pint', 130 ],
            },
            {
                'farm' => [ 'NEText', 'Hodgesons' ],
                'food' => [ 'NEText', 'Oranges' ],
                'qty'  => [ 'PInt', 'perl_pint', 10 ],
            },
            {
                'farm' => [ 'NEText', 'Hodgesons' ],
                'food' => [ 'NEText', 'Carrots' ],
                'qty'  => [ 'PInt', 'perl_pint', 50 ],
            },
            {
                'farm' => [ 'NEText', 'Beckers' ],
                'food' => [ 'NEText', 'Carrots' ],
                'qty'  => [ 'PInt', 'perl_pint', 90 ],
            },
            {
                'farm' => [ 'NEText', 'Beckers' ],
                'food' => [ 'NEText', 'Bananas' ],
                'qty'  => [ 'PInt', 'perl_pint', 120 ],
            },
            {
                'farm' => [ 'NEText', 'Wickets' ],
                'food' => [ 'NEText', 'Lemons' ],
                'qty'  => [ 'PInt', 'perl_pint', 30 ],
            },
        ] ],
    });
    pass( 'no death from loading example shipments data into VM' );

    # Execute a query against the virtual machine, to look at our sample
    # data and see what suppliers there are for foods coloured 'orange'.

    my $desi_colour
        = $dbms->new_var({ 'decl_type' => 'sys.Core.Text.Text' });
    does_ok( $desi_colour, 'Muldis::DB::Interface::Var' );
    $desi_colour->store_ast({ 'ast' => [ 'NEText', 'orange' ] });
    pass( 'no death from loading desired colour into VM' );

    my $matched_suppl = $dbms->call_func({
        'func_name' => 'sys.Core.Relation.semijoin',
        'args' => {
            'source' => $src_suppliers,
            'filter' => $dbms->call_func({
                'func_name' => 'sys.Core.Relation.join',
                'args' => {
                    'topic' => [ 'QuasiSet',
                            'sys.Core.Spec.QuasiSetOfRelation', [
                        $src_shipments,
                        $src_foods,
                        [ 'Relation', 'sys.Core.Relation.Relation', [
                            {
                                'colour' => $desi_colour,
                            },
                        ] ],
                    ] ],
                },
            }),
        },
    });
    pass( 'no death from executing search query' );
    does_ok( $matched_suppl, 'Muldis::DB::Interface::Var' );

    my $matched_suppl_ast = $matched_suppl->fetch_ast();
    pass( 'no death from fetching search results from VM' );

    # Finally, use the result somehow (not done here).
    # The result should be:
    # [ 'Relation', 'sys.Core.Relation.Relation', [
    #     {
    #         'farm'    => [ 'NEText', 'Hodgesons' ],
    #         'country' => [ 'NEText', 'Canada' ],
    #     },
    #     {
    #         'farm'    => [ 'NEText', 'Beckers' ],
    #         'country' => [ 'NEText', 'England' ],
    #     },
    # ] ]

    print "# debug: orange food suppliers found:\n";
#    print "# " . $rel_def_matched_suppl->as_perl() . "\n";
    print "#  TODO, as_perl()\n";

    return;
}

###########################################################################

# This does_ok exists for code parity with the Perl 6 Validator.pm, where
# a does_ok is a modified clone of Test.pm's isa_ok, that tests using
# .does rather than .isa; in Perl 5, they mean the same thing.

*does_ok = \&isa_ok;

###########################################################################

} # module Muldis::DB::Validator

###########################################################################
###########################################################################

1; # Magic true value required at end of a reusable file's code.
__END__