The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Myco::Test::EntityTest;

###############################################################################
# $Id: EntityTest.pm,v 1.3 2006/03/19 19:34:08 sommerb Exp $
#
# See license and copyright near the end of this file.
###############################################################################

=head1 NAME

Myco::Test::EntityTest - base class for Myco entity test classes

---these docs need expansion---

=head1 SYNOPSIS

 ### Set up an entity test class (don't do this by hand!  Use myco-mkentity!)
 ###

 package Myco::Foo::Test;

 use base qw(Test::Unit::TestCase Myco::Test::EntityTest);

 # This class tests features of:
 my $class = 'Myco::Foo';

 my %test_parameters =
  ###  Test Control Prameters ###
  (
   # A scalar attribute that can be used for testing... set to undef
   #    to disable related tests
   simple_accessor => 'fooattrib',

   # Default attribute values for use when constructing objects
   #    Needed for any 'required' attributes
   defaults =>
       {
	name => 'a value',
	# Use a coderef to auto-instantiate sub-objects for ref-type
	#   attributes
	type => sub {
                   my $test = shift;
	            my $foo = Myco::Foo->new(name => 'bar');
	            # Make sure sub-object gets removed after test
		    $test->destroy_upon_cleanup($foo);
		    $foo;
		},
      },
  );

 # Example test method
 sub test_bar {
     my $test = shift;
     $test->set_type_persistence(1);  # note that this test uses the db
     return if $test->should_skip;    # skip over this test if asked

     # Create entity object with any required attributes as specified
     # in %test_parameters{defaults}
     my $obj = $test->new_testable_entity;
     $obj->save;           # save to persistent storage, if you like

     # ...do something...
     $test->assert( __something__, "no can-do");

     # Use the following to have Entity objects auto-deleted after
     # test is run
     $test->destroy_upon_cleanup($obj);
 }


 ### Running tests
 ###

 $ cd $MYCO_DISTRIB/driver
 $ ./myco-testrun Myco::Foo::Test [-T]       # run tests
                                        # '-T' enables Tangram trace mode
 $ ./tkmyco-testrun Myco::Foo::Test          # run tests, GUI style

=cut

use strict;
use base qw(Myco::Test::Fodder);
use constant ACCESSOR_VAL => 123456;

###
### Unit Tests for all Myco classes!
###

##
##   Tests of In-Memory Behavior

sub test_new_empty {
    my $test = shift;
    my $class = $test->get_class;
    my $obj;
    my $reqs = $class->required_attributes;
    if (my $numreq = keys %$reqs) {
	my $reqs_w_init = 0;
	my $inits = $class->init_defaults;
	for my $reqattr (keys %$reqs) {
	    if (exists $inits->{$reqattr}) {
		$reqs_w_init++;  # Count number of $reqs having an init_default
	    }
	}
	# There are required attributes.
	eval { $obj = $class->new };
	$test->assert($@ || $reqs_w_init == $numreq,
		      "calling new() without required attributes "
		      ."should result in an exception");
	eval { $obj = $test->new_testable_entity };
	$test->assert(! $@, "exception when calling new() with default "
		           ."test attributes:  $@");
	$test->assert(defined $obj, 'no object returned by new() test args');
    } else {
	eval { $obj = $class->new };
	$test->assert(! $@, "unexpected exception when calling new() "
		           ."called with no args: $@");
	$test->assert(defined $obj, 'no object returned by new() w/no args');
    }
}

sub test_new_bogus_args {
    my $test = shift;
    eval { $test->new_testable_entity(foo => "blah"); };
    $test->assert($@);
}

sub test_accessor {
    my $test = shift;
    my $obj = $test->new_testable_entity;
    my $simple_accessor = $test->get_params->{simple_accessor};
    return unless $simple_accessor;
    my $simple_setter = 'set_' . $simple_accessor;
    my $simple_getter = 'get_' . $simple_accessor;
    my $val = $obj->$simple_getter;
    $val = '' unless defined $val;
    $test->assert($val ne "5551212");
    $obj->$simple_setter("5551212");
    $test->assert($obj->$simple_getter eq "5551212");
}

##
##   Tests of Persistence Behavior

sub test_save {
    my $test = shift;
    $test->set_type_persistence(1);
    return if $test->should_skip;    # skip over this test if asked

    my ($id, $id2, @create_args, $attrib, $setter, $getter);
    if ($attrib = $test->get_params->{simple_accessor}) {
	@create_args = ($attrib => ACCESSOR_VAL);
	$setter = 'set_'.$attrib;
	$getter = 'get_'.$attrib;
    };

    {
	my $obj = $test->new_testable_entity(@create_args);
	$test->assert( $id = $obj->save, 'false return from ->save' );
	Myco->unload($obj);
    }
    $test->assert(! Myco->is_transient($id),
		  '$obj is was not removed from transient storage' );

    {
#        DBI->trace(2);
	my $obj = Myco->load($id);
#        DBI->trace(0);
	$test->assert(defined $obj, 'object not reloaded');
	if ($attrib) {
	    $test->assert((my $val = $obj->$getter) == ACCESSOR_VAL,
			  'object missing expected attribute');
	    $obj->$setter($val - 2000);
	    $id2 = $obj->save;
	    $test->assert($id == $id2,
			  'unexpected id returned upon object update');
	}
	Myco->unload($obj);
    }

    my $obj = Myco->load($id);
    $test->assert(defined $obj, 'object not reloaded at last stage');
    if ($attrib) {
	$test->assert($obj->$getter == ACCESSOR_VAL - 2000,
		      'object update failed');
    }
    $test->destroy_upon_cleanup($obj);
}


# Testing both $obj->destroy and Myco->destroy($obj) usage;
sub test_destroy {
    my $test = shift;
    $test->set_type_persistence(1);
    return if $test->should_skip;    # skip over this test if asked

    my $obj = $test->new_testable_entity;
    my $class = $test->get_class;
    $test->assert($obj->isa($class),
		  "m'obj ain't of class $class, it's a". ref $obj );
    my $id = Myco->insert($obj);
    # Instance method syntax
    $obj->destroy;
    $test->assert(! Myco->is_transient($id),
		  'not cleared from transient storage' );
    $test->assert( ! defined Myco->load($id),
		   'not cleared from persistent storage' );
    $test->assert( ! defined $obj, '$obj still defined' );
    # Class (Myco) method syntax
    undef $obj;
    $obj = $test->new_testable_entity;
    $id = Myco->insert($obj);
    Myco->destroy($obj);
    $test->assert( ! defined $obj, 'Class meth:  $obj made undef' );
    $test->assert(! Myco->is_transient($obj),
		  'Class meth:  not cleared from transient storage' );
    $test->assert(! defined Myco->load($id),
		   'Class meth:  not cleared from persistent storage' );
}


sub test_id {
    my $test = shift;
    $test->set_type_persistence(1);
    return if $test->should_skip;    # skip over this test if asked

    my $id = Myco->insert( my $obj = $test->new_testable_entity );
    my $id2 = $obj->id;
    $test->assert( $id == $id2,
		   "incorrect id value returned:  $id\n\t\texpecting:  $id" );
    $test->destroy_upon_cleanup($obj);
}


1;
__END__


=head1 DESCRIPTION

Base class for all Myco entity test classes.  An entity test class benefits
in two ways:

=over 3

=item *

It is tied into a Test::Unit::TestCase-based framework which takes care of
database connection worries and various other concerns.

=item *

It inherits a collection of canned tests that will automatically get run along
with any tests unique to a given entity.

=back

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2006 the myco project. All rights reserved.
This software is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Charles Owens <owensc@enc.edu>

=head1 SEE ALSO

L<Myco::Entity|Myco::Entity>,
L<Myco::Test::Suite|Myco::Test::Suite>,
L<myco-testrun|testrun>,
L<tkmyco-testrun|tktestrun>,
L<Test::Unit::TestCase|Test::Unit::TestCase>

=cut