You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by nw...@apache.org on 2013/06/07 18:10:26 UTC
[lucy-commits] [11/16] Build Lucy with external Clownfish library
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/buildlib/Lucy/Build/Binding/Object.pm
----------------------------------------------------------------------
diff --git a/perl/buildlib/Lucy/Build/Binding/Object.pm b/perl/buildlib/Lucy/Build/Binding/Object.pm
index 50fe6a4..5f04fe2 100644
--- a/perl/buildlib/Lucy/Build/Binding/Object.pm
+++ b/perl/buildlib/Lucy/Build/Binding/Object.pm
@@ -22,17 +22,7 @@ $VERSION = eval $VERSION;
sub bind_all {
my $class = shift;
$class->bind_bitvector;
- $class->bind_bytebuf;
- $class->bind_charbuf;
- $class->bind_err;
- $class->bind_hash;
$class->bind_i32array;
- $class->bind_lockfreeregistry;
- $class->bind_float32;
- $class->bind_float64;
- $class->bind_obj;
- $class->bind_varray;
- $class->bind_vtable;
}
sub bind_bitvector {
@@ -80,205 +70,6 @@ END_CONSTRUCTOR
Clownfish::CFC::Binding::Perl::Class->register($binding);
}
-sub bind_bytebuf {
- my $xs_code = <<'END_XS_CODE';
-MODULE = Lucy PACKAGE = Clownfish::ByteBuf
-
-SV*
-new(either_sv, sv)
- SV *either_sv;
- SV *sv;
-CODE:
-{
- STRLEN size;
- char *ptr = SvPV(sv, size);
- cfish_ByteBuf *self = (cfish_ByteBuf*)XSBind_new_blank_obj(either_sv);
- cfish_BB_init(self, size);
- Cfish_BB_Mimic_Bytes(self, ptr, size);
- RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
-}
-OUTPUT: RETVAL
-END_XS_CODE
-
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::ByteBuf",
- );
- $binding->append_xs($xs_code);
- $binding->exclude_constructor;
-
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
-sub bind_charbuf {
- my $xs_code = <<'END_XS_CODE';
-MODULE = Lucy PACKAGE = Clownfish::CharBuf
-
-SV*
-new(either_sv, sv)
- SV *either_sv;
- SV *sv;
-CODE:
-{
- STRLEN size;
- char *ptr = SvPVutf8(sv, size);
- cfish_CharBuf *self = (cfish_CharBuf*)XSBind_new_blank_obj(either_sv);
- cfish_CB_init(self, size);
- Cfish_CB_Cat_Trusted_Str(self, ptr, size);
- RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
-}
-OUTPUT: RETVAL
-
-SV*
-_clone(self)
- cfish_CharBuf *self;
-CODE:
- RETVAL = CFISH_OBJ_TO_SV_NOINC(cfish_CB_clone(self));
-OUTPUT: RETVAL
-
-SV*
-to_perl(self)
- cfish_CharBuf *self;
-CODE:
- RETVAL = XSBind_cb_to_sv(self);
-OUTPUT: RETVAL
-
-MODULE = Lucy PACKAGE = Clownfish::ViewCharBuf
-
-SV*
-_new(unused, sv)
- SV *unused;
- SV *sv;
-CODE:
-{
- STRLEN size;
- char *ptr = SvPVutf8(sv, size);
- cfish_ViewCharBuf *self
- = cfish_ViewCB_new_from_trusted_utf8(ptr, size);
- CHY_UNUSED_VAR(unused);
- RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
-}
-OUTPUT: RETVAL
-END_XS_CODE
-
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::CharBuf",
- );
- $binding->append_xs($xs_code);
- $binding->exclude_constructor;
-
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
-sub bind_err {
- my $pod_spec = Clownfish::CFC::Binding::Perl::Pod->new;
- my $synopsis = <<'END_SYNOPSIS';
- package MyErr;
- use base qw( Clownfish::Err );
-
- ...
-
- package main;
- use Scalar::Util qw( blessed );
- while (1) {
- eval {
- do_stuff() or MyErr->throw("retry");
- };
- if ( blessed($@) and $@->isa("MyErr") ) {
- warn "Retrying...\n";
- }
- else {
- # Re-throw.
- die "do_stuff() died: $@";
- }
- }
-END_SYNOPSIS
- $pod_spec->set_synopsis($synopsis);
-
- my $xs_code = <<'END_XS_CODE';
-MODULE = Lucy PACKAGE = Clownfish::Err
-
-SV*
-trap(routine_sv, context_sv)
- SV *routine_sv;
- SV *context_sv;
-CODE:
- cfish_Err *error = XSBind_trap(routine_sv, context_sv);
- RETVAL = CFISH_OBJ_TO_SV_NOINC(error);
-OUTPUT: RETVAL
-END_XS_CODE
-
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::Err",
- );
- $binding->bind_constructor( alias => '_new' );
- $binding->set_pod_spec($pod_spec);
- $binding->append_xs($xs_code);
-
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
-sub bind_hash {
- my @hand_rolled = qw(
- Store
- Next
- );
-
- my $xs_code = <<'END_XS_CODE';
-MODULE = Lucy PACKAGE = Clownfish::Hash
-SV*
-_fetch(self, key)
- cfish_Hash *self;
- const cfish_CharBuf *key;
-CODE:
- RETVAL = CFISH_OBJ_TO_SV(cfish_Hash_fetch(self, (cfish_Obj*)key));
-OUTPUT: RETVAL
-
-void
-store(self, key, value);
- cfish_Hash *self;
- const cfish_CharBuf *key;
- cfish_Obj *value;
-PPCODE:
-{
- if (value) { CFISH_INCREF(value); }
- cfish_Hash_store(self, (cfish_Obj*)key, value);
-}
-
-void
-next(self)
- cfish_Hash *self;
-PPCODE:
-{
- cfish_Obj *key;
- cfish_Obj *val;
-
- if (Cfish_Hash_Next(self, &key, &val)) {
- SV *key_sv = (SV*)Cfish_Obj_To_Host(key);
- SV *val_sv = (SV*)Cfish_Obj_To_Host(val);
-
- XPUSHs(sv_2mortal(key_sv));
- XPUSHs(sv_2mortal(val_sv));
- XSRETURN(2);
- }
- else {
- XSRETURN_EMPTY;
- }
-}
-END_XS_CODE
-
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::Hash",
- );
- $binding->exclude_method($_) for @hand_rolled;
- $binding->append_xs($xs_code);
-
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
sub bind_i32array {
my $xs_code = <<'END_XS_CODE';
MODULE = Lucy PACKAGE = Lucy::Object::I32Array
@@ -355,329 +146,4 @@ END_XS_CODE
Clownfish::CFC::Binding::Perl::Class->register($binding);
}
-sub bind_lockfreeregistry {
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::LockFreeRegistry",
- );
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
-sub bind_float32 {
- my $float32_xs_code = <<'END_XS_CODE';
-MODULE = Lucy PACKAGE = Clownfish::Float32
-
-SV*
-new(either_sv, value)
- SV *either_sv;
- float value;
-CODE:
-{
- cfish_Float32 *self = (cfish_Float32*)XSBind_new_blank_obj(either_sv);
- cfish_Float32_init(self, value);
- RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
-}
-OUTPUT: RETVAL
-END_XS_CODE
-
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::Float32",
- );
- $binding->append_xs($float32_xs_code);
- $binding->exclude_constructor;
-
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
-sub bind_float64 {
- my $float64_xs_code = <<'END_XS_CODE';
-MODULE = Lucy PACKAGE = Clownfish::Float64
-
-SV*
-new(either_sv, value)
- SV *either_sv;
- double value;
-CODE:
-{
- cfish_Float64 *self = (cfish_Float64*)XSBind_new_blank_obj(either_sv);
- cfish_Float64_init(self, value);
- RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
-}
-OUTPUT: RETVAL
-END_XS_CODE
-
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::Float64",
- );
- $binding->append_xs($float64_xs_code);
- $binding->exclude_constructor;
-
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
-sub bind_obj {
- my @exposed = qw(
- To_String
- To_I64
- To_F64
- Equals
- Dump
- Load
- );
- my @hand_rolled = qw(
- Is_A
- );
-
- my $pod_spec = Clownfish::CFC::Binding::Perl::Pod->new;
- my $synopsis = <<'END_SYNOPSIS';
- package MyObj;
- use base qw( Clownfish::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';
-Clownfish::Obj is the base class of the Clownfish object hierarchy.
-
-From the standpoint of a Perl programmer, 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 Clownfish::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.
-
-=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 "Clownfish::Obj" directly causes an
-error.
-
-Takes no arguments; if any are supplied, an error will be reported.
-
-=head1 DESTRUCTOR
-
-=head2 DESTROY
-
-All Clownfish 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
- $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 = Lucy PACKAGE = Clownfish::Obj
-
-bool
-is_a(self, class_name)
- cfish_Obj *self;
- const cfish_CharBuf *class_name;
-CODE:
-{
- cfish_VTable *target = cfish_VTable_fetch_vtable(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 => '_load', method => 'Load' );
- $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 = Lucy 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(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_vtable {
- my @hand_rolled = qw( Make_Obj );
-
- my $xs_code = <<'END_XS_CODE';
-MODULE = Lucy PACKAGE = Clownfish::VTable
-
-SV*
-_get_registry()
-CODE:
- if (cfish_VTable_registry == NULL) {
- cfish_VTable_init_registry();
- }
- RETVAL = (SV*)Cfish_Obj_To_Host((cfish_Obj*)cfish_VTable_registry);
-OUTPUT: RETVAL
-
-SV*
-singleton(unused_sv, ...)
- SV *unused_sv;
-CODE:
-{
- CHY_UNUSED_VAR(unused_sv);
- cfish_CharBuf *class_name = NULL;
- cfish_VTable *parent = NULL;
- bool args_ok
- = XSBind_allot_params(&(ST(0)), 1, items,
- ALLOT_OBJ(&class_name, "class_name", 10, true,
- CFISH_CHARBUF, alloca(cfish_ZCB_size())),
- ALLOT_OBJ(&parent, "parent", 6, false,
- CFISH_VTABLE, NULL),
- NULL);
- if (!args_ok) {
- CFISH_RETHROW(CFISH_INCREF(cfish_Err_get_error()));
- }
- cfish_VTable *singleton = cfish_VTable_singleton(class_name, parent);
- RETVAL = (SV*)Cfish_VTable_To_Host(singleton);
-}
-OUTPUT: RETVAL
-
-SV*
-make_obj(self)
- cfish_VTable *self;
-CODE:
- cfish_Obj *blank = Cfish_VTable_Make_Obj(self);
- RETVAL = CFISH_OBJ_TO_SV_NOINC(blank);
-OUTPUT: RETVAL
-END_XS_CODE
-
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::VTable",
- );
- $binding->exclude_method($_) for @hand_rolled;
- $binding->append_xs($xs_code);
-
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
1;
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/buildlib/Lucy/Build/Binding/Util.pm
----------------------------------------------------------------------
diff --git a/perl/buildlib/Lucy/Build/Binding/Util.pm b/perl/buildlib/Lucy/Build/Binding/Util.pm
index 8d2a6a7..df3ee31 100644
--- a/perl/buildlib/Lucy/Build/Binding/Util.pm
+++ b/perl/buildlib/Lucy/Build/Binding/Util.pm
@@ -28,7 +28,6 @@ sub bind_all {
$class->bind_priorityqueue;
$class->bind_sortexternal;
$class->bind_stepper;
- $class->bind_stringhelper;
}
sub bind_debug {
@@ -218,105 +217,4 @@ sub bind_stepper {
Clownfish::CFC::Binding::Perl::Class->register($binding);
}
-sub bind_stringhelper {
- my $xs_code = <<'END_XS_CODE';
-MODULE = Lucy PACKAGE = Clownfish::Util::StringHelper
-
-=for comment
-
-Turn an SV's UTF8 flag on. Equivalent to Encode::_utf8_on, but we don't have
-to load Encode.
-
-=cut
-
-void
-utf8_flag_on(sv)
- SV *sv;
-PPCODE:
- SvUTF8_on(sv);
-
-=for comment
-
-Turn an SV's UTF8 flag off.
-
-=cut
-
-void
-utf8_flag_off(sv)
- SV *sv;
-PPCODE:
- SvUTF8_off(sv);
-
-SV*
-to_base36(num)
- uint64_t num;
-CODE:
-{
- char base36[cfish_StrHelp_MAX_BASE36_BYTES];
- size_t size = cfish_StrHelp_to_base36(num, &base36);
- RETVAL = newSVpvn(base36, size);
-}
-OUTPUT: RETVAL
-
-IV
-from_base36(str)
- char *str;
-CODE:
- RETVAL = strtol(str, NULL, 36);
-OUTPUT: RETVAL
-
-=for comment
-
-Upgrade a SV to UTF8, converting Latin1 if necessary. Equivalent to
-utf::upgrade().
-
-=cut
-
-void
-utf8ify(sv)
- SV *sv;
-PPCODE:
- sv_utf8_upgrade(sv);
-
-bool
-utf8_valid(sv)
- SV *sv;
-CODE:
-{
- STRLEN len;
- char *ptr = SvPV(sv, len);
- RETVAL = cfish_StrHelp_utf8_valid(ptr, len);
-}
-OUTPUT: RETVAL
-
-=for comment
-
-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.
-
-=cut
-
-void
-cat_bytes(sv, catted)
- SV *sv;
- SV *catted;
-PPCODE:
-{
- STRLEN len;
- char *ptr = SvPV(catted, len);
- if (SvUTF8(sv)) { CFISH_THROW(CFISH_ERR, "Can't cat_bytes onto a UTF-8 SV"); }
- sv_catpvn(sv, ptr, len);
-}
-END_XS_CODE
-
- my $binding = Clownfish::CFC::Binding::Perl::Class->new(
- parcel => "Clownfish",
- class_name => "Clownfish::Util::StringHelper",
- );
- $binding->append_xs($xs_code);
-
- Clownfish::CFC::Binding::Perl::Class->register($binding);
-}
-
1;
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/ByteBuf.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/ByteBuf.pm b/perl/lib/Clownfish/ByteBuf.pm
deleted file mode 100644
index 34698c7..0000000
--- a/perl/lib/Clownfish/ByteBuf.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::ByteBuf;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/CharBuf.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/CharBuf.pm b/perl/lib/Clownfish/CharBuf.pm
deleted file mode 100644
index c666613..0000000
--- a/perl/lib/Clownfish/CharBuf.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::CharBuf;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/Err.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/Err.pm b/perl/lib/Clownfish/Err.pm
deleted file mode 100644
index 68c9118..0000000
--- a/perl/lib/Clownfish/Err.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::Err;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/Hash.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/Hash.pm b/perl/lib/Clownfish/Hash.pm
deleted file mode 100644
index 0dbcd84..0000000
--- a/perl/lib/Clownfish/Hash.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::Hash;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/LockFreeRegistry.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/LockFreeRegistry.pm b/perl/lib/Clownfish/LockFreeRegistry.pm
deleted file mode 100644
index b2d8ea5..0000000
--- a/perl/lib/Clownfish/LockFreeRegistry.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::LockFreeRegistry;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/Num.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/Num.pm b/perl/lib/Clownfish/Num.pm
deleted file mode 100644
index fd63caa..0000000
--- a/perl/lib/Clownfish/Num.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::Num;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/Obj.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/Obj.pm b/perl/lib/Clownfish/Obj.pm
deleted file mode 100644
index d7208c7..0000000
--- a/perl/lib/Clownfish/Obj.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::Obj;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/Test.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/Test.pm b/perl/lib/Clownfish/Test.pm
deleted file mode 100644
index 1bd3c79..0000000
--- a/perl/lib/Clownfish/Test.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::Test;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/Util/StringHelper.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/Util/StringHelper.pm b/perl/lib/Clownfish/Util/StringHelper.pm
deleted file mode 100644
index c02ef0f..0000000
--- a/perl/lib/Clownfish/Util/StringHelper.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::Util::StringHelper;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/VArray.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/VArray.pm b/perl/lib/Clownfish/VArray.pm
deleted file mode 100644
index 411cc4b..0000000
--- a/perl/lib/Clownfish/VArray.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::VArray;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Clownfish/VTable.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Clownfish/VTable.pm b/perl/lib/Clownfish/VTable.pm
deleted file mode 100644
index 00fb050..0000000
--- a/perl/lib/Clownfish/VTable.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-# Licensed to the Apache Software Foundation (ASF) under one or more
-# contributor license agreements. See the NOTICE file distributed with
-# this work for additional information regarding copyright ownership.
-# The ASF licenses this file to You under the Apache License, Version 2.0
-# (the "License"); you may not use this file except in compliance with
-# the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-
-package Clownfish::VTable;
-use Lucy;
-our $VERSION = '0.003000';
-$VERSION = eval $VERSION;
-
-1;
-
-__END__
-
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/Lucy.pm
----------------------------------------------------------------------
diff --git a/perl/lib/Lucy.pm b/perl/lib/Lucy.pm
index a6e17a5..4b1e4b3 100644
--- a/perl/lib/Lucy.pm
+++ b/perl/lib/Lucy.pm
@@ -23,12 +23,10 @@ use 5.008003;
our $VERSION = '0.003000';
$VERSION = eval $VERSION;
+use Clownfish;
use Exporter 'import';
BEGIN {
our @EXPORT_OK = qw(
- to_clownfish
- to_perl
- kdump
STORABLE_freeze
STORABLE_thaw
);
@@ -47,16 +45,6 @@ BEGIN {
_init_autobindings();
}
-sub kdump {
- require Data::Dumper;
- my $kdumper = Data::Dumper->new( [@_] );
- $kdumper->Sortkeys( sub { return [ sort keys %{ $_[0] } ] } );
- $kdumper->Indent(1);
- warn $kdumper->Dump;
-}
-
-sub error {$Clownfish::Err::error}
-
{
package Lucy::Util::IndexFileNames;
our $VERSION = '0.003000';
@@ -71,24 +59,6 @@ sub error {$Clownfish::Err::error}
}
{
- package Clownfish::Util::StringHelper;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
- BEGIN {
- push our @ISA, 'Exporter';
- our @EXPORT_OK = qw(
- utf8_flag_on
- utf8_flag_off
- to_base36
- from_base36
- utf8ify
- utf8_valid
- cat_bytes
- );
- }
-}
-
-{
# Temporary back compat.
package Lucy::Object::Obj;
BEGIN { our @ISA = qw( Clownfish::Obj ) }
@@ -122,20 +92,8 @@ sub error {$Clownfish::Err::error}
}
{
- package Clownfish::LockFreeRegistry;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
- no warnings 'redefine';
- sub DESTROY { } # leak all
-}
-
-{
package Clownfish::Obj;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
- use Lucy qw( to_clownfish to_perl );
use Carp qw( confess );
- sub load { return $_[0]->_load( to_clownfish( $_[1] ) ) }
sub STORABLE_freeze {
my $class_name = shift->get_class_name;
confess("Storable serialization not implemented for $class_name");
@@ -147,48 +105,6 @@ sub error {$Clownfish::Err::error}
}
{
- package Clownfish::VTable;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
-
- sub _find_parent_class {
- my $package = shift;
- no strict 'refs';
- for my $parent ( @{"$package\::ISA"} ) {
- return $parent if $parent->isa('Clownfish::Obj');
- }
- return;
- }
-
- sub _fresh_host_methods {
- my $package = shift;
- no strict 'refs';
- my $stash = \%{"$package\::"};
- my $methods
- = Clownfish::VArray->new( capacity => scalar keys %$stash );
- while ( my ( $symbol, $glob ) = each %$stash ) {
- next if ref $glob;
- next unless *$glob{CODE};
- $methods->push( Clownfish::CharBuf->new($symbol) );
- }
- return $methods;
- }
-
- sub _register {
- my ( $singleton, $parent ) = @_;
- my $singleton_class = $singleton->get_name;
- my $parent_class = $parent->get_name;
- if ( !$singleton_class->isa($parent_class) ) {
- no strict 'refs';
- push @{"$singleton_class\::ISA"}, $parent_class;
- }
- }
-
- no warnings 'redefine';
- sub DESTROY { } # leak all
-}
-
-{
package Lucy::Index::DocVector;
our $VERSION = '0.003000';
$VERSION = eval $VERSION;
@@ -238,7 +154,7 @@ sub error {$Clownfish::Err::error}
package Lucy::Index::Segment;
our $VERSION = '0.003000';
$VERSION = eval $VERSION;
- use Lucy qw( to_clownfish );
+ use Clownfish qw( to_clownfish );
sub store_metadata {
my ( $self, %args ) = @_;
$self->_store_metadata( %args,
@@ -342,94 +258,6 @@ sub error {$Clownfish::Err::error}
}
{
- package Clownfish::ViewByteBuf;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
- use Carp;
- sub new { confess "ViewByteBuf objects can only be created from C." }
-}
-
-{
- package Clownfish::CharBuf;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
-
- {
- # Defeat obscure bugs in the XS auto-generation by redefining clone().
- # (Because of how the typemap works for CharBuf*,
- # the auto-generated methods return UTF-8 Perl scalars rather than
- # actual CharBuf objects.)
- no warnings 'redefine';
- sub clone { shift->_clone(@_) }
- }
-}
-
-{
- package Clownfish::ViewCharBuf;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
- use Carp;
- sub new { confess "ViewCharBuf has no public constructor." }
-}
-
-{
- package Clownfish::ZombieCharBuf;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
- use Carp;
- sub new { confess "ZombieCharBuf objects can only be created from C." }
- no warnings 'redefine';
- sub DESTROY { }
-}
-
-{
- package Clownfish::Err;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
- sub do_to_string { shift->to_string }
- use Scalar::Util qw( blessed );
- use Carp qw( confess longmess );
- use overload
- '""' => \&do_to_string,
- fallback => 1;
-
- sub new {
- my ( $either, $message ) = @_;
- my ( undef, $file, $line ) = caller;
- $message .= ", $file line $line\n";
- return $either->_new( mess => Clownfish::CharBuf->new($message) );
- }
-
- sub do_throw {
- my $err = shift;
- my $longmess = longmess();
- $longmess =~ s/^\s*/\t/;
- $err->cat_mess($longmess);
- die $err;
- }
-
- our $error;
- sub set_error {
- my $val = $_[1];
- if ( defined $val ) {
- confess("Not a Clownfish::Err")
- unless ( blessed($val)
- && $val->isa("Clownfish::Err") );
- }
- $error = $val;
- }
- sub get_error {$error}
-}
-
-{
- package Clownfish::VArray;
- our $VERSION = '0.003000';
- $VERSION = eval $VERSION;
- no warnings 'redefine';
- sub clone { CORE::shift->_clone }
-}
-
-{
package Lucy::Store::FileHandle;
our $VERSION = '0.003000';
$VERSION = eval $VERSION;
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/lib/LucyX/Index/ZlibDocWriter.pm
----------------------------------------------------------------------
diff --git a/perl/lib/LucyX/Index/ZlibDocWriter.pm b/perl/lib/LucyX/Index/ZlibDocWriter.pm
index 7258b2d..da7fd94 100644
--- a/perl/lib/LucyX/Index/ZlibDocWriter.pm
+++ b/perl/lib/LucyX/Index/ZlibDocWriter.pm
@@ -21,7 +21,7 @@ use Carp;
use Scalar::Util qw( blessed );
use Compress::Zlib qw( compress );
use Clownfish::Util::StringHelper qw( cat_bytes );
-use Lucy qw( to_perl );
+use Clownfish qw( to_perl );
use bytes;
no bytes;
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/t/018-host.t
----------------------------------------------------------------------
diff --git a/perl/t/018-host.t b/perl/t/018-host.t
index 291c4db..061f912 100644
--- a/perl/t/018-host.t
+++ b/perl/t/018-host.t
@@ -18,7 +18,7 @@ use warnings;
use Test::More tests => 3;
use Lucy::Test;
-use Lucy qw( to_perl to_clownfish );
+use Clownfish qw( to_perl to_clownfish );
my %complex_data_structure = (
a => [ 1, 2, 3, { ooga => 'booga' } ],
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/t/028-sortexrun.t
----------------------------------------------------------------------
diff --git a/perl/t/028-sortexrun.t b/perl/t/028-sortexrun.t
index 24abfd4..64b9ef7 100644
--- a/perl/t/028-sortexrun.t
+++ b/perl/t/028-sortexrun.t
@@ -20,7 +20,7 @@ use lib 'buildlib';
use Test::More skip_all => 'Disabled until test ported to C';
#use Test::More tests => 5;
use Lucy::Test;
-use Lucy qw( to_perl );
+use Clownfish qw( to_perl );
my $letters = Clownfish::VArray->new( capacity => 26 );
$letters->push( Clownfish::ByteBuf->new($_) ) for 'a' .. 'z';
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/t/binding/017-hash.t
----------------------------------------------------------------------
diff --git a/perl/t/binding/017-hash.t b/perl/t/binding/017-hash.t
index 67b0f13..4fde848 100644
--- a/perl/t/binding/017-hash.t
+++ b/perl/t/binding/017-hash.t
@@ -18,7 +18,7 @@ use warnings;
use Test::More tests => 2;
use Lucy::Test;
-use Lucy qw( to_perl to_clownfish );
+use Clownfish qw( to_perl to_clownfish );
my $hash = Clownfish::Hash->new( capacity => 10 );
$hash->store( "foo", Clownfish::CharBuf->new("bar") );
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/xs/XSBind.c
----------------------------------------------------------------------
diff --git a/perl/xs/XSBind.c b/perl/xs/XSBind.c
deleted file mode 100644
index 092b5e9..0000000
--- a/perl/xs/XSBind.c
+++ /dev/null
@@ -1,934 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements. See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License. You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-#define C_CFISH_OBJ
-#define C_CFISH_VTABLE
-#define C_CFISH_LOCKFREEREGISTRY
-#define NEED_newRV_noinc
-#include "XSBind.h"
-#include "Clownfish/LockFreeRegistry.h"
-#include "Clownfish/Util/StringHelper.h"
-#include "Clownfish/Util/NumberUtils.h"
-#include "Clownfish/Util/Memory.h"
-
-#define XSBIND_REFCOUNT_FLAG 1
-#define XSBIND_REFCOUNT_SHIFT 1
-
-// Convert a Perl hash into a Clownfish Hash. Caller takes responsibility for
-// a refcount.
-static cfish_Hash*
-S_perl_hash_to_cfish_hash(HV *phash);
-
-// Convert a Perl array into a Clownfish VArray. Caller takes responsibility
-// for a refcount.
-static cfish_VArray*
-S_perl_array_to_cfish_array(AV *parray);
-
-// Convert a VArray to a Perl array. Caller takes responsibility for a
-// refcount.
-static SV*
-S_cfish_array_to_perl_array(cfish_VArray *varray);
-
-// Convert a Hash to a Perl hash. Caller takes responsibility for a refcount.
-static SV*
-S_cfish_hash_to_perl_hash(cfish_Hash *hash);
-
-cfish_Obj*
-XSBind_new_blank_obj(SV *either_sv) {
- cfish_VTable *vtable;
-
- // Get a VTable.
- if (sv_isobject(either_sv)
- && sv_derived_from(either_sv, "Clownfish::Obj")
- ) {
- // Use the supplied object's VTable.
- IV iv_ptr = SvIV(SvRV(either_sv));
- cfish_Obj *self = INT2PTR(cfish_Obj*, iv_ptr);
- vtable = self->vtable;
- }
- else {
- // Use the supplied class name string to find a VTable.
- STRLEN len;
- char *ptr = SvPVutf8(either_sv, len);
- cfish_ZombieCharBuf *klass = CFISH_ZCB_WRAP_STR(ptr, len);
- vtable = cfish_VTable_singleton((cfish_CharBuf*)klass, NULL);
- }
-
- // Use the VTable to allocate a new blank object of the right size.
- return Cfish_VTable_Make_Obj(vtable);
-}
-
-cfish_Obj*
-XSBind_sv_to_cfish_obj(SV *sv, cfish_VTable *vtable, void *allocation) {
- cfish_Obj *retval = XSBind_maybe_sv_to_cfish_obj(sv, vtable, allocation);
- if (!retval) {
- THROW(CFISH_ERR, "Not a %o", Cfish_VTable_Get_Name(vtable));
- }
- return retval;
-}
-
-cfish_Obj*
-XSBind_maybe_sv_to_cfish_obj(SV *sv, cfish_VTable *vtable, void *allocation) {
- cfish_Obj *retval = NULL;
- if (XSBind_sv_defined(sv)) {
- if (sv_isobject(sv)
- && sv_derived_from(sv, (char*)Cfish_CB_Get_Ptr8(Cfish_VTable_Get_Name(vtable)))
- ) {
- // Unwrap a real Clownfish object.
- IV tmp = SvIV(SvRV(sv));
- retval = INT2PTR(cfish_Obj*, tmp);
- }
- else if (allocation &&
- (vtable == CFISH_ZOMBIECHARBUF
- || vtable == CFISH_VIEWCHARBUF
- || vtable == CFISH_CHARBUF
- || vtable == CFISH_OBJ)
- ) {
- // Wrap the string from an ordinary Perl scalar inside a
- // ZombieCharBuf.
- STRLEN size;
- char *ptr = SvPVutf8(sv, size);
- retval = (cfish_Obj*)cfish_ZCB_wrap_str(allocation, ptr, size);
- }
- else if (SvROK(sv)) {
- // Attempt to convert Perl hashes and arrays into their Clownfish
- // analogues.
- SV *inner = SvRV(sv);
- if (SvTYPE(inner) == SVt_PVAV && vtable == CFISH_VARRAY) {
- retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)inner);
- }
- else if (SvTYPE(inner) == SVt_PVHV && vtable == CFISH_HASH) {
- retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)inner);
- }
-
- if (retval) {
- // Mortalize the converted object -- which is somewhat
- // dangerous, but is the only way to avoid requiring that the
- // caller take responsibility for a refcount.
- SV *mortal = (SV*)Cfish_Obj_To_Host(retval);
- CFISH_DECREF(retval);
- sv_2mortal(mortal);
- }
- }
- }
-
- return retval;
-}
-
-SV*
-XSBind_cfish_to_perl(cfish_Obj *obj) {
- if (obj == NULL) {
- return newSV(0);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_CHARBUF)) {
- return XSBind_cb_to_sv((cfish_CharBuf*)obj);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_BYTEBUF)) {
- return XSBind_bb_to_sv((cfish_ByteBuf*)obj);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_VARRAY)) {
- return S_cfish_array_to_perl_array((cfish_VArray*)obj);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_HASH)) {
- return S_cfish_hash_to_perl_hash((cfish_Hash*)obj);
- }
- else if (Cfish_Obj_Is_A(obj, CFISH_FLOATNUM)) {
- return newSVnv(Cfish_Obj_To_F64(obj));
- }
- else if (obj == (cfish_Obj*)CFISH_TRUE) {
- return newSViv(1);
- }
- else if (obj == (cfish_Obj*)CFISH_FALSE) {
- return newSViv(0);
- }
- else if (sizeof(IV) == 8 && Cfish_Obj_Is_A(obj, CFISH_INTNUM)) {
- int64_t num = Cfish_Obj_To_I64(obj);
- return newSViv((IV)num);
- }
- else if (sizeof(IV) == 4 && Cfish_Obj_Is_A(obj, CFISH_INTEGER32)) {
- int32_t num = (int32_t)Cfish_Obj_To_I64(obj);
- return newSViv((IV)num);
- }
- else if (sizeof(IV) == 4 && Cfish_Obj_Is_A(obj, CFISH_INTEGER64)) {
- int64_t num = Cfish_Obj_To_I64(obj);
- return newSVnv((double)num); // lossy
- }
- else {
- return (SV*)Cfish_Obj_To_Host(obj);
- }
-}
-
-cfish_Obj*
-XSBind_perl_to_cfish(SV *sv) {
- cfish_Obj *retval = NULL;
-
- if (XSBind_sv_defined(sv)) {
- if (SvROK(sv)) {
- // Deep conversion of references.
- SV *inner = SvRV(sv);
- if (SvTYPE(inner) == SVt_PVAV) {
- retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)inner);
- }
- else if (SvTYPE(inner) == SVt_PVHV) {
- retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)inner);
- }
- else if (sv_isobject(sv)
- && sv_derived_from(sv, "Clownfish::Obj")
- ) {
- IV tmp = SvIV(inner);
- retval = INT2PTR(cfish_Obj*, tmp);
- (void)CFISH_INCREF(retval);
- }
- }
-
- // It's either a plain scalar or a non-Clownfish Perl object, so
- // stringify.
- if (!retval) {
- STRLEN len;
- char *ptr = SvPVutf8(sv, len);
- retval = (cfish_Obj*)cfish_CB_new_from_trusted_utf8(ptr, len);
- }
- }
- else if (sv) {
- // Deep conversion of raw AVs and HVs.
- if (SvTYPE(sv) == SVt_PVAV) {
- retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)sv);
- }
- else if (SvTYPE(sv) == SVt_PVHV) {
- retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)sv);
- }
- }
-
- return retval;
-}
-
-SV*
-XSBind_bb_to_sv(const cfish_ByteBuf *bb) {
- return bb
- ? newSVpvn(Cfish_BB_Get_Buf(bb), Cfish_BB_Get_Size(bb))
- : newSV(0);
-}
-
-SV*
-XSBind_cb_to_sv(const cfish_CharBuf *cb) {
- if (!cb) {
- return newSV(0);
- }
- else {
- SV *sv = newSVpvn((char*)Cfish_CB_Get_Ptr8(cb), Cfish_CB_Get_Size(cb));
- SvUTF8_on(sv);
- return sv;
- }
-}
-
-static cfish_Hash*
-S_perl_hash_to_cfish_hash(HV *phash) {
- uint32_t num_keys = hv_iterinit(phash);
- cfish_Hash *retval = cfish_Hash_new(num_keys);
- cfish_ZombieCharBuf *key = CFISH_ZCB_WRAP_STR("", 0);
-
- while (num_keys--) {
- HE *entry = hv_iternext(phash);
- STRLEN key_len = HeKLEN(entry);
- SV *value_sv = HeVAL(entry);
- cfish_Obj *value = XSBind_perl_to_cfish(value_sv); // Recurse.
-
- // Force key to UTF-8 if necessary.
- if (key_len == (STRLEN)HEf_SVKEY) {
- // Key is stored as an SV. Use its UTF-8 flag? Not sure about
- // this.
- SV *key_sv = HeKEY_sv(entry);
- char *key_str = SvPVutf8(key_sv, key_len);
- Cfish_ZCB_Assign_Trusted_Str(key, key_str, key_len);
- Cfish_Hash_Store(retval, (cfish_Obj*)key, value);
- }
- else if (HeKUTF8(entry)) {
- Cfish_ZCB_Assign_Trusted_Str(key, HeKEY(entry), key_len);
- Cfish_Hash_Store(retval, (cfish_Obj*)key, value);
- }
- else {
- char *key_str = HeKEY(entry);
- bool pure_ascii = true;
- for (STRLEN i = 0; i < key_len; i++) {
- if ((key_str[i] & 0x80) == 0x80) { pure_ascii = false; }
- }
- if (pure_ascii) {
- Cfish_ZCB_Assign_Trusted_Str(key, key_str, key_len);
- Cfish_Hash_Store(retval, (cfish_Obj*)key, value);
- }
- else {
- SV *key_sv = HeSVKEY_force(entry);
- key_str = SvPVutf8(key_sv, key_len);
- Cfish_ZCB_Assign_Trusted_Str(key, key_str, key_len);
- Cfish_Hash_Store(retval, (cfish_Obj*)key, value);
- }
- }
- }
-
- return retval;
-}
-
-static cfish_VArray*
-S_perl_array_to_cfish_array(AV *parray) {
- const uint32_t size = av_len(parray) + 1;
- cfish_VArray *retval = cfish_VA_new(size);
-
- // Iterate over array elems.
- for (uint32_t i = 0; i < size; i++) {
- SV **elem_sv = av_fetch(parray, i, false);
- if (elem_sv) {
- cfish_Obj *elem = XSBind_perl_to_cfish(*elem_sv);
- if (elem) { Cfish_VA_Store(retval, i, elem); }
- }
- }
- Cfish_VA_Resize(retval, size); // needed if last elem is NULL
-
- return retval;
-}
-
-static SV*
-S_cfish_array_to_perl_array(cfish_VArray *varray) {
- AV *perl_array = newAV();
- uint32_t num_elems = Cfish_VA_Get_Size(varray);
-
- // Iterate over array elems.
- if (num_elems) {
- av_fill(perl_array, num_elems - 1);
- for (uint32_t i = 0; i < num_elems; i++) {
- cfish_Obj *val = Cfish_VA_Fetch(varray, i);
- if (val == NULL) {
- continue;
- }
- else {
- // Recurse for each value.
- SV *const val_sv = XSBind_cfish_to_perl(val);
- av_store(perl_array, i, val_sv);
- }
- }
- }
-
- return newRV_noinc((SV*)perl_array);
-}
-
-static SV*
-S_cfish_hash_to_perl_hash(cfish_Hash *hash) {
- HV *perl_hash = newHV();
- SV *key_sv = newSV(1);
- cfish_CharBuf *key;
- cfish_Obj *val;
-
- // Prepare the SV key.
- SvPOK_on(key_sv);
- SvUTF8_on(key_sv);
-
- // Iterate over key-value pairs.
- Cfish_Hash_Iterate(hash);
- while (Cfish_Hash_Next(hash, (cfish_Obj**)&key, &val)) {
- // Recurse for each value.
- SV *val_sv = XSBind_cfish_to_perl(val);
- if (!Cfish_Obj_Is_A((cfish_Obj*)key, CFISH_CHARBUF)) {
- CFISH_THROW(CFISH_ERR,
- "Can't convert a key of class %o to a Perl hash key",
- Cfish_Obj_Get_Class_Name((cfish_Obj*)key));
- }
- else {
- STRLEN key_size = Cfish_CB_Get_Size(key);
- char *key_sv_ptr = SvGROW(key_sv, key_size + 1);
- memcpy(key_sv_ptr, Cfish_CB_Get_Ptr8(key), key_size);
- SvCUR_set(key_sv, key_size);
- *SvEND(key_sv) = '\0';
- (void)hv_store_ent(perl_hash, key_sv, val_sv, 0);
- }
- }
- SvREFCNT_dec(key_sv);
-
- return newRV_noinc((SV*)perl_hash);
-}
-
-struct trap_context {
- SV *routine;
- SV *context;
-};
-
-static void
-S_attempt_perl_call(void *context) {
- struct trap_context *args = (struct trap_context*)context;
- dSP;
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVsv(args->context)));
- PUTBACK;
- call_sv(args->routine, G_DISCARD);
- FREETMPS;
- LEAVE;
-}
-
-cfish_Err*
-XSBind_trap(SV *routine, SV *context) {
- struct trap_context args;
- args.routine = routine;
- args.context = context;
- return cfish_Err_trap(S_attempt_perl_call, &args);
-}
-
-void
-XSBind_enable_overload(void *pobj) {
- SV *perl_obj = (SV*)pobj;
- HV *stash = SvSTASH(SvRV(perl_obj));
-#if (PERL_VERSION > 10)
- Gv_AMupdate(stash, false);
-#else
- Gv_AMupdate(stash);
-#endif
- SvAMAGIC_on(perl_obj);
-}
-
-static bool
-S_extract_from_sv(SV *value, void *target, const char *label,
- bool required, int type, cfish_VTable *vtable,
- void *allocation) {
- bool valid_assignment = false;
-
- if (XSBind_sv_defined(value)) {
- switch (type) {
- case XSBIND_WANT_I8:
- *((int8_t*)target) = (int8_t)SvIV(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_I16:
- *((int16_t*)target) = (int16_t)SvIV(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_I32:
- *((int32_t*)target) = (int32_t)SvIV(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_I64:
- if (sizeof(IV) == 8) {
- *((int64_t*)target) = (int64_t)SvIV(value);
- }
- else { // sizeof(IV) == 4
- // lossy.
- *((int64_t*)target) = (int64_t)SvNV(value);
- }
- valid_assignment = true;
- break;
- case XSBIND_WANT_U8:
- *((uint8_t*)target) = (uint8_t)SvUV(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_U16:
- *((uint16_t*)target) = (uint16_t)SvUV(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_U32:
- *((uint32_t*)target) = (uint32_t)SvUV(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_U64:
- if (sizeof(UV) == 8) {
- *((uint64_t*)target) = (uint64_t)SvUV(value);
- }
- else { // sizeof(UV) == 4
- // lossy.
- *((uint64_t*)target) = (uint64_t)SvNV(value);
- }
- valid_assignment = true;
- break;
- case XSBIND_WANT_BOOL:
- *((bool*)target) = !!SvTRUE(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_F32:
- *((float*)target) = (float)SvNV(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_F64:
- *((double*)target) = SvNV(value);
- valid_assignment = true;
- break;
- case XSBIND_WANT_OBJ: {
- cfish_Obj *object
- = XSBind_maybe_sv_to_cfish_obj(value, vtable,
- allocation);
- if (object) {
- *((cfish_Obj**)target) = object;
- valid_assignment = true;
- }
- else {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS(
- "Invalid value for '%s' - not a %o",
- label, Cfish_VTable_Get_Name(vtable));
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
- }
- break;
- case XSBIND_WANT_SV:
- *((SV**)target) = value;
- valid_assignment = true;
- break;
- default: {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS("Unrecognized type: %i32 for param '%s'",
- (int32_t)type, label);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
- }
- }
-
- // Enforce that required params cannot be undef and must present valid
- // values.
- if (required && !valid_assignment) {
- cfish_CharBuf *mess = CFISH_MAKE_MESS("Missing required param %s",
- label);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
-
- return true;
-}
-
-bool
-XSBind_allot_params(SV** stack, int32_t start, int32_t num_stack_elems, ...) {
- va_list args;
- size_t size = sizeof(int64_t) + num_stack_elems / 64;
- void *verified_labels = alloca(size);
- memset(verified_labels, 0, size);
-
- // Verify that our args come in pairs. Return success if there are no
- // args.
- if ((num_stack_elems - start) % 2 != 0) {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS(
- "Expecting hash-style params, got odd number of args");
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
-
- void *target;
- va_start(args, num_stack_elems);
- while (NULL != (target = va_arg(args, void*))) {
- char *label = va_arg(args, char*);
- int label_len = va_arg(args, int);
- int required = va_arg(args, int);
- int type = va_arg(args, int);
- cfish_VTable *vtable = va_arg(args, cfish_VTable*);
- void *allocation = va_arg(args, void*);
-
- // Iterate through the stack looking for labels which match this param
- // name. If the label appears more than once, keep track of where it
- // appears *last*, as the last time a param appears overrides all
- // previous appearances.
- int32_t found_arg = -1;
- for (int32_t tick = start; tick < num_stack_elems; tick += 2) {
- SV *const key_sv = stack[tick];
- if (SvCUR(key_sv) == (STRLEN)label_len) {
- if (memcmp(SvPVX(key_sv), label, label_len) == 0) {
- found_arg = tick;
- cfish_NumUtil_u1set(verified_labels, tick);
- }
- }
- }
-
- if (found_arg == -1) {
- // Didn't find this parameter. Throw an error if it was required.
- if (required) {
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS("Missing required parameter: '%s'",
- label);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
- }
- else {
- // Found the arg. Extract the value.
- SV *value = stack[found_arg + 1];
- bool got_arg = S_extract_from_sv(value, target, label,
- required, type, vtable,
- allocation);
- if (!got_arg) {
- CFISH_ERR_ADD_FRAME(cfish_Err_get_error());
- return false;
- }
- }
- }
- va_end(args);
-
- // Ensure that all parameter labels were valid.
- for (int32_t tick = start; tick < num_stack_elems; tick += 2) {
- if (!cfish_NumUtil_u1get(verified_labels, tick)) {
- SV *const key_sv = stack[tick];
- char *key = SvPV_nolen(key_sv);
- cfish_CharBuf *mess
- = CFISH_MAKE_MESS("Invalid parameter: '%s'", key);
- cfish_Err_set_error(cfish_Err_new(mess));
- return false;
- }
- }
-
- return true;
-}
-
-/***************************************************************************
- * The routines below are declared within the Clownfish core but left
- * unimplemented and must be defined for each host language.
- ***************************************************************************/
-
-/**************************** Clownfish::Obj *******************************/
-
-static void
-S_lazy_init_host_obj(cfish_Obj *self) {
- SV *inner_obj = newSV(0);
- SvOBJECT_on(inner_obj);
-#if (PERL_VERSION <= 16)
- PL_sv_objcount++;
-#endif
- (void)SvUPGRADE(inner_obj, SVt_PVMG);
- sv_setiv(inner_obj, PTR2IV(self));
-
- // Connect class association.
- cfish_CharBuf *class_name = Cfish_VTable_Get_Name(self->vtable);
- HV *stash = gv_stashpvn((char*)Cfish_CB_Get_Ptr8(class_name),
- Cfish_CB_Get_Size(class_name), TRUE);
- SvSTASH_set(inner_obj, (HV*)SvREFCNT_inc(stash));
-
- /* Up till now we've been keeping track of the refcount in
- * self->ref.count. We're replacing ref.count with ref.host_obj, which
- * will assume responsibility for maintaining the refcount. ref.host_obj
- * starts off with a refcount of 1, so we need to transfer any refcounts
- * in excess of that. */
- size_t old_refcount = self->ref.count;
- self->ref.host_obj = inner_obj;
- SvREFCNT(inner_obj) += (old_refcount >> XSBIND_REFCOUNT_SHIFT) - 1;
-}
-
-uint32_t
-cfish_Obj_get_refcount(cfish_Obj *self) {
- return self->ref.count & XSBIND_REFCOUNT_FLAG
- ? self->ref.count >> XSBIND_REFCOUNT_SHIFT
- : SvREFCNT((SV*)self->ref.host_obj);
-}
-
-cfish_Obj*
-cfish_Obj_inc_refcount(cfish_Obj *self) {
- if (self->ref.count & XSBIND_REFCOUNT_FLAG) {
- if (self->ref.count == XSBIND_REFCOUNT_FLAG) {
- CFISH_THROW(CFISH_ERR, "Illegal refcount of 0");
- }
- self->ref.count += 1 << XSBIND_REFCOUNT_SHIFT;
- }
- else {
- SvREFCNT_inc_simple_void_NN((SV*)self->ref.host_obj);
- }
- return self;
-}
-
-uint32_t
-cfish_Obj_dec_refcount(cfish_Obj *self) {
- uint32_t modified_refcount = I32_MAX;
- if (self->ref.count & XSBIND_REFCOUNT_FLAG) {
- if (self->ref.count == XSBIND_REFCOUNT_FLAG) {
- CFISH_THROW(CFISH_ERR, "Illegal refcount of 0");
- }
- if (self->ref.count
- == ((1 << XSBIND_REFCOUNT_SHIFT) | XSBIND_REFCOUNT_FLAG)) {
- modified_refcount = 0;
- Cfish_Obj_Destroy(self);
- }
- else {
- self->ref.count -= 1 << XSBIND_REFCOUNT_SHIFT;
- modified_refcount = self->ref.count >> XSBIND_REFCOUNT_SHIFT;
- }
- }
- else {
- modified_refcount = SvREFCNT((SV*)self->ref.host_obj) - 1;
- // If the SV's refcount falls to 0, DESTROY will be invoked from
- // Perl-space.
- SvREFCNT_dec((SV*)self->ref.host_obj);
- }
- return modified_refcount;
-}
-
-void*
-cfish_Obj_to_host(cfish_Obj *self) {
- if (self->ref.count & XSBIND_REFCOUNT_FLAG) { S_lazy_init_host_obj(self); }
- return newRV_inc((SV*)self->ref.host_obj);
-}
-
-/*************************** Clownfish::VTable ******************************/
-
-cfish_Obj*
-cfish_VTable_make_obj(cfish_VTable *self) {
- cfish_Obj *obj
- = (cfish_Obj*)cfish_Memory_wrapped_calloc(self->obj_alloc_size, 1);
- obj->vtable = self;
- obj->ref.count = (1 << XSBIND_REFCOUNT_SHIFT) | XSBIND_REFCOUNT_FLAG;
- return obj;
-}
-
-cfish_Obj*
-cfish_VTable_init_obj(cfish_VTable *self, void *allocation) {
- cfish_Obj *obj = (cfish_Obj*)allocation;
- obj->vtable = self;
- obj->ref.count = (1 << XSBIND_REFCOUNT_SHIFT) | XSBIND_REFCOUNT_FLAG;
- return obj;
-}
-
-cfish_Obj*
-cfish_VTable_foster_obj(cfish_VTable *self, void *host_obj) {
- cfish_Obj *obj
- = (cfish_Obj*)cfish_Memory_wrapped_calloc(self->obj_alloc_size, 1);
- SV *inner_obj = SvRV((SV*)host_obj);
- obj->vtable = self;
- sv_setiv(inner_obj, PTR2IV(obj));
- obj->ref.host_obj = inner_obj;
- return obj;
-}
-
-void
-cfish_VTable_register_with_host(cfish_VTable *singleton, cfish_VTable *parent) {
- dSP;
- ENTER;
- SAVETMPS;
- EXTEND(SP, 2);
- PUSHMARK(SP);
- mPUSHs((SV*)Cfish_VTable_To_Host(singleton));
- mPUSHs((SV*)Cfish_VTable_To_Host(parent));
- PUTBACK;
- call_pv("Clownfish::VTable::_register", G_VOID | G_DISCARD);
- FREETMPS;
- LEAVE;
-}
-
-cfish_VArray*
-cfish_VTable_fresh_host_methods(const cfish_CharBuf *class_name) {
- dSP;
- ENTER;
- SAVETMPS;
- EXTEND(SP, 1);
- PUSHMARK(SP);
- mPUSHs(XSBind_cb_to_sv(class_name));
- PUTBACK;
- call_pv("Clownfish::VTable::_fresh_host_methods", G_SCALAR);
- SPAGAIN;
- cfish_VArray *methods = (cfish_VArray*)XSBind_perl_to_cfish(POPs);
- PUTBACK;
- FREETMPS;
- LEAVE;
- return methods;
-}
-
-cfish_CharBuf*
-cfish_VTable_find_parent_class(const cfish_CharBuf *class_name) {
- dSP;
- ENTER;
- SAVETMPS;
- EXTEND(SP, 1);
- PUSHMARK(SP);
- mPUSHs(XSBind_cb_to_sv(class_name));
- PUTBACK;
- call_pv("Clownfish::VTable::_find_parent_class", G_SCALAR);
- SPAGAIN;
- SV *parent_class_sv = POPs;
- PUTBACK;
- cfish_CharBuf *parent_class
- = (cfish_CharBuf*)XSBind_perl_to_cfish(parent_class_sv);
- FREETMPS;
- LEAVE;
- return parent_class;
-}
-
-void*
-cfish_VTable_to_host(cfish_VTable *self) {
- bool first_time = self->ref.count & XSBIND_REFCOUNT_FLAG ? true : false;
- Cfish_VTable_To_Host_t to_host
- = CFISH_SUPER_METHOD_PTR(CFISH_VTABLE, Cfish_VTable_To_Host);
- SV *host_obj = (SV*)to_host(self);
- if (first_time) {
- SvSHARE((SV*)self->ref.host_obj);
- }
- return host_obj;
-}
-
-
-/***************************** Clownfish::Err *******************************/
-
-// Anonymous XSUB helper for Err#trap(). It wraps the supplied C function
-// so that it can be run inside a Perl eval block.
-static SV *attempt_xsub = NULL;
-
-XS(cfish_Err_attempt_via_xs) {
- dXSARGS;
- CHY_UNUSED_VAR(cv);
- SP -= items;
- if (items != 2) {
- CFISH_THROW(CFISH_ERR, "Usage: $sub->(routine, context)");
- };
- IV routine_iv = SvIV(ST(0));
- IV context_iv = SvIV(ST(1));
- Cfish_Err_Attempt_t routine = INT2PTR(Cfish_Err_Attempt_t, routine_iv);
- void *context = INT2PTR(void*, context_iv);
- routine(context);
- XSRETURN(0);
-}
-
-void
-cfish_Err_init_class(void) {
- char *file = (char*)__FILE__;
- attempt_xsub = (SV*)newXS(NULL, cfish_Err_attempt_via_xs, file);
-}
-
-cfish_Err*
-cfish_Err_get_error() {
- dSP;
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- PUTBACK;
- call_pv("Clownfish::Err::get_error", G_SCALAR);
- SPAGAIN;
- cfish_Err *error = (cfish_Err*)XSBind_perl_to_cfish(POPs);
- PUTBACK;
- FREETMPS;
- LEAVE;
- return error;
-}
-
-void
-cfish_Err_set_error(cfish_Err *error) {
- dSP;
- ENTER;
- SAVETMPS;
- EXTEND(SP, 2);
- PUSHMARK(SP);
- PUSHmortal;
- if (error) {
- mPUSHs((SV*)Cfish_Err_To_Host(error));
- }
- else {
- PUSHmortal;
- }
- PUTBACK;
- call_pv("Clownfish::Err::set_error", G_VOID | G_DISCARD);
- FREETMPS;
- LEAVE;
-}
-
-void
-cfish_Err_do_throw(cfish_Err *err) {
- dSP;
- SV *error_sv = (SV*)Cfish_Err_To_Host(err);
- CFISH_DECREF(err);
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(error_sv));
- PUTBACK;
- call_pv("Clownfish::Err::do_throw", G_DISCARD);
- FREETMPS;
- LEAVE;
-}
-
-void*
-cfish_Err_to_host(cfish_Err *self) {
- Cfish_Err_To_Host_t super_to_host
- = CFISH_SUPER_METHOD_PTR(CFISH_ERR, Cfish_Err_To_Host);
- SV *perl_obj = (SV*)super_to_host(self);
- XSBind_enable_overload(perl_obj);
- return perl_obj;
-}
-
-void
-cfish_Err_throw_mess(cfish_VTable *vtable, cfish_CharBuf *message) {
- Cfish_Err_Make_t make
- = CFISH_METHOD_PTR(CFISH_CERTIFY(vtable, CFISH_VTABLE), Cfish_Err_Make);
- cfish_Err *err = (cfish_Err*)CFISH_CERTIFY(make(NULL), CFISH_ERR);
- Cfish_Err_Cat_Mess(err, message);
- CFISH_DECREF(message);
- cfish_Err_do_throw(err);
-}
-
-void
-cfish_Err_warn_mess(cfish_CharBuf *message) {
- SV *error_sv = XSBind_cb_to_sv(message);
- CFISH_DECREF(message);
- warn("%s", SvPV_nolen(error_sv));
- SvREFCNT_dec(error_sv);
-}
-
-cfish_Err*
-cfish_Err_trap(Cfish_Err_Attempt_t routine, void *context) {
- cfish_Err *error = NULL;
- SV *routine_sv = newSViv(PTR2IV(routine));
- SV *context_sv = newSViv(PTR2IV(context));
- dSP;
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- EXTEND(SP, 2);
- PUSHs(sv_2mortal(routine_sv));
- PUSHs(sv_2mortal(context_sv));
- PUTBACK;
-
- int count = call_sv(attempt_xsub, G_EVAL | G_DISCARD);
- if (count != 0) {
- cfish_CharBuf *mess
- = cfish_CB_newf("'attempt' returned too many values: %i32",
- (int32_t)count);
- error = cfish_Err_new(mess);
- }
- else {
- SV *dollar_at = get_sv("@", FALSE);
- if (SvTRUE(dollar_at)) {
- if (sv_isobject(dollar_at)
- && sv_derived_from(dollar_at,"Clownfish::Err")
- ) {
- IV error_iv = SvIV(SvRV(dollar_at));
- error = INT2PTR(cfish_Err*, error_iv);
- CFISH_INCREF(error);
- }
- else {
- STRLEN len;
- char *ptr = SvPVutf8(dollar_at, len);
- cfish_CharBuf *mess = cfish_CB_new_from_trusted_utf8(ptr, len);
- error = cfish_Err_new(mess);
- }
- }
- }
- FREETMPS;
- LEAVE;
-
- return error;
-}
-
-/*********************** Clownfish::LockFreeRegistry ************************/
-
-void*
-cfish_LFReg_to_host(cfish_LockFreeRegistry *self) {
- bool first_time = self->ref.count & XSBIND_REFCOUNT_FLAG ? true : false;
- Cfish_LFReg_To_Host_t to_host
- = CFISH_SUPER_METHOD_PTR(CFISH_LOCKFREEREGISTRY, Cfish_LFReg_To_Host);
- SV *host_obj = (SV*)to_host(self);
- if (first_time) {
- SvSHARE((SV*)self->ref.host_obj);
- }
- return host_obj;
-}
-
http://git-wip-us.apache.org/repos/asf/lucy/blob/ddff7ce9/perl/xs/XSBind.h
----------------------------------------------------------------------
diff --git a/perl/xs/XSBind.h b/perl/xs/XSBind.h
deleted file mode 100644
index c5a5453..0000000
--- a/perl/xs/XSBind.h
+++ /dev/null
@@ -1,347 +0,0 @@
-/* Licensed to the Apache Software Foundation (ASF) under one or more
- * contributor license agreements. See the NOTICE file distributed with
- * this work for additional information regarding copyright ownership.
- * The ASF licenses this file to You under the Apache License, Version 2.0
- * (the "License"); you may not use this file except in compliance with
- * the License. You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- */
-
-/* XSBind.h -- Functions to help bind Clownfish to Perl XS api.
- */
-
-#ifndef H_CFISH_XSBIND
-#define H_CFISH_XSBIND 1
-
-#include "charmony.h"
-#include "Clownfish/Obj.h"
-#include "Clownfish/ByteBuf.h"
-#include "Clownfish/CharBuf.h"
-#include "Clownfish/Err.h"
-#include "Clownfish/Hash.h"
-#include "Clownfish/Num.h"
-#include "Clownfish/VArray.h"
-#include "Clownfish/VTable.h"
-
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#define NEED_newRV_noinc_GLOBAL
-#include "ppport.h"
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/** Given either a class name or a perl object, manufacture a new Clownfish
- * object suitable for supplying to a cfish_Foo_init() function.
- */
-CFISH_VISIBLE cfish_Obj*
-cfish_XSBind_new_blank_obj(SV *either_sv);
-
-/** Test whether an SV is defined. Handles "get" magic, unlike SvOK on its
- * own.
- */
-static CFISH_INLINE bool
-cfish_XSBind_sv_defined(SV *sv) {
- if (!sv || !SvANY(sv)) { return false; }
- if (SvGMAGICAL(sv)) { mg_get(sv); }
- return SvOK(sv);
-}
-
-/** If the SV contains a Clownfish object which passes an "isa" test against the
- * passed-in VTable, return a pointer to it. If not, but
- * <code>allocation</code> is non-NULL and a ZombieCharBuf would satisfy the
- * "isa" test, stringify the SV, create a ZombieCharBuf using
- * <code>allocation</code>, assign the SV's string to it, and return that
- * instead. If all else fails, throw an exception.
- */
-CFISH_VISIBLE cfish_Obj*
-cfish_XSBind_sv_to_cfish_obj(SV *sv, cfish_VTable *vtable, void *allocation);
-
-/** As XSBind_sv_to_cfish_obj above, but returns NULL instead of throwing an
- * exception.
- */
-CFISH_VISIBLE cfish_Obj*
-cfish_XSBind_maybe_sv_to_cfish_obj(SV *sv, cfish_VTable *vtable,
- void *allocation);
-
-
-/** Derive an SV from a Clownfish object. If the Clownfish object is NULL, the SV
- * will be undef.
- *
- * The new SV has single refcount for which the caller must take
- * responsibility.
- */
-static CFISH_INLINE SV*
-cfish_XSBind_cfish_obj_to_sv(cfish_Obj *obj) {
- return obj ? (SV*)Cfish_Obj_To_Host(obj) : newSV(0);
-}
-
-/** XSBind_cfish_obj_to_sv, with a cast.
- */
-#define CFISH_OBJ_TO_SV(_obj) cfish_XSBind_cfish_obj_to_sv((cfish_Obj*)_obj)
-
-/** As XSBind_cfish_obj_to_sv above, except decrements the object's refcount
- * after creating the SV. This is useful when the Clownfish expression creates a new
- * refcount, e.g. a call to a constructor.
- */
-static CFISH_INLINE SV*
-cfish_XSBind_cfish_obj_to_sv_noinc(cfish_Obj *obj) {
- SV *retval;
- if (obj) {
- retval = (SV*)Cfish_Obj_To_Host(obj);
- Cfish_Obj_Dec_RefCount(obj);
- }
- else {
- retval = newSV(0);
- }
- return retval;
-}
-
-/** XSBind_cfish_obj_to_sv_noinc, with a cast.
- */
-#define CFISH_OBJ_TO_SV_NOINC(_obj) \
- cfish_XSBind_cfish_obj_to_sv_noinc((cfish_Obj*)_obj)
-
-/** Deep conversion of Clownfish objects to Perl objects -- CharBufs to UTF-8
- * SVs, ByteBufs to SVs, VArrays to Perl array refs, Hashes to Perl hashrefs,
- * and any other object to a Perl object wrapping the Clownfish Obj.
- */
-CFISH_VISIBLE SV*
-cfish_XSBind_cfish_to_perl(cfish_Obj *obj);
-
-/** Deep conversion of Perl data structures to Clownfish objects -- Perl hash
- * to Hash, Perl array to VArray, Clownfish objects stripped of their
- * wrappers, and everything else stringified and turned to a CharBuf.
- */
-CFISH_VISIBLE cfish_Obj*
-cfish_XSBind_perl_to_cfish(SV *sv);
-
-/** Convert a ByteBuf into a new string SV.
- */
-CFISH_VISIBLE SV*
-cfish_XSBind_bb_to_sv(const cfish_ByteBuf *bb);
-
-/** Convert a CharBuf into a new UTF-8 string SV.
- */
-CFISH_VISIBLE SV*
-cfish_XSBind_cb_to_sv(const cfish_CharBuf *cb);
-
-/** Perl-specific wrapper for Err#trap. The "routine" must be either a
- * subroutine reference or the name of a subroutine.
- */
-cfish_Err*
-cfish_XSBind_trap(SV *routine, SV *context);
-
-/** Turn on overloading for the supplied Perl object and its class.
- */
-CFISH_VISIBLE void
-cfish_XSBind_enable_overload(void *pobj);
-
-/** Process hash-style params passed to an XS subroutine. The varargs must be
- * a NULL-terminated series of ALLOT_ macros.
- *
- * cfish_XSBind_allot_params(stack, start, num_stack_elems,
- * ALLOT_OBJ(&field, "field", 5, CFISH_CHARBUF, true, alloca(cfish_ZCB_size()),
- * ALLOT_OBJ(&term, "term", 4, CFISH_CHARBUF, true, alloca(cfish_ZCB_size()),
- * NULL);
- *
- * The following ALLOT_ macros are available for primitive types:
- *
- * ALLOT_I8(ptr, key, keylen, required)
- * ALLOT_I16(ptr, key, keylen, required)
- * ALLOT_I32(ptr, key, keylen, required)
- * ALLOT_I64(ptr, key, keylen, required)
- * ALLOT_U8(ptr, key, keylen, required)
- * ALLOT_U16(ptr, key, keylen, required)
- * ALLOT_U32(ptr, key, keylen, required)
- * ALLOT_U64(ptr, key, keylen, required)
- * ALLOT_BOOL(ptr, key, keylen, required)
- * ALLOT_CHAR(ptr, key, keylen, required)
- * ALLOT_SHORT(ptr, key, keylen, required)
- * ALLOT_INT(ptr, key, keylen, required)
- * ALLOT_LONG(ptr, key, keylen, required)
- * ALLOT_SIZE_T(ptr, key, keylen, required)
- * ALLOT_F32(ptr, key, keylen, required)
- * ALLOT_F64(ptr, key, keylen, required)
- *
- * The four arguments to these ALLOT_ macros have the following meanings:
- *
- * ptr -- A pointer to the variable to be extracted.
- * key -- The name of the parameter as a C string.
- * keylen -- The length of the parameter name in bytes.
- * required -- A boolean indicating whether the parameter is required.
- *
- * If a required parameter is not present, allot_params() will set Err_error
- * and return false.
- *
- * Use the following macro if a Clownfish object is desired:
- *
- * ALLOT_OBJ(ptr, key, keylen, required, vtable, allocation)
- *
- * The "vtable" argument must be the VTable corresponding to the class of the
- * desired object. The "allocation" argument must be a blob of memory
- * allocated on the stack sufficient to hold a ZombieCharBuf. (Use
- * cfish_ZCB_size() to find the allocation size.)
- *
- * To extract a Perl scalar, use the following ALLOT_ macro:
- *
- * ALLOT_SV(ptr, key, keylen, required)
- *
- * All possible valid param names must be passed via the ALLOT_ macros; if a
- * user-supplied param cannot be matched up with an ALLOT_ macro,
- * allot_params() will set Err_error and return false.
- *
- * @param stack The Perl stack.
- * @param start Where on the Perl stack to start looking for params. For
- * methods, this would typically be 1; for functions, most likely 0.
- * @param num_stack_elems The number of arguments passed to the Perl function
- * (generally, the XS variable "items").
- * @return true on success, false on failure (sets Err_error).
- */
-CFISH_VISIBLE bool
-cfish_XSBind_allot_params(SV** stack, int32_t start,
- int32_t num_stack_elems, ...);
-
-#define XSBIND_WANT_I8 0x1
-#define XSBIND_WANT_I16 0x2
-#define XSBIND_WANT_I32 0x3
-#define XSBIND_WANT_I64 0x4
-#define XSBIND_WANT_U8 0x5
-#define XSBIND_WANT_U16 0x6
-#define XSBIND_WANT_U32 0x7
-#define XSBIND_WANT_U64 0x8
-#define XSBIND_WANT_BOOL 0x9
-#define XSBIND_WANT_F32 0xA
-#define XSBIND_WANT_F64 0xB
-#define XSBIND_WANT_OBJ 0xC
-#define XSBIND_WANT_SV 0xD
-
-#if (CHY_SIZEOF_CHAR == 1)
- #define XSBIND_WANT_CHAR XSBIND_WANT_I8
-#else
- #error "Can't build unless sizeof(char) == 1"
-#endif
-
-#if (CHY_SIZEOF_SHORT == 2)
- #define XSBIND_WANT_SHORT XSBIND_WANT_I16
-#else
- #error "Can't build unless sizeof(short) == 2"
-#endif
-
-#if (CHY_SIZEOF_INT == 4)
- #define XSBIND_WANT_INT XSBIND_WANT_I32
-#else // sizeof(int) == 8
- #define XSBIND_WANT_INT XSBIND_WANT_I64
-#endif
-
-#if (CHY_SIZEOF_LONG == 4)
- #define XSBIND_WANT_LONG XSBIND_WANT_I32
-#else // sizeof(long) == 8
- #define XSBIND_WANT_LONG XSBIND_WANT_I64
-#endif
-
-#if (CHY_SIZEOF_SIZE_T == 4)
- #define XSBIND_WANT_SIZE_T XSBIND_WANT_U32
-#else // sizeof(long) == 8
- #define XSBIND_WANT_SIZE_T XSBIND_WANT_U64
-#endif
-
-#define XSBIND_ALLOT_I8(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_I8, NULL, NULL
-#define XSBIND_ALLOT_I16(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_I16, NULL, NULL
-#define XSBIND_ALLOT_I32(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_I32, NULL, NULL
-#define XSBIND_ALLOT_I64(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_I64, NULL, NULL
-#define XSBIND_ALLOT_U8(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_U8, NULL, NULL
-#define XSBIND_ALLOT_U16(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_U16, NULL, NULL
-#define XSBIND_ALLOT_U32(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_U32, NULL, NULL
-#define XSBIND_ALLOT_U64(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_U64, NULL, NULL
-#define XSBIND_ALLOT_BOOL(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_BOOL, NULL, NULL
-#define XSBIND_ALLOT_CHAR(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_CHAR, NULL, NULL
-#define XSBIND_ALLOT_SHORT(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_SHORT, NULL, NULL
-#define XSBIND_ALLOT_INT(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_INT, NULL, NULL
-#define XSBIND_ALLOT_LONG(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_LONG, NULL, NULL
-#define XSBIND_ALLOT_SIZE_T(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_SIZE_T, NULL, NULL
-#define XSBIND_ALLOT_F32(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_F32, NULL, NULL
-#define XSBIND_ALLOT_F64(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_F64, NULL, NULL
-#define XSBIND_ALLOT_OBJ(ptr, key, keylen, required, vtable, allocation) \
- ptr, key, keylen, required, XSBIND_WANT_OBJ, vtable, allocation
-#define XSBIND_ALLOT_SV(ptr, key, keylen, required) \
- ptr, key, keylen, required, XSBIND_WANT_SV, NULL, NULL
-
-/* Define short names for most of the symbols in this file. Note that these
- * short names are ALWAYS in effect, since they are only used for Perl and we
- * can be confident they don't conflict with anything. (It's prudent to use
- * full symbols nevertheless in case someone else defines e.g. a function
- * named "XSBind_sv_defined".)
- */
-#define XSBind_new_blank_obj cfish_XSBind_new_blank_obj
-#define XSBind_sv_defined cfish_XSBind_sv_defined
-#define XSBind_sv_to_cfish_obj cfish_XSBind_sv_to_cfish_obj
-#define XSBind_maybe_sv_to_cfish_obj cfish_XSBind_maybe_sv_to_cfish_obj
-#define XSBind_cfish_obj_to_sv cfish_XSBind_cfish_obj_to_sv
-#define XSBind_cfish_obj_to_sv_noinc cfish_XSBind_cfish_obj_to_sv_noinc
-#define XSBind_cfish_to_perl cfish_XSBind_cfish_to_perl
-#define XSBind_perl_to_cfish cfish_XSBind_perl_to_cfish
-#define XSBind_bb_to_sv cfish_XSBind_bb_to_sv
-#define XSBind_cb_to_sv cfish_XSBind_cb_to_sv
-#define XSBind_trap cfish_XSBind_trap
-#define XSBind_enable_overload cfish_XSBind_enable_overload
-#define XSBind_allot_params cfish_XSBind_allot_params
-#define ALLOT_I8 XSBIND_ALLOT_I8
-#define ALLOT_I16 XSBIND_ALLOT_I16
-#define ALLOT_I32 XSBIND_ALLOT_I32
-#define ALLOT_I64 XSBIND_ALLOT_I64
-#define ALLOT_U8 XSBIND_ALLOT_U8
-#define ALLOT_U16 XSBIND_ALLOT_U16
-#define ALLOT_U32 XSBIND_ALLOT_U32
-#define ALLOT_U64 XSBIND_ALLOT_U64
-#define ALLOT_BOOL XSBIND_ALLOT_BOOL
-#define ALLOT_CHAR XSBIND_ALLOT_CHAR
-#define ALLOT_SHORT XSBIND_ALLOT_SHORT
-#define ALLOT_INT XSBIND_ALLOT_INT
-#define ALLOT_LONG XSBIND_ALLOT_LONG
-#define ALLOT_SIZE_T XSBIND_ALLOT_SIZE_T
-#define ALLOT_F32 XSBIND_ALLOT_F32
-#define ALLOT_F64 XSBIND_ALLOT_F64
-#define ALLOT_OBJ XSBIND_ALLOT_OBJ
-#define ALLOT_SV XSBIND_ALLOT_SV
-
-/* Strip the prefix from some common ClownFish symbols where we know there's
- * no conflict with Perl. It's a little inconsistent to do this rather than
- * leave all symbols at full size, but the succinctness is worth it.
- */
-#define THROW CFISH_THROW
-#define WARN CFISH_WARN
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif // H_CFISH_XSBIND
-
-