/usr/local/CPAN/XAO-FS/XAO/testcases/FS/placeholders.pm

• package XAO::testcases::FS::placeholders
  • test_double_drop_20031009
  • test_key_length
  • test_same_field_name
  • test_data_placeholder
  • test_list_placeholder
  • test_multiple_same_class
  • test_build_structure
• EOF

package XAO::testcases::FS::placeholders;
use strict;
use XAO::Utils;
use Error qw(:try);

use base qw(XAO::testcases::FS::base);

# If we have /Customers/Orders and /Orders and then drop_placeholder on
# /Customers it also drops /Orders from _MEMORY_, not from the
# database. Should not do that!
#
# AM: 2003-10-09
#
sub test_double_drop_20031009 {
    my $self=shift;
    my $odb=$self->get_odb();

    my $root=$odb->fetch('/');
    $root->add_placeholder(
        name        => 'Orders',
        type        => 'list',
        class       => 'Data::Order',
        key         => 'order_id',
    );

    $self->assert($root->exists('Orders'),
                  "Orders was not created");

    my $c1=$root->get('Customers')->get('c1');
    $c1->add_placeholder(
        name        => 'Orders',
        type        => 'list',
        class       => 'Data::Product',
        key         => 'order_id',
    );

    $self->assert($c1->exists('Orders'),
                  "c1/Orders was not created");

    $root->drop_placeholder('Customers');

    $self->assert(!$root->exists('Customers'),
                  "Customers exists after drop_placeholder (1)");
    $self->assert($root->exists('Orders'),
                  "Orders does not exist, but should");

    $root->add_placeholder(
        name        => 'Customers',
        type        => 'list',
        class       => 'Data::Customer',
        key         => 'order_id',
    );

    $self->assert($root->exists('Customers'),
                  "Customers was not created");

    $root->drop_placeholder('Customers');

    $self->assert(!$root->exists('Customers'),
                  "Customers exists after drop_placeholder (2)");
    $self->assert($root->exists('Orders'),
                  "Orders does not exist, but should");

    $root->drop_placeholder('Orders');

    $self->assert(!$root->exists('Customers'),
                  "Customers exists after drop_placeholder (3)");
    $self->assert(!$root->exists('Orders'),
                  "Orders exists after drop_placeholder");
}

sub test_key_length {
    my $self=shift;

    my $odb=$self->get_odb();

    my $customer=$odb->fetch('/Customers/c1');
    $self->assert(ref($customer),
                  "Can't fetch /Customers/c1");

    $customer->add_placeholder(
        name        => 'Orders',
        type        => 'list',
        class       => 'Data::Order',
        key         => 'order_id',
        key_length  => 40,
    );

    my $orders=$customer->get('Orders');
    my $no=$orders->get_new;

    my $kl=$no->describe('order_id')->{key_length};
    $self->assert($kl == 40,
                  "Got wrong key length, method 1");

    $kl=$orders->key_length;
    $self->assert($kl == 40,
                  "Got wrong key length, method 2");

    $no->add_placeholder(
        name        => 'name',
        type        => 'text',
        maxlength   => 10,
    );

    my $k1=('Z' x 35) . '11';
    my $k2=('Z' x 35) . '22';

    $no->put(name => 'k1');
    $orders->put($k1 => $no);

    $no->put(name => 'k2');
    $orders->put($k2 => $no);

    my $v1=$orders->get($k1)->get('name');
    my $v2=$orders->get($k2)->get('name');

    $self->assert($v1 eq 'k1',
                  "Expected 'k1', got '$v1'");
    $self->assert($v2 eq 'k2',
                  "Expected 'k2', got '$v2'");
}

sub test_same_field_name {
    my $self=shift;

    my $odb=$self->get_odb();

    my $customer=$odb->fetch('/Customers/c1');
    $self->assert(ref($customer),
                  "Can't fetch /Customers/c1");

    $customer->add_placeholder(name => 'first_name',
                               type => 'text',
                               maxlength => 20);

    my $thrown=1;
    try {
        $customer->add_placeholder(name => 'first_name',
                                   type => 'text',
                                   maxlength => 20);
    } otherwise {
        $thrown=1;
    };

    $self->assert($thrown,
                  "Succeeded in adding new placeholder with already used name!");

    $customer->drop_placeholder('first_name');
}

sub test_data_placeholder {
    my $self=shift;

    my $odb=$self->get_odb();

    my $customer=$odb->fetch('/Customers/c1');
    $self->assert(ref($customer),
                  "Can't fetch /Customers/c1");

    $customer->add_placeholder(name => 'first_name',
                               type => 'text',
                               maxlength => 20);

    my $name='John Doe';
    $customer->put(first_name => $name);
    my $got=$customer->get('first_name');
    $self->assert($name eq $got,
                  "Got ($got) not what was stored ($name)");

    $customer->drop_placeholder('first_name');
}

sub test_list_placeholder {
    my $self=shift;

    my $odb=$self->get_odb();

    my $customer=$odb->fetch('/Customers/c1');
    $self->assert(ref($customer),
                  "Can't fetch /Customers/c1");

    $customer->add_placeholder(name   => 'Orders',
                               type   => 'list',
                               class  => 'Data::Order',
                               key    => 'order_id');

    my $cust_orders=$customer->get('Orders');
    $self->assert(ref($cust_orders),
                  "Can't get reference to Orders list from /Customers/c1");

    my $o1=$odb->new(objname => 'Data::Order');
    $self->assert(ref($o1),
                  "Can't create an empty order");

    $o1->add_placeholder(name => 'foo', type => 'text');
    $o1->put(foo => 'bar');

    $cust_orders->put(o0 => $o1);
    $cust_orders->put(o1 => $o1);
    $cust_orders->put(o2 => $o1);
    my $order=$odb->fetch('/Customers/c1/Orders/o1');
    $self->assert(ref($order),
                  "Can't save order into /Customers/c1");
    my $got=$order->get('foo');
    $self->assert($got eq 'bar',
                  "Got wrong value in the order ($got!='bar')");

    my @k=sort $cust_orders->keys;
    $self->assert($k[2] eq 'o2',
                  "Got wrong key in the key list (".join(',',@k).")");

    $order->put(foo => 'new');
    $got=$odb->fetch('/Customers/c1/Orders/o1/foo');
    $self->assert($got eq 'new',
                  "Got wrong value in the order ($got!='new')");

    ##
    # Checking how automatic naming works
    #
    my $c2orders=$odb->fetch('/Customers/c2/Orders');
    $self->assert(ref($c2orders),
                  "Can't fetch /Customers/c2/Orders");

    $o1->put(foo => 'under c2');
    my $newname=$c2orders->put($o1);
    $got=$odb->fetch("/Customers/c2/Orders/$newname/foo");
    $self->assert($got eq 'under c2',
                  "Got wrong value in the order ($got!='under c2')");

    ##
    # Adding third level placeholder on Order.
    #
    $order->add_placeholder(name   => 'Products',
                            type   => 'list',
                            class  => 'Data::Product',
                            key    => 'product_id');
    my $products=$order->get('Products');
    $self->assert(ref($products),
                  "Can't get reference to Products list from /Customers/c1/Orders/o1");
    my $product=$products->get_new();
    $product->add_placeholder(name => 'name',
                              type => 'text');
    $product->put(name => 'test');
    my $newprod=$products->put($product);
    $product=$products->get($newprod);
    $self->assert(ref($product),
                  "Can't put test product into Products");
    $got=$product->get('name');
    $self->assert($got eq 'test',
                  "Got not what was stored into product ($got!='test')");

    ##
    # Deleting
    #
    $cust_orders->delete('o1');
    my $thrown=0;
    try {
        $cust_orders->get('o1');
    } otherwise {
        $thrown=1;
    };
    $self->assert($thrown,
                  "Can still retrieve deleted Order");
    $c2orders->delete($newname);
    $thrown=0;
    try {
        $c2orders->get($newname);
    } otherwise {
        $thrown=1;
    };
    $self->assert($thrown,
                  "Deleted order c2/$newname is still there");

    ##
    # Deleting lists
    #
    $customer->drop_placeholder('Orders');
    $got=1;
    try {
        $order=$customer->get('Orders');
    } otherwise {
        $got=0;
    };
    $self->assert(!$got,
                  "Still can retrieve Orders after dropping placeholder");
}

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

##
# Checking that it is impossible to create more then one list for the
# same class.
#
sub test_multiple_same_class {
    my $self=shift;

    my $odb=$self->get_odb();

    my $customer=$odb->fetch('/Customers/c1');
    $self->assert(ref($customer),
                  "Can't fetch /Customers/c1");

    $customer->add_placeholder(name   => 'Orders',
                               type   => 'list',
                               class  => 'Data::Order',
                               key    => 'order_id');

    my $root=$odb->fetch('/');
    $self->assert(ref($root),
                  "Can't fetch reference to /");

    my $created=1;
    try {
        $root->add_placeholder(name      => 'rootorders',
                               type      => 'list',
                               class     => 'Data::Order',
                               key       => 'root_order_id',
                               connector => 'root_uid');
    } otherwise {
        $created=0;
    };
    $self->assert(! $created,
                  "Succeeded in creating second list of the same class");

    my $got=1;
    try {
        $root->get('rootorders');
    } otherwise {
        $got=0;
    };
    $self->assert(!$got,
                  "Succeeded in creating second list of the same class (After error! Weird..)");
}

sub test_build_structure {
    my $self=shift;
    my $odb=$self->get_odb;

    my $cust=$odb->fetch('/Customers/c1');

    # Otherwise UNIQUE option would not work
    #
    $odb->fetch('/Customers')->delete('c2');

    my %structure=(
        name => {
            type => 'text',
            maxlength => 40,
        },
        text => {
            type => 'text',
            maxlength => 200,
            index => 1,
        },
        integer => {
            type => 'integer',
            minvalue => 0,
            maxvalue => 100
        },
        uns => {
            type => 'integer',
            minvalue => 0,
        },
        uq => {
            type => 'real',
            minvalue => 123,
            maxvalue => 234,
            unique => 1,
        },
        Orders => {
            type      => 'list',
            class     => 'Data::Order',
            key       => 'order_id',
            structure => {
                total => {
                    type => 'real',
                    default => 123.34,
                },
                foo => {
                    type => 'text',
                },
            },
        },
    );

    $cust->build_structure(\%structure);
    foreach my $name (qw(name text integer Orders)) {
        $self->assert($cust->exists($name),
                      "Field ($name) doesn't exist after build_structure()");
    }

# TODO:
# We need to re-load database structure from disk at this
# point. Otherwise index and unique are not really tested.
# am@xao.com, 10/1/2001
#

    $structure{newf}={
        type => 'real',
        minvalue => 123,
        maxvalue => 234,
        index => 1,
    };
    $cust->build_structure(\%structure);

    foreach my $name (qw(newf name text integer uns Orders)) {
        $self->assert($cust->exists($name),
                      "Field ($name) doesn't exist after build_structure()");
        if($name eq 'uns') {
            my $min=$cust->describe($name)->{minvalue};
            $self->assert($min == $structure{uns}->{minvalue},
                          "Minvalue is wrong for 'uns' ($min)");
            my $max=$cust->describe($name)->{maxvalue};
            $self->assert($max == 0xFFFFFFFF,
                          "Maxvalue is wrong for 'uns' ($max)");
        }

        next unless $name eq 'newf';
        $self->assert($cust->describe($name)->{index},
                      "No indication of index in the created field ($name)");
    }
}

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

1;