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

• package XAO::testcases::FS::collection
  • test_am_20031029_wrong_id
  • test_bild_20030611_distinct
  • test_bild_20021217
  • test_describe
  • test_everything
  • test_deeper
• EOF

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

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

# It used to return a damaged object

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

    my $coll=$odb->collection(class => 'Data::Customer');

    my $c;
    try {
        $c=$coll->get(9876543);
    }
    otherwise {
        my $e=shift;
        dprint "Expected error: $e";
    };
    
    $self->assert(!$c,
                  "Returned non-existing object");
}

##
#  my $ingredients = $odb->collection('class' => 'Data::Ingredient') ;
#  my $result = $ingredients->search(
#                                    { orderby => ['ascend' => 'name'],
#                                      distinct => 'name' }
#                                    ) ;
# 
# ... doesn't seem to work correctly.  It returns a list containing a
# large list of identical keys, like:
# 
# [ 5589, 5589, 5589, 5589 ... ]
#
sub test_bild_20030611_distinct {
    my $self=shift;
    my $odb=$self->get_odb;

    my $c1=$odb->fetch('/Customers/c1');
    $c1->build_structure(
        Orders => {
            type        => 'list',
            class       => 'Data::Order',
            key         => 'order_id',
            structure   => {
                name => {
                    type        => 'text',
                    maxlength   => 100,
                }
            },
        },
    );

    my $orders1=$c1->get('Orders');
    my $orders2=$odb->fetch('/Customers/c2/Orders');

    my $nc=$orders1->get_new;
    $nc->put(name => 'test1');
    $orders1->put(test1_1_1 => $nc);
    $orders1->put(test1_2_1 => $nc);
    $orders1->put(test1_3_1 => $nc);
    $orders2->put(test1_1_2 => $nc);
    $orders2->put(test1_2_2 => $nc);
    $nc->put(name => 'test2');
    $orders1->put(test2_1_1 => $nc);
    $orders1->put(test2_2_1 => $nc);
    $orders1->put(test2_3_1 => $nc);
    $orders2->put(test2_1_2 => $nc);
    $orders2->put(test2_2_2 => $nc);
    $nc->put(name => 'test3');
    $orders1->put(test3_1_1 => $nc);
    $nc->put(name => 'test4');
    $orders2->put(test4_1_2 => $nc);

    my $coll=$odb->collection(class => 'Data::Order');

    my $sr=$coll->search({ orderby => [ ascend => 'name' ],
                           distinct => 'name'
                         });
    my $t1c=0;
    my $t2c=0;
    my $t3c=0;
    my $t4c=0;
    foreach my $id (@$sr) {
        my $cust_id=$coll->get($id)->container_key;
        $t1c++ if $cust_id =~ /test1_/;
        $t2c++ if $cust_id =~ /test2_/;
        $t3c++ if $cust_id =~ /test3_/;
        $t4c++ if $cust_id =~ /test4_/;
        dprint "$id $cust_id";
    }
    $self->assert($t1c == 1,
                  "Expected one occurance of test1, got $t1c");
    $self->assert($t2c == 1,
                  "Expected one occurance of test2, got $t2c");
    $self->assert($t3c == 1,
                  "Expected one occurance of test3, got $t3c");
    $self->assert($t4c == 1,
                  "Expected one occurance of test4, got $t4c");
}

##
# This is a testcase for a bug reported by Bil on 12/17/2002. It allows
# collection to get some sort of read-only clone object by passing array
# reference to collection get() method. Should throw an error instead!
#
sub test_bild_20021217 {
    my $self=shift;
    my $odb=$self->get_odb();

    my $clist=$odb->collection(class => 'Data::Customer');
    $self->assert(ref($clist),
                  "Can't create a collection");

    my $sr=$clist->search('customer_id','eq','c1');
    $self->assert(@$sr==1,
                  "Should have got a single value");
    
    my $pass;
    try {
        my $c=$clist->get($sr);
        $pass=0;
    }
    otherwise {
        my $e=shift;
        ## dprint "Expected error: $e";
        $pass=1;
    };
    $self->assert($pass,
                  "Managed to get an object by passing array reference to get()");
}

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

sub test_describe {
    my $self=shift;
    
    my $odb = $self->{odb};
    
    my $list=$odb->collection(class => 'Data::Customer');
    $self->assert($list, "Can't create Data::Customer collection");
    
    $self->assert(defined($list->can('describe')),
                  "Can't call function 'describe()' on the Collection object");

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

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

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

    my $clist=$odb->collection(class => 'Data::Customer');
    $self->assert(ref($clist),
                  "Can't create a collection");

    $self->assert($clist->objtype eq 'Collection',
                  "Objtype() is not 'Collection'");

    $self->assert($clist->objname eq 'FS::Collection',
                  "Objname() is not 'FS::Collection'");

    my @kk=$clist->keys;
    $self->assert(@kk == 2,
                  "Wrong number of items in the collection");

    my $c=$clist->get($kk[0]);
    $self->assert($c->objtype eq 'Hash',
                  "Got something wrong from collection");

    $self->assert($c->collection_key eq $kk[0],
                  "Wrong value returned by collection_key()");

    my $kn=$c->container_key();
    $self->assert($kn eq 'c1' || $kn eq 'c2',
                  "Container_key returned wrong value ($kn)");

    my $name='New Name';
    $c->put(name => $name);
    my $got=$c->get('name');
    $self->assert($got eq $name,
                  "Something wrong with the hash object we got ($got!=$name)");

    my $uri=$c->uri;
    $self->assert($uri && $uri =~ '/Customers/c?',
                  "Wrong URI ($uri)");
}

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

    my $c=$odb->fetch('/Customers/c2');
    $c->add_placeholder(name => 'Orders',
                        type => 'list',
                        class => 'Data::Order',
                        key => 'order_id',
                       );
    my $orders=$c->get('Orders');
    my $o=$orders->get_new();
    $o->add_placeholder(name => 'foo',
                        type => 'text');
    $o->put(foo => 'test');
    $orders->put($o);
    $o->put(foo => 'fubar');
    $orders->put($o);
    $o->put(foo => 'junk');
    $orders->put($o);

    my $coll=$odb->collection(class => 'Data::Order');
    $self->assert(ref($coll),
                  "Can't create a collection");

    $self->assert($coll->objtype eq 'Collection',
                  "Objtype() is not 'Collection'");

    $self->assert($coll->objname eq 'FS::Collection',
                  "Objname() is not 'FS::Collection'");

    my @kk=$coll->keys;
    $self->assert(@kk == 3,
                  "Wrong number of items in the collection");

    my $item=$coll->get($kk[1]);
    $self->assert($item->objtype eq 'Hash',
                  "Got something wrong from collection");

    my $foo='New Name';
    $item->put(foo => $foo);
    my $got=$item->get('foo');
    $self->assert($got eq $foo,
                  "Something wrong with the hash object we got ($got!=$foo)");

    my $uri=$item->uri;
    $self->assert($uri && $uri =~ '^/Customers/c2/Orders/',
                  "Wrong URI ($uri)");

    $item=$coll->get($kk[0]);
    $self->assert($item->objtype eq 'Hash',
                  "Got something wrong from collection");

    $item=$coll->get($kk[2]);
    $self->assert($item->objtype eq 'Hash',
                  "Got something wrong from collection");

    my $list=$coll->search('foo', 'cs', 'New');
    $self->assert($list && scalar(@$list),
                  "Wrong search results on collection");

    my $id=$list->[0];
    $item=$coll->get($id);
    $self->assert(ref($item),
                  "Can't get order reference using search results");

    $got=$item->get('foo');
    $self->assert($got =~ /New/,
                  "Wrong search results from collection ($got !~ /New/)");

    $foo='Super-Duper';
    $item->put(foo => $foo);
    $got=$item->get('foo');
    $self->assert($got eq $foo,
                  "Something wrong with the hash object we got ($got!=$foo)");
}

1;