Subclassing

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

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

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

Caveats:

• Inside-out aficionados will have noted that the "cached scalar id" stratagem recommended above isn't compatible with ithreads.

• 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.)

CONSTRUCTOR

new()

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

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

DESTRUCTOR

DESTROY

All Clownfish classes implement a DESTROY method; if you override it in a subclass, you must call $self->SUPER::DESTROY to avoid leaking memory. END_DESCRIPTION $pod_spec->set_synopsis($synopsis); $pod_spec->set_description($description); $pod_spec->add_method( method => $_, alias => lc($_) ) for @exposed;

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

bool is_a(self, class_name) cfish_Obj *self; cfish_String *class_name; CODE: { cfish_Class *target = cfish_Class_fetch_class(class_name); RETVAL = CFISH_Obj_Is_A(self, target); } OUTPUT: RETVAL END_XS_CODE

my $binding = Clownfish::CFC::Binding::Perl::Class->new(
    parcel     => "Clownfish",
    class_name => "Clownfish::Obj",
);
$binding->bind_method(
    alias  => 'DESTROY',
    method => 'Destroy',
);
$binding->exclude_method($_) for @hand_rolled;
$binding->append_xs($xs_code);
$binding->set_pod_spec($pod_spec);

Clownfish::CFC::Binding::Perl::Class->register($binding);
}

sub bind_varray { my @hand_rolled = qw( Shallow_Copy Shift Pop Delete Store Fetch );

my $xs_code = <<'END_XS_CODE';
MODULE = Clownfish   PACKAGE = Clownfish::VArray

SV* shallow_copy(self) cfish_VArray *self; CODE: RETVAL = CFISH_OBJ_TO_SV_NOINC(CFISH_VA_Shallow_Copy(self)); OUTPUT: RETVAL

SV* _clone(self) cfish_VArray *self; CODE: RETVAL = CFISH_OBJ_TO_SV_NOINC(CFISH_VA_Clone(self)); OUTPUT: RETVAL

SV* shift(self) cfish_VArray *self; CODE: RETVAL = CFISH_OBJ_TO_SV_NOINC(CFISH_VA_Shift(self)); OUTPUT: RETVAL

SV* pop(self) cfish_VArray *self; CODE: RETVAL = CFISH_OBJ_TO_SV_NOINC(CFISH_VA_Pop(self)); OUTPUT: RETVAL

SV* delete(self, tick) cfish_VArray *self; uint32_t tick; CODE: RETVAL = CFISH_OBJ_TO_SV_NOINC(CFISH_VA_Delete(self, tick)); OUTPUT: RETVAL

void store(self, tick, value); cfish_VArray *self; uint32_t tick; cfish_Obj *value; PPCODE: { if (value) { CFISH_INCREF(value); } CFISH_VA_Store_IMP(self, tick, value); }

SV* fetch(self, tick) cfish_VArray *self; uint32_t tick; CODE: RETVAL = CFISH_OBJ_TO_SV(CFISH_VA_Fetch(self, tick)); OUTPUT: RETVAL END_XS_CODE

my $binding = Clownfish::CFC::Binding::Perl::Class->new(
    parcel     => "Clownfish",
    class_name => "Clownfish::VArray",
);
$binding->exclude_method($_) for @hand_rolled;
$binding->append_xs($xs_code);

Clownfish::CFC::Binding::Perl::Class->register($binding);
}

sub bind_class { my $xs_code = <<'END_XS_CODE'; MODULE = Clownfish PACKAGE = Clownfish::Class

SV* _get_registry() CODE: if (cfish_Class_registry == NULL) { cfish_Class_init_registry(); } RETVAL = (SV*)CFISH_Obj_To_Host((cfish_Obj*)cfish_Class_registry); OUTPUT: RETVAL

SV* fetch_class(unused_sv, class_name_sv) SV *unused_sv; SV *class_name_sv; CODE: { STRLEN size; char *ptr = SvPVutf8(class_name_sv, size); cfish_StackString *class_name = CFISH_SSTR_WRAP_UTF8(ptr, size); cfish_Class *klass = cfish_Class_fetch_class((cfish_String*)class_name); CFISH_UNUSED_VAR(unused_sv); RETVAL = klass ? (SV*)CFISH_Class_To_Host(klass) : &PL_sv_undef; } OUTPUT: RETVAL

SV* singleton(unused_sv, ...) SV *unused_sv; CODE: { cfish_String *class_name = NULL; cfish_Class *parent = NULL; cfish_Class *singleton = NULL; bool args_ok = XSBind_allot_params(&(ST(0)), 1, items, ALLOT_OBJ(&class_name, "class_name", 10, true, CFISH_STRING, alloca(cfish_SStr_size())), ALLOT_OBJ(&parent, "parent", 6, false, CFISH_CLASS, NULL), NULL); CFISH_UNUSED_VAR(unused_sv); if (!args_ok) { CFISH_RETHROW(CFISH_INCREF(cfish_Err_get_error())); } singleton = cfish_Class_singleton(class_name, parent); RETVAL = (SV*)CFISH_Class_To_Host(singleton); } OUTPUT: RETVAL END_XS_CODE

my $binding = Clownfish::CFC::Binding::Perl::Class->new(
    parcel     => "Clownfish",
    class_name => "Clownfish::Class",
);
$binding->append_xs($xs_code);

Clownfish::CFC::Binding::Perl::Class->register($binding);
}

sub bind_stringhelper { my $xs_code = <<'END_XS_CODE'; MODULE = Clownfish PACKAGE = Clownfish::Util::StringHelper

Turn an SV's UTF8 flag on. Equivalent to Encode::_utf8_on, but we don't have to load Encode.

Turn an SV's UTF8 flag off.

Upgrade a SV to UTF8, converting Latin1 if necessary. Equivalent to utf::upgrade().

Concatenate one scalar onto the end of the other, ignoring UTF-8 status of the second scalar. This is necessary because $not_utf8 . $utf8 results in a scalar which has been infected by the UTF-8 flag of the second argument.

cpanm Clownfish

perl -MCPAN -e shell
install Clownfish