ASCOPE::Class::Null - Aaron's dummy class thingy.
package Foo::Bar; use base qw (My::Class::DBI);
use ASCOPE::Class::Null;
__PACKAGE__->has_a(next_id => "Foo::Bar",
# We the next_id method for # this object is called execute # this subroutine: inflate => sub {
# Do we have a next_id? ($_[0]) ?
# Yes, return an object # of class Foo::Bae Foo::Bar->retrieve($_[0]) :
# No next_id. Return an # object which when tested # ( e.g. if($obj)) will return # false (specificall, nothing.) ASCOPE::Class::Null->new() });
This is a hack.
It was written to deal with a ``feature'' in Class::DBI that prevents you from doing stuff like setting up a next_id relationship with a class to itself.
Eventually, the last next_id in the chain will be 0 which will cause Class::DBI 's retrieve method to return undef which will cause the automagic relationship generator to blow it's brains out.
This may be the Right Way To Do It but it's also very annoying.
This package returns a blessed scalar reference to an undefined string and then overloads ``'' to return nothing. Which can be used in conjuction with Class::DBI 's inflate hooks to DWIM.
Although it was written with Class::DBI in mind, it may prove useful in other situations.
Since version 0.91 is not yet outta beta, you will either need to suffer it's shortcomings or override the _inflate_to_object method in your own Class::DBI subclass.
The following works for me:
sub _inflate_to_object { my ($col, $a_class, %meths) = @_; return sub { my $self = shift; return if not defined $self->{$col}; if (my $obj = ref $self->{$col}) { UNIVERSAL::isa($obj, $a_class) ? return : die "$obj is not a $a_class"; } my $get = $meths{'inflate'} || ($a_class->isa('Class::DBI') ? "retrieve" : "new"); my $obj = (ref $get eq "CODE") ? $get->($self->{$col}) : $a_class->$get($self->{$col}); return $self->_croak("Can't inflate $col to $a_class via $get using '$self->{$col}'") unless ref $obj; # use ref as $obj may be overloaded and appear 'false'
$self->{$col} = $obj; } }Your mileage may return undef.
1.1
$Date: 2003/03/09 14:36:43 $
Aaron Straup Cope
Copyright (c) 2003 Aaron Straup Cope. All Rights Reserved.
This is free software, you may use it and distribute it under the same terms as Perl itself.