/usr/local/CPAN/XAO-Base/testcases/DOConfig.pm

• package testcases::DOConfig
  • test_base
  • test_project
  • test_double
  • test_error
  • test_cache
• EOF

package testcases::DOConfig;
use strict;
use XAO::Utils;
use XAO::SimpleHash;
use XAO::Projects;
use XAO::Objects;
use Error qw(:try);

use base qw(testcases::base);

sub test_base {
    my $self=shift;

    my $config=XAO::Objects->new(objname => 'Config', baseobj => 1);
    $self->assert(ref($config),
                  "Can't get config");

    my $hash=XAO::SimpleHash->new(foo => 'bar');
    $self->assert(ref($hash),
                  "Can't get SimpleHash object");

    $config->embed('hash' => $hash);

    my $got=$config->get('foo');
    $self->assert($got eq 'bar',
                  "Got wrong value from config -- '$got' ne 'bar'");

    $config->put('test' => 123);
    $got=$config->get('test');
    $self->assert($got == 123,
                  "Got wrong value after put -- '$got' != 123");

    $got=join(',',sort $config->keys);
    $self->assert($got eq 'foo,test',
                  "Got wrong keys from config -- '$got' ne 'foo,test'");

    $self->assert(ref($config->embedded('hash')) eq 'XAO::SimpleHash',
                  "Can't use embedded() to get an object");
}

sub test_project {
    my $self=shift;

    my $config=XAO::Objects->new(objname => 'Config', sitename => 'test');
    $self->assert(ref($config),
                  "Can't get config");

    XAO::Projects::create_project(
        name => 'test',
        object => $config,
        set_current => 1
    );

    $config->init();

    my $got=$config->fubar('123');
    $self->assert($got eq 'X123X',
                  "Execution chain does not work for siteobj ($got ne X123X)");

    $self->assert($config->get('LocalConfig') == 1,
                  "Initialization did not make it to the local config");

    $self->assert(ref($config->check) eq ref($config),
                  "Error using base_config() method");

    $config->cleanup();
}

sub test_double {
    my $self=shift;

    my $c1=XAO::Objects->new(objname => 'Config', baseobj => 1);
    $self->assert(ref($c1),
                  "Can't get c1");
    $c1->embed('hash' => XAO::SimpleHash->new);

    my $c2=XAO::Objects->new(objname => 'Config', baseobj => 1);
    $self->assert(ref($c2),
                  "Can't get c2");
    $c2->embed('hash' => XAO::SimpleHash->new);
}

sub test_error {
    my $self=shift;

    use XAO::Errors qw(XAO::E::DO::Config);

    my $c=XAO::Objects->new(objname => 'Config', baseobj => 1);

    my $errstr;
    try {
        $c->embedded('foo');
        $errstr="Not failed where it should";
    }
    catch XAO::E::DO::Config with {
        $errstr='';
    }
    otherwise {
        my $e=shift;
        $errstr="Unexpected error (".ref($e)." -- $e)";
    };

    $self->assert($errstr eq '',
                  $errstr);
}

sub test_cache {
    my $self=shift;

    my $config=XAO::Objects->new(objname => 'Config', baseobj => 1);
    $self->assert(ref($config),
                  "Can't get config");

    ##
    # Define cache
    #
    $config->cache(
        name        => 'test',
        coords      => [ 'foo' ],
        retrieve    => sub {
            my $args=get_args(\@_);
            return '>' . $args->{foo} . '<';
        },
    );

    ##
    # Now pretend that it is called someplace else with different
    # parameters. They should be ignored.
    #
    my $cache=$config->cache(
        name        => 'test',
        coords      => [ 'bar' ],
        retrieve    => sub {
            return 'BAD';
        },
    );
    my $got=$cache->get(foo => '123');
    my $expect='>123<';
    $self->assert($got eq $expect,
                  "Got wrong data from the cache ($got), expected $expect");

    ##
    # Now just giving the name
    #
    $cache=$config->cache(name => 'test');
    $got=$cache->get(foo => 'qwe');
    $expect='>qwe<';
    $self->assert($got eq $expect,
                  "Got wrong data from the cache ($got), expected $expect");
}

1;