#!/usr/bin/perl -w
# @(#) $Id: TestClass.pm,v 1.3 2003/07/16 16:26:41 dom Exp $
package TestClass::Base;

use strict;

use base qw( Class::DBI::ToSax Class::Data::Inheritable Class::Accessor );

use vars qw( %cache );

# This class is a simulation of a Class::DBI generated class.  It
# contains similiar enough methods to test Class::DBI::ToSax.

__PACKAGE__->mk_classdata( 'table' );
__PACKAGE__->mk_classdata( '_columns' );

sub columns {
    my $class = shift;
    $class->_columns( [@_] ) if @_;
    return @{ $class->_columns };
}

sub primary_column {
    my $class = shift;
    return ( $class->columns )[0];
}

sub id {
    my $self = shift;
    my $pk = $self->primary_column;
    return $self->$pk;
}

# All so we can support has_many()...
sub new {
    my $class = shift;
    my $self = $class->SUPER::new;
    my %args = @_;
    foreach my $method ( keys %args ) {
	$self->$method( $args{ $method } ) 
    }
    $cache{ $class }{ $self->id } = $self;
    return $self;
}

sub has_many {
    my $class = shift;

    # Ensure Class::DBI::ToSax gets to see it too.
    $class->SUPER::has_many( @_ );

    # And now set up ourselves.
    my ( $method, $otherclass ) = @_;
    no strict 'refs';
    *{ "${class}::$method" } = sub {
        my $self = shift;
        my $pk   = $self->primary_column;
        my $id   = $self->$pk;
        return
            grep { $_->$pk && $_->$pk->id == $id }
            values %{ $cache{ $otherclass } };
    };
}

#---------------------------------------------------------------------

# Our main testing vehicle.
package TestClass::Foo;

use strict;
use warnings;

use base qw( TestClass::Base );

__PACKAGE__->table( 'foo' );
__PACKAGE__->columns( qw( foo_id foo_name bar_id ) );
__PACKAGE__->has_a( bar_id => 'TestClass::Bar' );
__PACKAGE__->has_many( bazza => 'TestClass::Baz' );

__PACKAGE__->mk_accessors( __PACKAGE__->columns );

#---------------------------------------------------------------------

package TestClass::Bar;

use strict;
use warnings;

use base qw( TestClass::Base );

__PACKAGE__->table( 'bar' );
__PACKAGE__->columns( qw( bar_id bar_name ) );

__PACKAGE__->mk_accessors( __PACKAGE__->columns );

#---------------------------------------------------------------------

package TestClass::Baz;

use strict;
use warnings;

use base qw( TestClass::Base );

__PACKAGE__->table( 'baz' );
__PACKAGE__->columns( qw( baz_id baz_name foo_id ) );
__PACKAGE__->has_a( foo_id => 'TestClass::Foo' );

__PACKAGE__->mk_accessors( __PACKAGE__->columns );

package TestClass::MCPK;

use strict;
use warnings;

use base qw( TestClass::Base );

__PACKAGE__->table( 'mcpk' );
__PACKAGE__->columns( qw( id_a id_b ) );

__PACKAGE__->mk_accessors( __PACKAGE__->columns );

sub primary_column { qw( id_a id_b ) }

1;
__END__