/lib/KinoSearch/Object/Obj.pm

package KinoSearch::Object::Obj;
use KinoSearch;

1;

__END__

__BINDING__

my $xs_code = <<'END_XS_CODE';
MODULE = KinoSearch     PACKAGE = KinoSearch::Object::Obj

chy_bool_t
is_a(self, class_name)
    kino_Obj *self;
    const kino_CharBuf *class_name;
CODE:
{
    kino_VTable *target = kino_VTable_fetch_vtable(class_name);
    RETVAL = Kino_Obj_Is_A(self, target);
}
OUTPUT: RETVAL

void
STORABLE_freeze(self, ...)
    kino_Obj *self;
PPCODE:
{
    CHY_UNUSED_VAR(self);
    if (items < 2 || !SvTRUE(ST(1))) {
        SV *retval;
        kino_ByteBuf *serialized_bb;
        kino_RAMFileHandle *file_handle = kino_RAMFH_open(NULL, 
            KINO_FH_WRITE_ONLY | KINO_FH_CREATE, NULL);
        kino_OutStream *target = kino_OutStream_open((kino_Obj*)file_handle);

        Kino_Obj_Serialize(self, target);

        Kino_OutStream_Close(target);
        serialized_bb = Kino_RAMFile_Get_Contents(
            Kino_RAMFH_Get_File(file_handle));
        retval = XSBind_bb_to_sv(serialized_bb);
        KINO_DECREF(file_handle);
        KINO_DECREF(target);

        if (SvCUR(retval) == 0) { // Thwart Storable bug 
            THROW(KINO_ERR, "Calling serialize produced an empty string");
        }
        ST(0) = sv_2mortal(retval);
        XSRETURN(1);
    }
}

=begin comment

Calls deserialize(), and copies the object pointer.  Since deserialize is an
abstract method, it will confess() unless implemented.

=end comment
=cut

void
STORABLE_thaw(blank_obj, cloning, serialized_sv)
    SV *blank_obj;
    SV *cloning;
    SV *serialized_sv;
PPCODE:
{
    char *class_name = HvNAME(SvSTASH(SvRV(blank_obj)));
    kino_ZombieCharBuf *klass 
        = CFISH_ZCB_WRAP_STR(class_name, strlen(class_name));
    kino_VTable *vtable = (kino_VTable*)kino_VTable_singleton(
        (kino_CharBuf*)klass, NULL);
    STRLEN len;
    char *ptr = SvPV(serialized_sv, len);
    kino_ViewByteBuf *contents = kino_ViewBB_new(ptr, len);
    kino_RAMFile *ram_file = kino_RAMFile_new((kino_ByteBuf*)contents, true);
    kino_RAMFileHandle *file_handle 
        = kino_RAMFH_open(NULL, KINO_FH_READ_ONLY, ram_file);
    kino_InStream *instream = kino_InStream_open((kino_Obj*)file_handle);
    kino_Obj *self = Kino_VTable_Foster_Obj(vtable, blank_obj);
    kino_Obj *deserialized = Kino_Obj_Deserialize(self, instream);

    CHY_UNUSED_VAR(cloning);
    KINO_DECREF(contents);
    KINO_DECREF(ram_file);
    KINO_DECREF(file_handle);
    KINO_DECREF(instream);

    // Catch bad deserialize() override. 
    if (deserialized != self) {
        THROW(KINO_ERR, "Error when deserializing obj of class %o", klass);
    }
}

void
DESTROY(self)
    kino_Obj *self;
PPCODE:
    /*
    {
        char *perl_class = HvNAME(SvSTASH(SvRV(ST(0))));
        warn("Destroying: 0x%x %s", (unsigned)self, perl_class);
    }
    */
    Kino_Obj_Destroy(self);
END_XS_CODE

my $synopsis = <<'END_SYNOPSIS';
    package MyObj;
    use base qw( KinoSearch::Object::Obj );
    
    # Inside-out member var.
    my %foo;
    
    sub new {
        my ( $class, %args ) = @_;
        my $foo = delete $args{foo};
        my $self = $class->SUPER::new(%args);
        $foo{$$self} = $foo;
        return $self;
    }
    
    sub get_foo {
        my $self = shift;
        return $foo{$$self};
    }
    
    sub DESTROY {
        my $self = shift;
        delete $foo{$$self};
        $self->SUPER::DESTROY;
    }
END_SYNOPSIS

my $description = <<'END_DESCRIPTION';
All objects in the KinoSearch:: hierarchy descend from
KinoSearch::Object::Obj.  All classes are implemented as blessed scalar
references, with the scalar storing a pointer to a C struct.

==head2 Subclassing

The recommended way to subclass KinoSearch::Object::Obj and its descendants is
to use the inside-out design pattern.  (See L<Class::InsideOut> for an
introduction to inside-out techniques.)

Since the blessed scalar stores a C pointer value which is unique per-object,
C<$$self> can be used as an inside-out ID.

    # Accessor for 'foo' member variable.
    sub get_foo {
        my $self = shift;
        return $foo{$$self};
    }


Caveats:

==over

==item *

Inside-out aficionados will have noted that the "cached scalar id" stratagem
recommended above isn't compatible with ithreads -- but KinoSearch doesn't
support ithreads anyway, so it doesn't matter.

==item *

Overridden methods must not return undef unless the API specifies that
returning undef is permissible.  (Failure to adhere to this rule currently
results in a segfault rather than an exception.)

==back

==head1 CONSTRUCTOR

==head2 new()

Abstract constructor -- must be invoked via a subclass.  Attempting to
instantiate objects of class "KinoSearch::Object::Obj" directly causes an
error.

Takes no arguments; if any are supplied, an error will be reported.

==head1 DESTRUCTOR

==head2 DESTROY

All KinoSearch classes implement a DESTROY method; if you override it in a
subclass, you must call C<< $self->SUPER::DESTROY >> to avoid leaking memory.
END_DESCRIPTION

Clownfish::Binding::Perl::Class->register(
    parcel       => "KinoSearch",
    class_name   => "KinoSearch::Object::Obj",
    xs_code      => $xs_code,
    bind_methods => [
        qw(
            Get_RefCount
            Inc_RefCount
            Dec_RefCount
            Get_VTable
            To_String
            To_I64
            To_F64
            Dump
            _load|Load
            Clone
            Mimic
            Equals
            Hash_Sum
            Serialize
            Deserialize
            Destroy
            )
    ],
    bind_constructors => ["new"],
    make_pod          => {
        synopsis    => $synopsis,
        description => $description,
        methods     => [
            qw(
                to_string
                to_i64
                to_f64
                equals
                dump
                load
                )
        ],
    }
);

__COPYRIGHT__

Copyright 2005-2011 Marvin Humphrey

This program is free software; you can redistribute it and/or modify
under the same terms as Perl itself.