File Coverage

blib/lib/XAO/testcases/FS/lists.pm

Criterion	Covered	Total	%
statement	15	143	10.4
branch			n/a
condition	0	3	0.0
subroutine	5	17	29.4
pod	0	10	0.0
total	20	173	11.5

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

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

sub new_cust {
    my $self=shift;
    my $nref=shift;

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

    my $newcust=XAO::Objects->new(objname => 'Data::Customer',
                                  glue => $odb);
    $self->assert(ref($newcust), 'Detached customer creation failure');

    $$nref='New Customer - ' . sprintf('%5.2f',rand(100));
    $newcust->put(name => $$nref);
    my $got=$newcust->get('name');
    $self->assert($$nref eq $got, "We got ($got) not what we stored ($$nref)");

    $newcust;
}

##
# Checks that two customer objects are different.
#
sub check_separation {
    my $self=shift;
    my ($cust1,$clist,$c2id)=@_;

    my $cust2=$clist->get($c2id);
    $self->assert(ref($cust2),
                  "Failure retrieving customer ($c2id)");

    my $name1='c1 name 11';
    my $name2='c2 name 2222';
    $cust1->put(name => $name1);
    $cust2->put(name => $name2);
    my $got1=$cust1->get('name');
    my $got2=$cust2->get('name');

    $self->assert($got1 eq $name1,
                  "Got ($got1) not what we stored ($name1) (1)");
    $self->assert($got2 eq $name2,
                  "Got ($got2) not what we stored ($name2) (2)");

    $cust2->put(name => $name2);
    $cust1->put(name => $name1);
    $got1=$cust1->get('name');
    $got2=$cust2->get('name');

    $self->assert($got1 eq $name1,
                  "Got ($got1) not what we stored ($name1) (3)");
    $self->assert($got2 eq $name2,
                  "Got ($got2) not what we stored ($name2) (4)");
}

##
# Puts new hash object into storage under generated name. Checks various
# key formats.
#
sub test_store_nameless_object {
    my $self=shift;

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

    my $name;
    my $newcust=$self->new_cust(\$name);

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

    my $id=$clist->put($newcust);
    $self->assert(defined($id) && $id && $id=~/^\w{1,20}$/,
                  "Wrong ID generated ($id)");

    my $got=$odb->fetch("/Customers/$id/name");
    $self->assert($name eq $got,
                  "We fetched ($got) not what we stored ($name)");

    $self->check_separation($newcust,$clist,$id);

    my %matrix=(
        '<$RANDOM$>'            => qr/^\w{8}$/,
        '<$RANDOM/20$>'         => qr/^\w{20}$/,
        '<$AUTOINC$>'           => qr/^\d+$/,
        'X<$AUTOINC/10$>Y'      => qr/^X\d{10}Y$/,
        '<$GMTIME$>_<$RANDOM$>' => qr/^\d+_\w{8}$/,
        'RND<$RANDOM$>X<$DATE$>'=> qr/RND\w{8}X\d{14}/,
    );
    my $root=$odb->fetch('/');
    foreach my $key_format (keys %matrix) {
        my $re=$matrix{$key_format};
        $root->drop_placeholder('Customers');
        $root->build_structure(
            Customers => {
                type        => 'list',
                class       => 'Data::Customer',
                key         => 'customer_id',
                key_format  => $key_format,
                structure   => {
                    name => {
                        type        => 'text',
                        maxlength   => 100,
                    },
                },
            },
        );
        $clist=$root->get('Customers');
        $newcust=$self->new_cust(\$name);
        $id=$clist->put($newcust);
        $self->assert($id=~$re,
                      "Wrong ID generated ($id)");
        $got=$odb->fetch("/Customers/$id/name");
        $self->assert($name eq $got,
                      "We fetched ($got) not what we stored ($name)");
        $self->check_separation($newcust,$clist,$id);
    }
}

##
# Puts new hash object into storage under given name
#
sub test_store_named_object {
    my $self=shift;

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

    my $name;
    my $newcust=$self->new_cust(\$name);

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

    $clist->put(newcust => $newcust);

    my $got=$odb->fetch('/Customers/newcust/name');
    $self->assert($name eq $got,
                  "We fetched ($got) not what we stored ($name)");

    $self->check_separation($newcust,$clist,'newcust');

    ##
    # Now checking how replacement works as 'newcust' already exists at
    # this point.
    #
    $name='new name';
    $newcust->put(name => $name);
    $clist->put(newcust => $newcust);
    $got=$odb->fetch('/Customers/newcust/name');
    $self->assert($name eq $got,
                  "We fetched ($got) not what we stored ($name)");

    $self->check_separation($newcust,$clist,'newcust');
}

sub test_cloning {
    my $self=shift;

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

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

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

    my $id=$clist->put($c1);
    my $n1=$c1->get('name');
    my $c2=$clist->get($id);
    my $n2=$c2->get('name');

    $self->assert($n1 eq $n2,
                  "Cloned name ($n2) differs from the original ($n1) (1)");

    $self->check_separation($c1,$clist,$id);

    $id=$clist->put(c3 => $c1);
    $n1=$c1->get('name');
    $c2=$clist->get($id);
    $n2=$c2->get('name');

    $self->assert($n1 eq $n2,
                  "Cloned name ($n2) differs from the original ($n1) (2)");

    $self->check_separation($c1,$clist,$id);
}

sub test_container_key {
    my $self=shift;
    my $odb=$self->get_odb();

    my $clist=$odb->fetch('/Customers');
    my $name=$clist->container_key();
    $self->assert($name eq 'Customers',
                  "Container_key returned wrong value ('$name'!='Customers')");
}

sub test_keys {
    my $self=shift;
    my $odb=$self->get_odb();

    my $clist=$odb->fetch('/Customers');
    my $keys=join(',',sort $clist->keys);

    $self->assert($keys eq 'c1,c2',
                  "Customers->keys returned wrong value ('$keys'!='c1,c2')");

    my @v=$clist->values();
    $self->assert(@v == 2,
                  "Customers->values returned wrong number of items");
}

sub test_exists {
    my $self=shift;
    my $odb=$self->get_odb();

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

    $self->assert($clist->exists('c1'),
                  "Exists() returned wrong value for 'c1'");

    $self->assert(! $clist->exists('nonexistent'),
                  "Exists() returned wrong value fro 'nonexistent'");
}

sub test_list_describe {
    my $self=shift;

    my $odb = $self->{odb};

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

    $self->assert($list, "Can't fetch List object");

    $self->assert(defined($list->can('describe')),
                  "Can't call function 'describe()' on the List object");

    my $desc=$list->describe();
    $self->assert(ref($desc) eq 'HASH',
                  "List description is not a hash reference");
    $self->assert($desc->{type} eq 'list',
                  "Type of Customers is not 'list'");
    $self->assert($desc->{class} eq 'Data::Customer',
                  "Class of Customers is not 'Data::Customer'");
    $self->assert($desc->{key} => 'customer_id',
                  "Key for Customers is not 'customer_id'");
}

sub test_wrong_name {
    my $self=shift;

    my $odb = $self->{odb};
    my $list=$odb->fetch('/Customers');
    $self->assert($list, "Can't fetch List object");

    my $c=$list->get_new;

    my $flag=0;
    try {
        $list->put('123-456+789' => $c);
        $flag++;
        $list->put('123.456#789' => $c);
        $flag++;
        $list->put('123@456/789' => $c);
        $flag++;
    }
    otherwise {
        $flag=0;
    };

    $self->assert($flag == 0,
                  "Succeeded in storing under wrong name (flag=$flag)");
}

1;