in reply to Re: Re: Are array based objects fixed length?
in thread Are array based objects fixed length?

The problem with that approach is that it'd be horribly, horribly slow.

Yes it will be :-)

Maybe you could insert a DESTROY method into the targeted object, possibly aliasing any existing ones, and do the cleanup there?

Something like: 

if (ClassName->can('DESTROY') {
   *ClassName::OLD_DESTROY = \&ClassName::DESTROY;
   *ClassName::DESTROY = sub { 
       cleanup_object($_[0]);
       goto &$_[0]->DESTROY;
   }
}
else {
   *ClassName::DESTROY = \&cleanup_object($_[0]);
}

[download]

Update: this will not get you the object id... hmmm...

Joost frowns, going to get another cup of coffee 

-- 
Joost       downtime n. The period during which a system
            is error-free and immune from user input.

[download]

Replies are listed 'Best First'.
Re: Re: Re: Re: Are array based objects fixed length?
by pdcawley (Hermit) on Jul 26, 2002 at 11:19 UTC
    I think we're going to be doing something like that. Trouble is, we only want to override DESTROY for objects that have been fetched from or stored with Pixie, so you have to do it with something like: 
    my $anon_class = $self->get_anon_class;

eval "package $anon_class; use base qw/$target_class Pixie::Inner/"; 

$anon_class->object_info(Pixie::ObjectInfo->new(object_id => $oid);

bless $fetched_obj, $anon_class;

Pixie::Inner::object_info = sub { 
    my $proto = shift;
    my $class = ref($proto) || $proto;

    no strict 'refs';
    ${$class . "::object_info"} = shift if @_;
    return ${$class . "::object_info"};
}

Pixie::Inner::DESTROY {
    my $self = shift;
    my $class = ref $self;
    my $super_dest = $class . "::DESTROY";
    $self->$super_dest(); # Why doesn't UNIVERSAL::DESTROY exist alrea
+dy?
    $self->object_info(undef);

    delete $::{$class . "::"}
}

    [download]
    We stick with Pixie::ObjectInfo, because we only need these scary tricks when the object isn't a hash. And we wouldn't need them if Perl did DESTROYs properly and called *all* the DESTROYs in an objects hierarchy, one could just stick the stuff you need in UNIVERSAL (or a superclass of UNIVERSAL if you're feeling Damianesque), and perl would call them automatically. Bah. This will break horribly if someone reblesses. Unless they either bless back, or knew exactly what they were doing...
[reply]
[d/l]
      Trouble is, we only want to override DESTROY for objects that have been fetched from or stored with Pixie

      The code below reblesses the object into a new class that is based on it's existing class, establishing the necessary ISA relationships to make it work like before, yet call your DESTROY method. 
      package Pixie::objwrapper;

sub wrap {
        my $class = shift;
        my $obj = shift;
        my $obj_class = ref($obj);
        {
                no strict;
                @{"Pixie::objwrapper::${obj_class}::ISA"} = ('Pixie::o
+bjwrapper', $obj_class);
        }
        return bless $obj, "Pixie::objwrapper::$obj_class";
}

sub DESTROY {
        my $self = shift;
        print "wrapper->DESTROY\n";
        my $obj_class = ref($self);
        $obj_class =~ s/Pixie::objwrapper:://;
        if ($obj_class->can('DESTROY')) {
                $obj_class->DESTROY($self);
        }
}

      [download]
      UPDATE: Fixed some code that was uglier than necessary.

      -- O thievish Night, Why should'st thou, but for some felonious end, In thy dark lantern thus close up the stars? --Milton
[reply]
[d/l]
        Oh yes, of course. Because we're going to want this behaviour for every Pixie managed object of the class then all instances of that class can share the 'shadow' Pixie class. Thanks for that.

        BTW, your DESTROY still looks a bit wrong. Should probably be: 

        sub DESTROY {
    my $self = shift;
    print "wrapper->DESTROY\n";
    my $obj_class = ref($self);
    $obj_class =~ s/Pixie::objwrapper:://;
    if ( my $method = $obj_class->can('DESTROY') ) {
        $method->($self);
    }
}

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom