Might Have

[prev] [thread] [next] [Date index for 2005/02/23]

Hello all,

I tried using the might_have relationship and found behaviour
which suprised me, but may or may not be buggy.

I tried to delete and then access the deleted object.
In terms of the might have example:

 $cd->liner_notes->delete
 $cd->liner_notes;          # error not undef

 Operation `bool': no method found, argument in overloaded package 
 Class::DBI::Object::Has::Been::Deleted at 
 lib/Class/DBI/Relationship/MightHave.pm line 45.

I expected undef but upon looking at the code, saw the difficulty.
The patch included has a fix for this, but it's UGLY.  A better
approach may be a ->delete_liner_notes generated method.
If there's a way to cleanly delete the object I'd like to know.


There is another, simpler issue.  The line:
     my $val = shift or return;    # just fetching
prevents a false or undef value from creating a might_have linked
record.  I tried to set a score to '0' but no record was created.

Also @extra seems not to be used anymore (although if
$meta->foreign_class can return () then I'm wrong)

I half remember some might have development going on so these
problems are hopefully already solved.


Brad

For what it may be worth:

diff -Bub /usr/share/perl5/Class/DBI/Relationship/MightHave.pm ./lib/Class/DBI/Relationship/MightHave.pm
--- /usr/share/perl5/Class/DBI/Relationship/MightHave.pm        2004-04-26 01:33:36.000000000 +1000
+++ ./lib/Class/DBI/Relationship/MightHave.pm   2005-02-16 16:51:32.000000000 +1100
@@ -41,8 +41,11 @@
        return sub {
                my $self = shift;
                my $meta = $class->meta_info(might_have => $method);
-               my ($f_class, @extra) =
-                       ($meta->foreign_class, @{ $meta->args->{import} });
+               my $f_class = $meta->foreign_class;
+               if(ref($self->{"_${method}_object"}) 
+                               eq 'Class::DBI::Object::Has::Been::Deleted') {
+                       return $self->{"_${method}_object"} = undef;
+               }
                $self->{"_${method}_object"} ||= $f_class->retrieve($self->id);
        };
}
@@ -53,10 +56,10 @@
        return sub {
                my $self = shift;
                my $meta = $class->meta_info(might_have => $method);
-               my ($f_class, @extra) =
-                       ($meta->foreign_class, @{ $meta->args->{import} });
+               my $f_class = $meta->foreign_class;
                my $for_obj = $self->$method() || do {
-                       my $val = shift or return;    # just fetching
+                       return unless @_;    # just fetching
+                       my $val = shift;
                        $f_class->create({ $f_class->primary_column => $self->id, $name => $val });
                        $self->$method();
                };

        -- 
         By inconsistency and frivolity we stray from the Way and show ourselves
 to be beginners. In this we do much harm. 
                                    -- Hagakure http://bereft.net/hagakure/