#!/usr/bin/perl -w

# Note - I create a bunch of classes in these tests and then change
# their valid_params() and contained_objects() lists several times.
# This isn't really supported behavior of this module, but it's
# necessary to do it in the tests.

use strict;

use Test;

use Class::Container;
use Params::Validate qw(:types);
use File::Spec;
require File::Spec->catfile('t', 'classes.pl');

my $HAVE_WEAKEN = 0 + exists $INC{'Scalar/Util.pm'};

plan tests => 67 + 1*$HAVE_WEAKEN;

use Carp; $SIG{__DIE__} = \&Carp::confess;

eval {new Daughter(hair => 'long')};
ok $@, '', "Try making an object";

eval {new Parent()};
ok $@, '/mood/', "Should fail, missing required parameter";

my %args = (parent_val => 7,
	    mood => 'bubbly');

eval {new Parent(%args)};
ok $@, '', "Try creating top-level object";

my $mood = eval {Parent->new(%args)->{son}->{mood}};
ok $mood, 'bubbly';
ok $@, '', "Make sure sub-objects are created with proper values";

if ($HAVE_WEAKEN) {
  my $p = Parent->new(%args);
  ok $p->{son}->container, $p, "Container of son should be parent";
}

eval {my $p = new Parent(%args);
      $p->create_delayed_object('daughter')};
ok $@, '', "Create a delayed object";

my $d = eval {Parent->new(%args)->create_delayed_object('daughter', hair => 'short')};
ok $@, '', "Create a delayed object with parameters";
ok $d->{hair}, 'short', "Make sure parameters are propogated to delayed object";

eval {new Daughter(foo => 'invalid')};
ok $@, '/Daughter/', "Make sure error messages contain the name of the class";

# Make sure we can override class names
{
  ok my $p = eval {new Parent(mood => 'foo', parent_val => 1,
			      daughter_class => 'StepDaughter',
			      toy_class => 'Ball',
			      other_toys_class => 'Streamer',
			      son_class => 'StepSon')};
  warn $@ if $@;

  my $d = eval {$p->create_delayed_object('daughter')};
  ok $@, '';

  ok ref($d), 'StepDaughter';
  ok ref($p->{son}), 'StepSon';

  # Note - if one of these fails and the other succeeds, then we're
  # not properly passing 'toy_class' to both son & daughter classes.
  ok ref($d->{toy}), 'Ball';
  ok ref($p->{son}{toy}), 'Ball';

  ok $d->delayed_object_class('other_toys'), 'Streamer';
  ok $p->{son}->delayed_object_class('other_toys'), 'Streamer';

  # Special 'container' parameter shouldn't be shared among objects
  ok ($p->{container} ne $p->{son}{container});

  # Check some of the formatting of show_containers()
  my $string = $p->show_containers;
  ok $string, '/\n  son -> StepSon/', $string;
}


{
  # Check that subclass contained_objects override superclass

  local @Superclass::ISA = qw(Class::Container);
  local @Subclass::ISA = qw(Superclass);
  'Superclass'->valid_params( foo => {isa => 'Foo'} );
  'Subclass'->valid_params(   foo => {isa => 'Bar'} );
  'Superclass'->contained_objects( foo => 'Foo' );
  'Subclass'->contained_objects(   foo => 'Bar' );
  local @Bar::ISA = qw(Foo);
  sub Foo::new { bless {}, 'Foo' }
  sub Bar::new { bless {}, 'Bar' }

  my $child = 'Subclass'->new;
  ok ref($child->{foo}), 'Bar', 'Subclass contained_object should override superclass';

  my $spec = 'Subclass'->validation_spec;
  ok $spec->{foo}{isa}, 'Bar';
}

{
  local @Top::ISA = qw(Class::Container);
  'Top'->valid_params(      document => {isa => 'Document'} );
  'Top'->contained_objects( document => 'Document',
			    collection => {class => 'Collection', delayed => 1} );
  
  local @Collection::ISA = qw(Class::Container);
  'Collection'->contained_objects( document => {class => 'Document', delayed => 1} );
  
  local @Document::ISA = qw(Class::Container);
  local @Document2::ISA = qw(Document);
  
  my $k = new Top;
  print $k->show_containers;
  ok $k->contained_class('document'), 'Document';
  my $collection = $k->create_delayed_object('collection');
  ok ref($collection), 'Collection';
  ok $collection->contained_class('document'), 'Document';

  my $string = $k->show_containers;
  ok $string, '/ collection -> Collection \(delayed\)/';
  ok $string, '/  document -> Document \(delayed\)/';

  my $k2 = new Top(document_class => 'Document2');
  print $k2->show_containers;
  ok $k2->contained_class('document'), 'Document2';
  my $collection2 = $k2->create_delayed_object('collection');
  ok ref($collection2), 'Collection';
  ok $collection2->contained_class('document'), 'Document2';

  my $string2 = $k2->show_containers;
  ok $string2, '/ collection -> Collection \(delayed\)/';
  ok $string2, '/  document -> Document2 \(delayed\)/';
}

{
  local @Top::ISA = qw(Class::Container);
  'Top'->valid_params( document => {isa => 'Document1'} );
  'Top'->contained_objects( document => 'Document1' );
  
  my $contained = 'Top'->get_contained_object_spec;
  ok  $contained->{document};
  ok !$contained->{collection}; # Shouldn't have anything left over from the last block
  
  local @Document1::ISA = qw(Class::Container);
  'Document1'->valid_params( doc1 => {type => SCALAR} );
  
  local @Document2::ISA = qw(Class::Container);
  'Document2'->valid_params( doc2 => {type => SCALAR} );
  
  my $allowed = 'Top'->allowed_params();
  ok  $allowed->{doc1};
  ok !$allowed->{doc2};
  
  $allowed = 'Top'->allowed_params( document_class => 'Document2' );
  ok  $allowed->{doc2};
  ok !$allowed->{doc1};
}

{
  local @Top::ISA = qw(Class::Container);
  'Top'->_expire_caches;
  'Top'->valid_params( document => {isa => 'Document1'} );
  'Top'->contained_objects( document => 'Document1' );
  
  local @Document1::ISA = qw(Class::Container);
  'Document1'->valid_params();
  local @Document2::ISA = qw(Document1);
  'Document2'->valid_params();
  
  my $t = new Top( document => bless {}, 'Document2' );
  ok $t;
  ok ref($t->{document}), 'Document2';
}

{
  local @Top::ISA = qw(Class::Container);
  'Top'->valid_params( document => {isa => 'Document'} );
  'Top'->contained_objects( document => 'Document' );
  
  local @Document::ISA = qw(Class::Container);
  'Document'->valid_params( sub => {isa => 'Class::Container'} );
  'Document'->contained_objects( sub => 'Sub1' );
  
  local @Sub1::ISA = qw(Class::Container);
  'Sub1'->valid_params( bar => {type => SCALAR} );
  'Sub1'->contained_objects();

  local @Sub2::ISA = qw(Class::Container);
  'Sub2'->valid_params( foo => {type => SCALAR} );
  'Sub2'->contained_objects();
  
  my $allowed = 'Top'->allowed_params();
  ok  $allowed->{document};
  ok  $allowed->{bar};
  ok !$allowed->{foo};
  
  $allowed = 'Top'->allowed_params(sub_class => 'Sub2');
  ok  $allowed->{document};
  ok !$allowed->{bar};
  ok  $allowed->{foo};
}

{
  local @Top::ISA = qw(Class::Container);
  Top->valid_params(foo => {type => SCALAR});
  Top->contained_objects();
  
  ok 'Top'->valid_params;
  ok 'Top'->valid_params->{foo}{type}, SCALAR;
}

{
  local @Top::ISA = qw(Class::Container);
  Top->valid_params(foo => {type => SCALAR}, child => {isa => 'Child'});
  Top->contained_objects(child => 'Child');
  
  local @Child::ISA = qw(Class::Container);
  Child->valid_params(bar => {type => SCALAR}, grand_child => {isa => 'GrandChild'});
  Child->contained_objects(grand_child => 'GrandChild');
  
  local @GrandChild::ISA = qw(Class::Container);
  GrandChild->valid_params(baz => {type => SCALAR}, boo => {default => 5});
  GrandChild->contained_objects();

  local @GrandSibling::ISA = qw(GrandChild);

  my $dump = GrandSibling->new(baz => 'BAZ')->dump_parameters;
  ok keys(%$dump), 2;
  ok $dump->{baz}, 'BAZ', "Sibling has baz=BAZ";
  ok $dump->{boo}, 5, "Sibling has boo=5";

  $dump = Child->new(bar => 'BAR', baz => 'BAZ')->dump_parameters;
  ok keys(%$dump), 3;
  ok $dump->{bar}, 'BAR';
  ok $dump->{baz}, 'BAZ';

  $dump = Child->new(bar => 'BAR', baz => 'BAZ', grand_child_class => 'GrandChild')->dump_parameters;
  ok keys(%$dump), 3;
  ok $dump->{bar}, 'BAR';
  ok $dump->{baz}, 'BAZ';
  
  $dump = Top->new(foo => 'FOO', bar => 'BAR', baz => 'BAZ')->dump_parameters;
  ok keys(%$dump), 4;
  ok $dump->{foo}, 'FOO';
  ok $dump->{bar}, 'BAR';
  ok $dump->{baz}, 'BAZ';
  
  
  # Test default values in a delayed object
  Top->valid_params(undef);
  Top->contained_objects(child => {class => 'Child', delayed => 1});
  
  Child->valid_params(bar => {default => 4});
  Child->contained_objects();

  $dump = Top->new()->dump_parameters;
  ok keys(%$dump), 1;
  ok $dump->{bar}, 4;
  
  $dump = Top->new(bar => 6)->dump_parameters;
  ok keys(%$dump), 1;
  ok $dump->{bar}, 6;
}

{
  # Make sure a later call to valid_params() clears the param list
  local @Top::ISA = qw(Class::Container);
  Top->valid_params(undef);
  Top->contained_objects();
  
  ok eval{ new Top };
}

{
  # Make sure valid_params() gives sensible null output
  local @Nonexistent::ISA = qw(Class::Container);
  my $params = Nonexistent->valid_params;
  ok ref($params), 'HASH';
  ok keys(%$params), 0;
}