# -*-perl-*-

# $Id: base.t 267 2006-09-12 18:02:00Z jonasbn $

use strict;
use lib 't';
use TestUtil;
use Test::More  tests => 26;

require_ok( 'Workflow::Base' );

my $b = Workflow::Base->new();
is( ref( $b ), 'Workflow::Base',
    'Object created of correct type' );
is( ref $b->{PARAMS}, 'HASH',
    'Internal parameter storage created' );
is( scalar keys %{ $b->{PARAMS} }, 0,
    'No parameters set' );
my $b_hash = $b->param;
is( ref( $b_hash ), 'HASH',
    'All parameter call returns hashref' );
is( scalar keys %{ $b_hash }, 0,
    'No parameters set in all parameter call' );
is( $b->param( 'foo' ), undef,
    'Parameter call to nonexistent key returns undef' );
is( $b->param( foo => 'bar' ), 'bar',
    'Parameter call with single value set returns value' );
is( $b->param( 'foo' ), 'bar',
    'Parameter call to existent key returns proper value' );
my $b_all_hash = $b->param({ baz => 'quux', blah => 'blech' });
is( ref( $b_all_hash ), 'HASH',
    'Parameter call with multiple keys and values returns hashref' );
is( scalar keys %{ $b_all_hash }, 3,
    'Proper number of parameters after multiple values set' );
is( $b->param( 'baz' ), 'quux',
    'Multiple parameter set value 1 ok' );
is( $b->param( 'blah' ), 'blech',
    'Multiple parameter set value 2 ok' );
is( $b->delete_param('baz'), 'quux',
    'Delete one parameter' );
is( $b->param( 'baz' ), undef,
    'Parameter call to nonexistent key returns undef' );
my $list = $b->delete_param(['blah']);
is ( $list->{'blah'}, 'blech',
    'Deleted several parameters' );
is( $b->param( 'blah' ), undef,
    'Parameter call to nonexistent key returns undef' );
ok( $b->clear_params,
    'Cleared param call executed ok' );
is( scalar keys %{ $b->param }, 0,
    'All parameters cleared' );

create_subclass();

my $b_params = My::Workflow::Base->new({
    param => [ { name => 'foo', value => 'bar' },
               { name => 'baz', value => 'quux' } ],
    green => 'grimy gophers',
});
is( ref( $b_params ), 'My::Workflow::Base',
    'Constructor using multiple generic params returned correct subclass' );
is( $b_params->param( 'foo' ), 'bar',
    'Generic param value 1 (set via init()) ok' );
is( $b_params->param( 'baz' ), 'quux',
    'Generic param value 2 (set via init()) ok' );
is( $b_params->param( 'green' ), 'grimy gophers' ,
    'Named param value (set via init()) ok' );

my @no_items   = $b_params->normalize_array();
is( scalar @no_items, 0,
    'Empty array normalized to empty array' );
my @list_items = $b_params->normalize_array( 'foo' );
is( scalar @list_items, 1,
    'List of one item normalized to array of proper size' );
my @ref_items  = $b_params->normalize_array( [ 'foo', 'bar', 'baz' ] );
is( scalar @ref_items, 3,
    'List reference normalized to array of proper size' );


# Test out 'init()' call of subclass

sub create_subclass {
    my $subclass = <<'SUBCLASS';
package My::Workflow::Base;

use strict;
use base qw( Workflow::Base );

sub init {
    my ( $self, $params ) = @_;
    while ( my ( $k, $v ) = each %{ $params } ) {
        $self->param( $k => $v );
    }
}

1;
SUBCLASS
    eval $subclass;
    if ( $@ ) {
        die "Cannot eval subclass on the fly: $@";
    }
}