You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by lo...@apache.org on 2012/01/16 16:10:05 UTC
[lucy-commits] svn commit: r1232020 [2/3] - in /incubator/lucy/trunk/perl/buildlib: Lucy/
Lucy/Build/ Lucy/Build/Binding/ Lucy/Build/Binding/Index/
Lucy/Build/Binding/Search/ Lucy/Build/Binding/Test/ LucyX/ LucyX/Build/
LucyX/Build/Binding/
Added: incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Object.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Object.pm?rev=1232020&view=auto
==============================================================================
--- incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Object.pm (added)
+++ incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Object.pm Mon Jan 16 15:10:03 2012
@@ -0,0 +1,890 @@
+# 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 Lucy::Build::Binding::Object;
+
+
+sub bind_all {
+ my $class = shift;
+ $class->bind_bitvector;
+ $class->bind_bytebuf;
+ $class->bind_charbuf;
+ $class->bind_err;
+ $class->bind_hash;
+ $class->bind_host;
+ $class->bind_i32array;
+ $class->bind_lockfreeregistry;
+ $class->bind_num;
+ $class->bind_obj;
+ $class->bind_varray;
+ $class->bind_vtable;
+}
+
+sub bind_bitvector {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $bit_vec = Lucy::Object::BitVector->new( capacity => 8 );
+ my $other = Lucy::Object::BitVector->new( capacity => 8 );
+ $bit_vec->set($_) for ( 0, 2, 4, 6 );
+ $other->set($_) for ( 1, 3, 5, 7 );
+ $bit_vec->or($other);
+ print "$_\n" for @{ $bit_vec->to_array }; # prints 0 through 7.
+END_SYNOPSIS
+my $constructor = <<'END_CONSTRUCTOR';
+ my $bit_vec = Lucy::Object::BitVector->new(
+ capacity => $doc_max + 1, # default 0,
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::BitVector",
+ bind_methods => [
+ qw( Get
+ Set
+ Clear
+ Clear_All
+ And
+ Or
+ And_Not
+ Xor
+ Flip
+ Flip_Block
+ Next_Hit
+ To_Array
+ Grow
+ Count
+ Get_Capacity
+ )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [
+ qw( get
+ set
+ clear
+ clear_all
+ and
+ or
+ and_not
+ xor
+ flip
+ flip_block
+ next_hit
+ to_array
+ grow
+ count
+ )
+ ],
+ }
+);
+
+}
+
+sub bind_bytebuf {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::ByteBuf
+
+SV*
+new(either_sv, sv)
+ SV *either_sv;
+ SV *sv;
+CODE:
+{
+ STRLEN size;
+ char *ptr = SvPV(sv, size);
+ lucy_ByteBuf *self = (lucy_ByteBuf*)XSBind_new_blank_obj(either_sv);
+ lucy_BB_init(self, size);
+ Lucy_BB_Mimic_Bytes(self, ptr, size);
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
+}
+OUTPUT: RETVAL
+
+SV*
+_deserialize(self, instream)
+ lucy_ByteBuf *self;
+ lucy_InStream *instream;
+CODE:
+ lucy_ByteBuf *thawed = Lucy_BB_Deserialize(self, instream);
+ RETVAL = (SV*)Lucy_BB_To_Host(thawed);
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::ByteBuf",
+ xs_code => $xs_code,
+ bind_methods => [
+ qw(
+ Get_Size
+ Get_Capacity
+ Cat
+ )
+ ],
+);
+
+}
+
+sub bind_charbuf {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::CharBuf
+
+SV*
+new(either_sv, sv)
+ SV *either_sv;
+ SV *sv;
+CODE:
+{
+ STRLEN size;
+ char *ptr = SvPVutf8(sv, size);
+ lucy_CharBuf *self = (lucy_CharBuf*)XSBind_new_blank_obj(either_sv);
+ lucy_CB_init(self, size);
+ Lucy_CB_Cat_Trusted_Str(self, ptr, size);
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
+}
+OUTPUT: RETVAL
+
+SV*
+_clone(self)
+ lucy_CharBuf *self;
+CODE:
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(lucy_CB_clone(self));
+OUTPUT: RETVAL
+
+SV*
+_deserialize(self, instream)
+ lucy_CharBuf *self;
+ lucy_InStream *instream;
+CODE:
+ lucy_CharBuf *thawed = Lucy_CB_Deserialize(self, instream);
+ RETVAL = (SV*)Lucy_CB_To_Host(thawed);
+OUTPUT: RETVAL
+
+SV*
+to_perl(self)
+ lucy_CharBuf *self;
+CODE:
+ RETVAL = XSBind_cb_to_sv(self);
+OUTPUT: RETVAL
+
+MODULE = Lucy PACKAGE = Lucy::Object::ViewCharBuf
+
+SV*
+_new(unused, sv)
+ SV *unused;
+ SV *sv;
+CODE:
+{
+ STRLEN size;
+ char *ptr = SvPVutf8(sv, size);
+ lucy_ViewCharBuf *self
+ = lucy_ViewCB_new_from_trusted_utf8(ptr, size);
+ CHY_UNUSED_VAR(unused);
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
+}
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::CharBuf",
+ xs_code => $xs_code,
+);
+
+}
+
+sub bind_err {
+ my $synopsis = <<'END_SYNOPSIS';
+ use Scalar::Util qw( blessed );
+ my $bg_merger;
+ while (1) {
+ $bg_merger = eval {
+ Lucy::Index::BackgroundMerger->new( index => $index );
+ };
+ last if $bg_merger;
+ if ( blessed($@) and $@->isa("Lucy::Store::LockErr") ) {
+ warn "Retrying...\n";
+ }
+ else {
+ # Re-throw.
+ die "Failed to open BackgroundMerger: $@";
+ }
+ }
+END_SYNOPSIS
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::Err",
+ bind_methods => [qw( Cat_Mess Get_Mess )],
+ make_pod => { synopsis => $synopsis },
+ bind_constructors => ["_new"],
+);
+
+}
+
+sub bind_hash {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::Hash
+
+SV*
+_deserialize(self, instream)
+ lucy_Hash *self;
+ lucy_InStream *instream;
+CODE:
+ lucy_Hash *thawed = Lucy_Hash_Deserialize(self, instream);
+ RETVAL = (SV*)Lucy_Hash_To_Host(thawed);
+OUTPUT: RETVAL
+
+SV*
+_fetch(self, key)
+ lucy_Hash *self;
+ const lucy_CharBuf *key;
+CODE:
+ RETVAL = CFISH_OBJ_TO_SV(lucy_Hash_fetch(self, (lucy_Obj*)key));
+OUTPUT: RETVAL
+
+void
+store(self, key, value);
+ lucy_Hash *self;
+ const lucy_CharBuf *key;
+ lucy_Obj *value;
+PPCODE:
+{
+ if (value) { CFISH_INCREF(value); }
+ lucy_Hash_store(self, (lucy_Obj*)key, value);
+}
+
+void
+next(self)
+ lucy_Hash *self;
+PPCODE:
+{
+ lucy_Obj *key;
+ lucy_Obj *val;
+
+ if (Lucy_Hash_Next(self, &key, &val)) {
+ SV *key_sv = (SV*)Lucy_Obj_To_Host(key);
+ SV *val_sv = (SV*)Lucy_Obj_To_Host(val);
+
+ XPUSHs(sv_2mortal(key_sv));
+ XPUSHs(sv_2mortal(val_sv));
+ XSRETURN(2);
+ }
+ else {
+ XSRETURN_EMPTY;
+ }
+}
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::Hash",
+ xs_code => $xs_code,
+ bind_methods => [
+ qw(
+ Fetch
+ Delete
+ Keys
+ Values
+ Find_Key
+ Clear
+ Iterate
+ Get_Size
+ )
+ ],
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_host {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::Host
+
+=for comment
+
+These are all for testing purposes only.
+
+=cut
+
+IV
+_test(...)
+CODE:
+ RETVAL = items;
+OUTPUT: RETVAL
+
+SV*
+_test_obj(...)
+CODE:
+{
+ lucy_ByteBuf *test_obj = lucy_BB_new_bytes("blah", 4);
+ SV *pack_var = get_sv("Lucy::Object::Host::testobj", 1);
+ RETVAL = (SV*)Lucy_BB_To_Host(test_obj);
+ SvSetSV_nosteal(pack_var, RETVAL);
+ CFISH_DECREF(test_obj);
+ CHY_UNUSED_VAR(items);
+}
+OUTPUT: RETVAL
+
+void
+_callback(obj)
+ lucy_Obj *obj;
+PPCODE:
+{
+ lucy_ZombieCharBuf *blank = CFISH_ZCB_BLANK();
+ lucy_Host_callback(obj, "_test", 2,
+ CFISH_ARG_OBJ("nothing", (lucy_CharBuf*)blank),
+ CFISH_ARG_I32("foo", 3));
+}
+
+int64_t
+_callback_i64(obj)
+ lucy_Obj *obj;
+CODE:
+{
+ lucy_ZombieCharBuf *blank = CFISH_ZCB_BLANK();
+ RETVAL
+ = lucy_Host_callback_i64(obj, "_test", 2,
+ CFISH_ARG_OBJ("nothing", (lucy_CharBuf*)blank),
+ CFISH_ARG_I32("foo", 3));
+}
+OUTPUT: RETVAL
+
+double
+_callback_f64(obj)
+ lucy_Obj *obj;
+CODE:
+{
+ lucy_ZombieCharBuf *blank = CFISH_ZCB_BLANK();
+ RETVAL
+ = lucy_Host_callback_f64(obj, "_test", 2,
+ CFISH_ARG_OBJ("nothing", (lucy_CharBuf*)blank),
+ CFISH_ARG_I32("foo", 3));
+}
+OUTPUT: RETVAL
+
+SV*
+_callback_obj(obj)
+ lucy_Obj *obj;
+CODE:
+{
+ lucy_Obj *other = lucy_Host_callback_obj(obj, "_test_obj", 0);
+ RETVAL = (SV*)Lucy_Obj_To_Host(other);
+ CFISH_DECREF(other);
+}
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::Host",
+ xs_code => $xs_code,
+);
+
+}
+
+sub bind_i32array {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::I32Array
+
+SV*
+new(either_sv, ...)
+ SV *either_sv;
+CODE:
+{
+ SV *ints_sv = NULL;
+ lucy_I32Array *self = NULL;
+
+ chy_bool_t args_ok
+ = XSBind_allot_params(&(ST(0)), 1, items,
+ "Lucy::Object::I32Array::new_PARAMS",
+ ALLOT_SV(&ints_sv, "ints", 4, true),
+ NULL);
+ if (!args_ok) {
+ CFISH_RETHROW(CFISH_INCREF(cfish_Err_get_error()));
+ }
+
+ AV *ints_av = NULL;
+ if (SvROK(ints_sv)) {
+ ints_av = (AV*)SvRV(ints_sv);
+ }
+ if (ints_av && SvTYPE(ints_av) == SVt_PVAV) {
+ int32_t size = av_len(ints_av) + 1;
+ int32_t *ints = (int32_t*)LUCY_MALLOCATE(size * sizeof(int32_t));
+ int32_t i;
+
+ for (i = 0; i < size; i++) {
+ SV **const sv_ptr = av_fetch(ints_av, i, 0);
+ ints[i] = (sv_ptr && XSBind_sv_defined(*sv_ptr))
+ ? SvIV(*sv_ptr)
+ : 0;
+ }
+ self = (lucy_I32Array*)XSBind_new_blank_obj(either_sv);
+ lucy_I32Arr_init(self, ints, size);
+ }
+ else {
+ THROW(LUCY_ERR, "Required param 'ints' isn't an arrayref");
+ }
+
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
+}
+OUTPUT: RETVAL
+
+SV*
+to_arrayref(self)
+ lucy_I32Array *self;
+CODE:
+{
+ AV *out_av = newAV();
+ uint32_t i;
+ uint32_t size = Lucy_I32Arr_Get_Size(self);
+
+ av_extend(out_av, size);
+ for (i = 0; i < size; i++) {
+ int32_t result = Lucy_I32Arr_Get(self, i);
+ SV* result_sv = result == -1 ? newSV(0) : newSViv(result);
+ av_push(out_av, result_sv);
+ }
+ RETVAL = newRV_noinc((SV*)out_av);
+}
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::I32Array",
+ xs_code => $xs_code,
+ bind_methods => [qw( Get Get_Size )],
+);
+
+}
+
+sub bind_lockfreeregistry {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::LockFreeRegistry",
+ bind_methods => [qw( Register Fetch )],
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_num {
+ my $float32_xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::Float32
+
+SV*
+new(either_sv, value)
+ SV *either_sv;
+ float value;
+CODE:
+{
+ lucy_Float32 *self = (lucy_Float32*)XSBind_new_blank_obj(either_sv);
+ lucy_Float32_init(self, value);
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
+}
+OUTPUT: RETVAL
+END_XS_CODE
+
+my $float64_xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::Float64
+
+SV*
+new(either_sv, value)
+ SV *either_sv;
+ double value;
+CODE:
+{
+ lucy_Float64 *self = (lucy_Float64*)XSBind_new_blank_obj(either_sv);
+ lucy_Float64_init(self, value);
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
+}
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::Float32",
+ xs_code => $float32_xs_code,
+ bind_methods => [qw( Set_Value Get_Value )],
+);
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::Float64",
+ xs_code => $float64_xs_code,
+ bind_methods => [qw( Set_Value Get_Value )],
+);
+
+}
+
+sub bind_obj {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::Obj
+
+chy_bool_t
+is_a(self, class_name)
+ lucy_Obj *self;
+ const lucy_CharBuf *class_name;
+CODE:
+{
+ lucy_VTable *target = lucy_VTable_fetch_vtable(class_name);
+ RETVAL = Lucy_Obj_Is_A(self, target);
+}
+OUTPUT: RETVAL
+
+void
+STORABLE_freeze(self, ...)
+ lucy_Obj *self;
+PPCODE:
+{
+ CHY_UNUSED_VAR(self);
+ if (items < 2 || !SvTRUE(ST(1))) {
+ SV *retval;
+ lucy_ByteBuf *serialized_bb;
+ lucy_RAMFileHandle *file_handle
+ = lucy_RAMFH_open(NULL, LUCY_FH_WRITE_ONLY | LUCY_FH_CREATE, NULL);
+ lucy_OutStream *target = lucy_OutStream_open((lucy_Obj*)file_handle);
+
+ Lucy_Obj_Serialize(self, target);
+
+ Lucy_OutStream_Close(target);
+ serialized_bb
+ = Lucy_RAMFile_Get_Contents(Lucy_RAMFH_Get_File(file_handle));
+ retval = XSBind_bb_to_sv(serialized_bb);
+ CFISH_DECREF(file_handle);
+ CFISH_DECREF(target);
+
+ if (SvCUR(retval) == 0) { // Thwart Storable bug
+ THROW(LUCY_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)));
+ lucy_ZombieCharBuf *klass
+ = CFISH_ZCB_WRAP_STR(class_name, strlen(class_name));
+ lucy_VTable *vtable
+ = (lucy_VTable*)lucy_VTable_singleton((lucy_CharBuf*)klass, NULL);
+ STRLEN len;
+ char *ptr = SvPV(serialized_sv, len);
+ lucy_ViewByteBuf *contents = lucy_ViewBB_new(ptr, len);
+ lucy_RAMFile *ram_file = lucy_RAMFile_new((lucy_ByteBuf*)contents, true);
+ lucy_RAMFileHandle *file_handle
+ = lucy_RAMFH_open(NULL, LUCY_FH_READ_ONLY, ram_file);
+ lucy_InStream *instream = lucy_InStream_open((lucy_Obj*)file_handle);
+ lucy_Obj *self = Lucy_VTable_Foster_Obj(vtable, blank_obj);
+ lucy_Obj *deserialized = Lucy_Obj_Deserialize(self, instream);
+
+ CHY_UNUSED_VAR(cloning);
+ CFISH_DECREF(contents);
+ CFISH_DECREF(ram_file);
+ CFISH_DECREF(file_handle);
+ CFISH_DECREF(instream);
+
+ // Catch bad deserialize() override.
+ if (deserialized != self) {
+ THROW(LUCY_ERR, "Error when deserializing obj of class %o", klass);
+ }
+}
+END_XS_CODE
+
+my $synopsis = <<'END_SYNOPSIS';
+ package MyObj;
+ use base qw( Lucy::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 Lucy:: hierarchy descend from
+Lucy::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 Lucy::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 Lucy 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 "Lucy::Object::Obj" directly causes an
+error.
+
+Takes no arguments; if any are supplied, an error will be reported.
+
+==head1 DESTRUCTOR
+
+==head2 DESTROY
+
+All Lucy 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::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::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
+ )
+ ],
+ }
+);
+
+}
+
+sub bind_varray {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::VArray
+
+SV*
+shallow_copy(self)
+ lucy_VArray *self;
+CODE:
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(Lucy_VA_Shallow_Copy(self));
+OUTPUT: RETVAL
+
+SV*
+_deserialize(self, instream)
+ lucy_VArray *self;
+ lucy_InStream *instream;
+CODE:
+ lucy_VArray *thawed = Lucy_VA_Deserialize(self, instream);
+ RETVAL = (SV*)Lucy_VA_To_Host(thawed);
+OUTPUT: RETVAL
+
+SV*
+_clone(self)
+ lucy_VArray *self;
+CODE:
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(Lucy_VA_Clone(self));
+OUTPUT: RETVAL
+
+SV*
+shift(self)
+ lucy_VArray *self;
+CODE:
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(Lucy_VA_Shift(self));
+OUTPUT: RETVAL
+
+SV*
+pop(self)
+ lucy_VArray *self;
+CODE:
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(Lucy_VA_Pop(self));
+OUTPUT: RETVAL
+
+SV*
+delete(self, tick)
+ lucy_VArray *self;
+ uint32_t tick;
+CODE:
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(Lucy_VA_Delete(self, tick));
+OUTPUT: RETVAL
+
+void
+store(self, tick, value);
+ lucy_VArray *self;
+ uint32_t tick;
+ lucy_Obj *value;
+PPCODE:
+{
+ if (value) { CFISH_INCREF(value); }
+ lucy_VA_store(self, tick, value);
+}
+
+SV*
+fetch(self, tick)
+ lucy_VArray *self;
+ uint32_t tick;
+CODE:
+ RETVAL = CFISH_OBJ_TO_SV(Lucy_VA_Fetch(self, tick));
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::VArray",
+ xs_code => $xs_code,
+ bind_methods => [
+ qw(
+ Push
+ Push_VArray
+ Unshift
+ Excise
+ Resize
+ Get_Size
+ )
+ ],
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_vtable {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Object::VTable
+
+SV*
+_get_registry()
+CODE:
+ if (lucy_VTable_registry == NULL) {
+ lucy_VTable_init_registry();
+ }
+ RETVAL = (SV*)Lucy_Obj_To_Host((lucy_Obj*)lucy_VTable_registry);
+OUTPUT: RETVAL
+
+SV*
+singleton(unused_sv, ...)
+ SV *unused_sv;
+CODE:
+{
+ CHY_UNUSED_VAR(unused_sv);
+ lucy_CharBuf *class_name = NULL;
+ lucy_VTable *parent = NULL;
+ chy_bool_t args_ok
+ = XSBind_allot_params(&(ST(0)), 1, items,
+ "Lucy::Object::VTable::singleton_PARAMS",
+ ALLOT_OBJ(&class_name, "class_name", 10, true,
+ LUCY_CHARBUF, alloca(cfish_ZCB_size())),
+ ALLOT_OBJ(&parent, "parent", 6, false,
+ LUCY_VTABLE, NULL),
+ NULL);
+ if (!args_ok) {
+ CFISH_RETHROW(CFISH_INCREF(cfish_Err_get_error()));
+ }
+ lucy_VTable *singleton = lucy_VTable_singleton(class_name, parent);
+ RETVAL = (SV*)Lucy_VTable_To_Host(singleton);
+}
+OUTPUT: RETVAL
+
+SV*
+make_obj(self)
+ lucy_VTable *self;
+CODE:
+ lucy_Obj *blank = Lucy_VTable_Make_Obj(self);
+ RETVAL = CFISH_OBJ_TO_SV_NOINC(blank);
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Object::VTable",
+ xs_code => $xs_code,
+ bind_methods => [qw( Get_Name Get_Parent )],
+);
+
+}
+
+1;
Added: incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Plan.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Plan.pm?rev=1232020&view=auto
==============================================================================
--- incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Plan.pm (added)
+++ incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Plan.pm Mon Jan 16 15:10:03 2012
@@ -0,0 +1,427 @@
+# 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 Lucy::Build::Binding::Plan;
+
+
+sub bind_all {
+ my $class = shift;
+ $class->bind_architecture;
+ $class->bind_blobtype;
+ $class->bind_fieldtype;
+ $class->bind_float32type;
+ $class->bind_float64type;
+ $class->bind_fulltexttype;
+ $class->bind_int32type;
+ $class->bind_int64type;
+ $class->bind_schema;
+ $class->bind_stringtype;
+}
+
+sub bind_architecture {
+ my $synopsis = <<'END_SYNOPSIS';
+ package MyArchitecture;
+ use base qw( Lucy::Plan::Architecture );
+
+ use LucyX::Index::ZlibDocWriter;
+ use LucyX::Index::ZlibDocReader;
+
+ sub register_doc_writer {
+ my ( $self, $seg_writer ) = @_;
+ my $doc_writer = LucyX::Index::ZlibDocWriter->new(
+ snapshot => $seg_writer->get_snapshot,
+ segment => $seg_writer->get_segment,
+ polyreader => $seg_writer->get_polyreader,
+ );
+ $seg_writer->register(
+ api => "Lucy::Index::DocReader",
+ component => $doc_writer,
+ );
+ $seg_writer->add_writer($doc_writer);
+ }
+
+ sub register_doc_reader {
+ my ( $self, $seg_reader ) = @_;
+ my $doc_reader = LucyX::Index::ZlibDocReader->new(
+ schema => $seg_reader->get_schema,
+ folder => $seg_reader->get_folder,
+ segments => $seg_reader->get_segments,
+ seg_tick => $seg_reader->get_seg_tick,
+ snapshot => $seg_reader->get_snapshot,
+ );
+ $seg_reader->register(
+ api => 'Lucy::Index::DocReader',
+ component => $doc_reader,
+ );
+ }
+
+ package MySchema;
+ use base qw( Lucy::Plan::Schema );
+
+ sub architecture {
+ shift;
+ return MyArchitecture->new(@_);
+ }
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $arch = Lucy::Plan::Architecture->new;
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::Architecture",
+ bind_methods => [
+ qw(
+ Index_Interval
+ Skip_Interval
+ Init_Seg_Reader
+ Register_Doc_Writer
+ Register_Doc_Reader
+ Register_Deletions_Writer
+ Register_Deletions_Reader
+ Register_Lexicon_Reader
+ Register_Posting_List_Writer
+ Register_Posting_List_Reader
+ Register_Sort_Writer
+ Register_Sort_Reader
+ Register_Highlight_Writer
+ Register_Highlight_Reader
+ Make_Similarity
+ )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ methods => [
+ qw(
+ register_doc_writer
+ register_doc_reader
+ )
+ ],
+ constructors => [ { sample => $constructor } ],
+ }
+);
+
+}
+
+sub bind_blobtype {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $string_type = Lucy::Plan::StringType->new;
+ my $blob_type = Lucy::Plan::BlobType->new( stored => 1 );
+ my $schema = Lucy::Plan::Schema->new;
+ $schema->spec_field( name => 'id', type => $string_type );
+ $schema->spec_field( name => 'jpeg', type => $blob_type );
+END_SYNOPSIS
+my $constructor = <<'END_CONSTRUCTOR';
+ my $blob_type = Lucy::Plan::BlobType->new(
+ stored => 1, # default: false
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::BlobType",
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ },
+);
+
+}
+
+sub bind_fieldtype {
+ my $synopis = <<'END_SYNOPSIS';
+
+ my @sortable;
+ for my $field ( @{ $schema->all_fields } ) {
+ my $type = $schema->fetch_type($field);
+ next unless $type->sortable;
+ push @sortable, $field;
+ }
+
+END_SYNOPSIS
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::FieldType",
+ bind_methods => [
+ qw(
+ Get_Boost
+ Indexed
+ Stored
+ Sortable
+ Binary
+ Compare_Values
+ )
+ ],
+ bind_constructors => ["new|init2"],
+ make_pod => {
+ synopsis => $synopis,
+ methods => [
+ qw(
+ get_boost
+ indexed
+ stored
+ sortable
+ binary
+ )
+ ],
+ }
+);
+
+}
+
+sub bind_float32type {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $schema = Lucy::Plan::Schema->new;
+ my $float32_type = Lucy::Plan::FloatType->new;
+ $schema->spec_field( name => 'intensity', type => $float32_type );
+END_SYNOPSIS
+my $constructor = <<'END_CONSTRUCTOR';
+ my $float32_type = Lucy::Plan::Float32Type->new(
+ indexed => 0, # default true
+ stored => 0, # default true
+ sortable => 1, # default false
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::Float32Type",
+ bind_constructors => ["new|init2"],
+ #make_pod => {
+ # synopsis => $synopsis,
+ # constructor => { sample => $constructor },
+ #},
+);
+
+}
+
+sub bind_float64type {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $schema = Lucy::Plan::Schema->new;
+ my $float64_type = Lucy::Plan::FloatType->new;
+ $schema->spec_field( name => 'intensity', type => $float64_type );
+END_SYNOPSIS
+my $constructor = <<'END_CONSTRUCTOR';
+ my $float64_type = Lucy::Plan::Float64Type->new(
+ indexed => 0 # default true
+ stored => 0, # default true
+ sortable => 1, # default false
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::Float64Type",
+ bind_constructors => ["new|init2"],
+ #make_pod => {
+ # synopsis => $synopsis,
+ # constructor => { sample => $constructor },
+ #},
+);
+
+}
+
+sub bind_fulltexttype {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $polyanalyzer = Lucy::Analysis::PolyAnalyzer->new(
+ language => 'en',
+ );
+ my $type = Lucy::Plan::FullTextType->new(
+ analyzer => $polyanalyzer,
+ );
+ my $schema = Lucy::Plan::Schema->new;
+ $schema->spec_field( name => 'title', type => $type );
+ $schema->spec_field( name => 'content', type => $type );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $type = Lucy::Plan::FullTextType->new(
+ analyzer => $analyzer, # required
+ boost => 2.0, # default: 1.0
+ indexed => 1, # default: true
+ stored => 1, # default: true
+ sortable => 1, # default: false
+ highlightable => 1, # default: false
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::FullTextType",
+ bind_constructors => ["new|init2"],
+ bind_methods => [
+ qw(
+ Set_Highlightable
+ Highlightable
+ )
+ ],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [
+ qw(
+ set_highlightable
+ highlightable
+ )
+ ],
+ },
+);
+
+}
+
+sub bind_int32type {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $schema = Lucy::Plan::Schema->new;
+ my $int32_type = Lucy::Plan::Int32Type->new;
+ $schema->spec_field( name => 'count', type => $int32_type );
+END_SYNOPSIS
+my $constructor = <<'END_CONSTRUCTOR';
+ my $int32_type = Lucy::Plan::Int32Type->new(
+ indexed => 0, # default true
+ stored => 0, # default true
+ sortable => 1, # default false
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::Int32Type",
+ bind_constructors => ["new|init2"],
+ #make_pod => {
+ # synopsis => $synopsis,
+ # constructor => { sample => $constructor },
+ #},
+);
+
+}
+
+sub bind_int64type {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $schema = Lucy::Plan::Schema->new;
+ my $int64_type = Lucy::Plan::Int64Type->new;
+ $schema->spec_field( name => 'count', type => $int64_type );
+END_SYNOPSIS
+my $constructor = <<'END_CONSTRUCTOR';
+ my $int64_type = Lucy::Plan::Int64Type->new(
+ indexed => 0, # default true
+ stored => 0, # default true
+ sortable => 1, # default false
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::Int64Type",
+ bind_constructors => ["new|init2"],
+ #make_pod => {
+ # synopsis => $synopsis,
+ # constructor => { sample => $constructor },
+ #},
+);
+
+}
+
+sub bind_schema {
+ my $synopsis = <<'END_SYNOPSIS';
+ use Lucy::Plan::Schema;
+ use Lucy::Plan::FullTextType;
+ use Lucy::Analysis::PolyAnalyzer;
+
+ my $schema = Lucy::Plan::Schema->new;
+ my $polyanalyzer = Lucy::Analysis::PolyAnalyzer->new(
+ language => 'en',
+ );
+ my $type = Lucy::Plan::FullTextType->new(
+ analyzer => $polyanalyzer,
+ );
+ $schema->spec_field( name => 'title', type => $type );
+ $schema->spec_field( name => 'content', type => $type );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $schema = Lucy::Plan::Schema->new;
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::Schema",
+ bind_methods => [
+ qw(
+ Architecture
+ Get_Architecture
+ Get_Similarity
+ Fetch_Type
+ Fetch_Analyzer
+ Fetch_Sim
+ Num_Fields
+ All_Fields
+ Spec_Field
+ Write
+ Eat
+ )
+ ],
+ bind_constructors => [qw( new )],
+ make_pod => {
+ methods => [
+ qw(
+ spec_field
+ num_fields
+ all_fields
+ fetch_type
+ fetch_sim
+ architecture
+ get_architecture
+ get_similarity
+ )
+ ],
+ synopsis => $synopsis,
+ constructors => [ { sample => $constructor } ],
+ },
+);
+
+}
+
+sub bind_stringtype {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $type = Lucy::Plan::StringType->new;
+ my $schema = Lucy::Plan::Schema->new;
+ $schema->spec_field( name => 'category', type => $type );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $type = Lucy::Plan::StringType->new(
+ boost => 0.1, # default: 1.0
+ indexed => 1, # default: true
+ stored => 1, # default: true
+ sortable => 1, # default: false
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Plan::StringType",
+ bind_constructors => ["new|init2"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ },
+);
+
+}
+
+1;
Added: incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Search.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Search.pm?rev=1232020&view=auto
==============================================================================
--- incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Search.pm (added)
+++ incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Search.pm Mon Jan 16 15:10:03 2012
@@ -0,0 +1,985 @@
+# 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 Lucy::Build::Binding::Search;
+
+
+sub bind_all {
+ my $class = shift;
+ $class->bind_andmatcher;
+ $class->bind_andquery;
+ $class->bind_bitvecmatcher;
+ $class->bind_collector;
+ $class->bind_compiler;
+ $class->bind_hitqueue;
+ $class->bind_hits;
+ $class->bind_indexsearcher;
+ $class->bind_leafquery;
+ $class->bind_matchallquery;
+ $class->bind_matchdoc;
+ $class->bind_matcher;
+ $class->bind_notmatcher;
+ $class->bind_notquery;
+ $class->bind_nomatchquery;
+ $class->bind_orquery;
+ $class->bind_orscorer;
+ $class->bind_phrasequery;
+ $class->bind_polyquery;
+ $class->bind_polysearcher;
+ $class->bind_query;
+ $class->bind_queryparser;
+ $class->bind_rangequery;
+ $class->bind_requiredoptionalmatcher;
+ $class->bind_requiredoptionalquery;
+ $class->bind_searcher;
+ $class->bind_sortrule;
+ $class->bind_sortspec;
+ $class->bind_span;
+ $class->bind_termquery;
+ $class->bind_topdocs;
+}
+
+sub bind_andmatcher {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::ANDMatcher",
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_andquery {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $foo_and_bar_query = Lucy::Search::ANDQuery->new(
+ children => [ $foo_query, $bar_query ],
+ );
+ my $hits = $searcher->hits( query => $foo_and_bar_query );
+ ...
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $foo_and_bar_query = Lucy::Search::ANDQuery->new(
+ children => [ $foo_query, $bar_query ],
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::ANDQuery",
+ bind_constructors => ["new"],
+ make_pod => {
+ methods => [qw( add_child )],
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ },
+);
+
+}
+
+sub bind_bitvecmatcher {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::BitVecMatcher",
+ bind_constructors => [qw( new )],
+);
+
+}
+
+sub bind_collector {
+ my $constructor = <<'END_CONSTRUCTOR';
+ package MyCollector;
+ use base qw( Lucy::Search::Collector );
+ our %foo;
+ sub new {
+ my $self = shift->SUPER::new;
+ my %args = @_;
+ $foo{$$self} = $args{foo};
+ return $self;
+ }
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Collector",
+ bind_methods => [
+ qw(
+ Collect
+ Set_Reader
+ Set_Base
+ Set_Matcher
+ Need_Score
+ )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => " # Abstract base class.\n",
+ constructor => { sample => $constructor },
+ methods => [qw( collect )],
+ },
+);
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Collector::OffsetCollector",
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_compiler {
+ my $synopsis = <<'END_SYNOPSIS';
+ # (Compiler is an abstract base class.)
+ package MyCompiler;
+ use base qw( Lucy::Search::Compiler );
+
+ sub make_matcher {
+ my $self = shift;
+ return MyMatcher->new( @_, compiler => $self );
+ }
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR_CODE_SAMPLE';
+ my $compiler = MyCompiler->SUPER::new(
+ parent => $my_query,
+ searcher => $searcher,
+ similarity => $sim, # default: undef
+ boost => undef, # default: see below
+ );
+END_CONSTRUCTOR_CODE_SAMPLE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Compiler",
+ bind_methods => [
+ qw(
+ Make_Matcher
+ Get_Parent
+ Get_Similarity
+ Get_Weight
+ Sum_Of_Squared_Weights
+ Apply_Norm_Factor
+ Normalize
+ Highlight_Spans
+ )
+ ],
+ bind_constructors => ["do_new"],
+ make_pod => {
+ methods => [
+ qw(
+ make_matcher
+ get_weight
+ sum_of_squared_weights
+ apply_norm_factor
+ normalize
+ get_parent
+ get_similarity
+ highlight_spans
+ )
+ ],
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ }
+);
+
+}
+
+sub bind_hitqueue {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::HitQueue",
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_hits {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $hits = $searcher->hits(
+ query => $query,
+ offset => 0,
+ num_wanted => 10,
+ );
+ while ( my $hit = $hits->next ) {
+ print "<p>$hit->{title} <em>" . $hit->get_score . "</em></p>\n";
+ }
+END_SYNOPSIS
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Hits",
+ bind_methods => [
+ qw(
+ Total_Hits
+ Next
+ )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ methods => [qw( next total_hits )],
+ }
+);
+
+}
+
+sub bind_indexsearcher {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $searcher = Lucy::Search::IndexSearcher->new(
+ index => '/path/to/index'
+ );
+ my $hits = $searcher->hits(
+ query => 'foo bar',
+ offset => 0,
+ num_wanted => 100,
+ );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $searcher = Lucy::Search::IndexSearcher->new(
+ index => '/path/to/index'
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::IndexSearcher",
+ bind_methods => [qw( Get_Reader )],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [
+ qw( hits
+ collect
+ doc_max
+ doc_freq
+ fetch_doc
+ get_schema
+ get_reader )
+ ],
+ },
+);
+
+}
+
+sub bind_leafquery {
+ my $synopsis = <<'END_SYNOPSIS';
+ package MyQueryParser;
+ use base qw( Lucy::Search::QueryParser );
+
+ sub expand_leaf {
+ my ( $self, $leaf_query ) = @_;
+ if ( $leaf_query->get_text =~ /.\*\s*$/ ) {
+ return PrefixQuery->new(
+ query_string => $leaf_query->get_text,
+ field => $leaf_query->get_field,
+ );
+ }
+ else {
+ return $self->SUPER::expand_leaf($leaf_query);
+ }
+ }
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $leaf_query = Lucy::Search::LeafQuery->new(
+ text => '"three blind mice"', # required
+ field => 'content', # default: undef
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::LeafQuery",
+ bind_methods => [qw( Get_Field Get_Text )],
+ bind_constructors => ["new"],
+ make_pod => {
+ methods => [qw( get_field get_text )],
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ }
+);
+
+}
+
+sub bind_matchallquery {
+ my $constructor = <<'END_CONSTRUCTOR';
+ my $match_all_query = Lucy::Search::MatchAllQuery->new;
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::MatchAllQuery",
+ bind_constructors => ["new"],
+ make_pod => { constructor => { sample => $constructor }, }
+);
+
+}
+
+sub bind_matchdoc {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::MatchDoc",
+ bind_methods => [
+ qw(
+ Get_Doc_ID
+ Set_Doc_ID
+ Get_Score
+ Set_Score
+ Get_Values
+ Set_Values
+ )
+ ],
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_matcher {
+ my $synopsis = <<'END_SYNOPSIS';
+ # abstract base class
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR_CODE_SAMPLE';
+ my $matcher = MyMatcher->SUPER::new;
+END_CONSTRUCTOR_CODE_SAMPLE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Matcher",
+ bind_methods => [qw( Next Advance Get_Doc_ID Score Collect )],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [qw( next advance get_doc_id score )],
+ }
+);
+
+}
+
+sub bind_notmatcher {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::NOTMatcher",
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_notquery {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $not_bar_query = Lucy::Search::NOTQuery->new(
+ negated_query => $bar_query,
+ );
+ my $foo_and_not_bar_query = Lucy::Search::ANDQuery->new(
+ children => [ $foo_query, $not_bar_query ].
+ );
+ my $hits = $searcher->hits( query => $foo_and_not_bar_query );
+ ...
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $not_query = Lucy::Search::NOTQuery->new(
+ negated_query => $query,
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::NOTQuery",
+ bind_constructors => ["new"],
+ bind_methods => [qw( Get_Negated_Query Set_Negated_Query )],
+ make_pod => {
+ methods => [qw( get_negated_query set_negated_query )],
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ }
+);
+
+}
+
+sub bind_nomatchquery {
+ my $constructor = <<'END_CONSTRUCTOR';
+ my $no_match_query = Lucy::Search::NoMatchQuery->new;
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::NoMatchQuery",
+ bind_constructors => ["new"],
+ make_pod => { constructor => { sample => $constructor }, }
+);
+
+}
+
+sub bind_orquery {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $foo_or_bar_query = Lucy::Search::ORQuery->new(
+ children => [ $foo_query, $bar_query ],
+ );
+ my $hits = $searcher->hits( query => $foo_or_bar_query );
+ ...
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $foo_or_bar_query = Lucy::Search::ORQuery->new(
+ children => [ $foo_query, $bar_query ],
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::ORQuery",
+ bind_constructors => ["new"],
+ make_pod => {
+ methods => [qw( add_child )],
+ synopsis => $synopsis,
+ constructor => { sample => $constructor, }
+ },
+);
+
+}
+
+sub bind_orscorer {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::ORScorer",
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_phrasequery {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $phrase_query = Lucy::Search::PhraseQuery->new(
+ field => 'content',
+ terms => [qw( the who )],
+ );
+ my $hits = $searcher->hits( query => $phrase_query );
+END_SYNOPSIS
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::PhraseQuery",
+ bind_methods => [qw( Get_Field Get_Terms )],
+ bind_constructors => ["new"],
+ make_pod => {
+ constructor => { sample => '' },
+ synopsis => $synopsis,
+ methods => [qw( get_field get_terms )],
+ },
+);
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::PhraseCompiler",
+ bind_constructors => ["do_new"],
+);
+
+}
+
+sub bind_polyquery {
+ my $synopsis = <<'END_SYNOPSIS';
+ sub walk {
+ my $query = shift;
+ if ( $query->isa("Lucy::Search::PolyQuery") ) {
+ if ( $query->isa("Lucy::Search::ORQuery") ) { ... }
+ elsif ( $query->isa("Lucy::Search::ANDQuery") ) { ... }
+ elsif ( $query->isa("Lucy::Search::RequiredOptionalQuery") ) {
+ ...
+ }
+ elsif ( $query->isa("Lucy::Search::NOTQuery") ) { ... }
+ }
+ else { ... }
+ }
+END_SYNOPSIS
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::PolyQuery",
+ bind_methods => [qw( Add_Child Set_Children Get_Children )],
+ bind_constructors => ["new"],
+ make_pod => { synopsis => $synopsis, },
+);
+
+}
+
+sub bind_polysearcher {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $schema = MySchema->new;
+ for my $index (@index_paths) {
+ push @searchers, Lucy::Search::IndexSearcher->new( index => $index );
+ }
+ my $poly_searcher = Lucy::Search::PolySearcher->new(
+ schema => $schema,
+ searchers => \@searchers,
+ );
+ my $hits = $poly_searcher->hits( query => $query );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $poly_searcher = Lucy::Search::PolySearcher->new(
+ schema => $schema,
+ searchers => \@searchers,
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::PolySearcher",
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [
+ qw( hits
+ doc_max
+ doc_freq
+ fetch_doc
+ get_schema
+ )
+ ],
+ }
+);
+
+}
+
+sub bind_query {
+ my $synopsis = <<'END_SYNOPSIS';
+ # Query is an abstract base class.
+ package MyQuery;
+ use base qw( Lucy::Search::Query );
+
+ sub make_compiler {
+ my ( $self, %args ) = @_;
+ my $subordinate = delete $args{subordinate};
+ my $compiler = MyCompiler->new( %args, parent => $self );
+ $compiler->normalize unless $subordinate;
+ return $compiler;
+ }
+
+ package MyCompiler;
+ use base ( Lucy::Search::Compiler );
+ ...
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR_CODE_SAMPLE';
+ my $query = MyQuery->SUPER::new(
+ boost => 2.5,
+ );
+END_CONSTRUCTOR_CODE_SAMPLE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Query",
+ bind_methods => [
+ qw( Set_Boost
+ Get_Boost
+ _make_compiler|Make_Compiler )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [qw( make_compiler set_boost get_boost )],
+ },
+);
+
+}
+
+sub bind_queryparser {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $query_parser = Lucy::Search::QueryParser->new(
+ schema => $searcher->get_schema,
+ fields => ['body'],
+ );
+ my $query = $query_parser->parse( $query_string );
+ my $hits = $searcher->hits( query => $query );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $query_parser = Lucy::Search::QueryParser->new(
+ schema => $searcher->get_schema, # required
+ analyzer => $analyzer, # overrides schema
+ fields => ['bodytext'], # default: indexed fields
+ default_boolop => 'AND', # default: 'OR'
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::QueryParser",
+ bind_methods => [
+ qw(
+ Parse
+ Tree
+ Expand
+ Expand_Leaf
+ Prune
+ Heed_Colons
+ Set_Heed_Colons
+ Get_Analyzer
+ Get_Schema
+ Get_Fields
+ Make_Term_Query
+ Make_Phrase_Query
+ Make_AND_Query
+ Make_OR_Query
+ Make_NOT_Query
+ Make_Req_Opt_Query
+ )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ methods => [
+ qw( parse
+ tree
+ expand
+ expand_leaf
+ prune
+ set_heed_colons
+ make_term_query
+ make_phrase_query
+ make_and_query
+ make_or_query
+ make_not_query
+ make_req_opt_query
+ )
+ ],
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ }
+);
+
+}
+
+sub bind_rangequery {
+ my $synopsis = <<'END_SYNOPSIS';
+ # Match all articles by "Foo" published since the year 2000.
+ my $range_query = Lucy::Search::RangeQuery->new(
+ field => 'publication_date',
+ lower_term => '2000-01-01',
+ include_lower => 1,
+ );
+ my $author_query = Lucy::Search::TermQuery->new(
+ field => 'author_last_name',
+ text => 'Foo',
+ );
+ my $and_query = Lucy::Search::ANDQuery->new(
+ children => [ $range_query, $author_query ],
+ );
+ my $hits = $searcher->hits( query => $and_query );
+ ...
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $range_query = Lucy::Search::RangeQuery->new(
+ field => 'product_number', # required
+ lower_term => '003', # see below
+ upper_term => '060', # see below
+ include_lower => 0, # default true
+ include_upper => 0, # default true
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::RangeQuery",
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ },
+);
+
+}
+
+sub bind_requiredoptionalmatcher {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::RequiredOptionalMatcher",
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_requiredoptionalquery {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $foo_and_maybe_bar = Lucy::Search::RequiredOptionalQuery->new(
+ required_query => $foo_query,
+ optional_query => $bar_query,
+ );
+ my $hits = $searcher->hits( query => $foo_and_maybe_bar );
+ ...
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $reqopt_query = Lucy::Search::RequiredOptionalQuery->new(
+ required_query => $foo_query, # required
+ optional_query => $bar_query, # required
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::RequiredOptionalQuery",
+ bind_methods => [
+ qw( Get_Required_Query Set_Required_Query
+ Get_Optional_Query Set_Optional_Query )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ methods => [
+ qw( get_required_query set_required_query
+ get_optional_query set_optional_query )
+ ],
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ },
+);
+
+}
+
+sub bind_searcher {
+ my $constructor = <<'END_CONSTRUCTOR';
+ package MySearcher;
+ use base qw( Lucy::Search::Searcher );
+ sub new {
+ my $self = shift->SUPER::new;
+ ...
+ return $self;
+ }
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Searcher",
+ bind_methods => [
+ qw( Doc_Max
+ Doc_Freq
+ Glean_Query
+ Hits
+ Collect
+ Top_Docs
+ Fetch_Doc
+ Fetch_Doc_Vec
+ Get_Schema
+ Close )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => " # Abstract base class.\n",
+ constructor => { sample => $constructor },
+ methods => [
+ qw(
+ hits
+ collect
+ glean_query
+ doc_max
+ doc_freq
+ fetch_doc
+ get_schema
+ )
+ ],
+ },
+);
+
+}
+
+sub bind_sortrule {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Search::SortRule
+
+int32_t
+FIELD()
+CODE:
+ RETVAL = lucy_SortRule_FIELD;
+OUTPUT: RETVAL
+
+int32_t
+SCORE()
+CODE:
+ RETVAL = lucy_SortRule_SCORE;
+OUTPUT: RETVAL
+
+int32_t
+DOC_ID()
+CODE:
+ RETVAL = lucy_SortRule_DOC_ID;
+OUTPUT: RETVAL
+END_XS_CODE
+
+my $synopsis = <<'END_SYNOPSIS';
+ my $sort_spec = Lucy::Search::SortSpec->new(
+ rules => [
+ Lucy::Search::SortRule->new( field => 'date' ),
+ Lucy::Search::SortRule->new( type => 'doc_id' ),
+ ],
+ );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $by_title = Lucy::Search::SortRule->new( field => 'title' );
+ my $by_score = Lucy::Search::SortRule->new( type => 'score' );
+ my $by_doc_id = Lucy::Search::SortRule->new( type => 'doc_id' );
+ my $reverse_date = Lucy::Search::SortRule->new(
+ field => 'date',
+ reverse => 1,
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::SortRule",
+ xs_code => $xs_code,
+ bind_constructors => ["_new"],
+ bind_methods => [qw( Get_Field Get_Reverse )],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [qw( get_field get_reverse )],
+ },
+);
+
+}
+
+sub bind_sortspec {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $sort_spec = Lucy::Search::SortSpec->new(
+ rules => [
+ Lucy::Search::SortRule->new( field => 'date' ),
+ Lucy::Search::SortRule->new( type => 'doc_id' ),
+ ],
+ );
+ my $hits = $searcher->hits(
+ query => $query,
+ sort_spec => $sort_spec,
+ );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $sort_spec = Lucy::Search::SortSpec->new( rules => \@rules );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::SortSpec",
+ bind_methods => [qw( Get_Rules )],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ },
+);
+
+}
+
+sub bind_span {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $combined_length = $upper_span->get_length
+ + ( $upper_span->get_offset - $lower_span->get_offset );
+ my $combined_span = Lucy::Search::Span->new(
+ offset => $lower_span->get_offset,
+ length => $combined_length,
+ );
+ ...
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $span = Lucy::Search::Span->new(
+ offset => 75, # required
+ length => 7, # required
+ weight => 1.0, # default 0.0
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Span",
+ bind_methods => [
+ qw( Set_Offset
+ Get_Offset
+ Set_Length
+ Get_Length
+ Set_Weight
+ Get_Weight )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [
+ qw( set_offset
+ get_offset
+ set_length
+ get_length
+ set_weight
+ get_weight )
+ ],
+ }
+);
+
+}
+
+sub bind_termquery {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $term_query = Lucy::Search::TermQuery->new(
+ field => 'content',
+ term => 'foo',
+ );
+ my $hits = $searcher->hits( query => $term_query );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $term_query = Lucy::Search::TermQuery->new(
+ field => 'content', # required
+ term => 'foo', # required
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::TermQuery",
+ bind_methods => [qw( Get_Field Get_Term )],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [qw( get_field get_term )],
+ },
+);
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::TermCompiler",
+ bind_constructors => ["do_new"],
+);
+
+}
+
+sub bind_topdocs {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::TopDocs",
+ bind_methods => [
+ qw(
+ Get_Match_Docs
+ Get_Total_Hits
+ Set_Total_Hits
+ )
+ ],
+ bind_constructors => ["new"],
+);
+
+}
+
+1;
Added: incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Search/Collector.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Search/Collector.pm?rev=1232020&view=auto
==============================================================================
--- incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Search/Collector.pm (added)
+++ incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Search/Collector.pm Mon Jan 16 15:10:03 2012
@@ -0,0 +1,67 @@
+# 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 Lucy::Build::Binding::Search::Collector;
+
+
+sub bind_all {
+ my $class = shift;
+ $class->bind_bitcollector;
+ $class->bind_sortcollector;
+}
+
+sub bind_bitcollector {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $bit_vec = Lucy::Object::BitVector->new(
+ capacity => $searcher->doc_max + 1,
+ );
+ my $bit_collector = Lucy::Search::Collector::BitCollector->new(
+ bit_vector => $bit_vec,
+ );
+ $searcher->collect(
+ collector => $bit_collector,
+ query => $query,
+ );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $bit_collector = Lucy::Search::Collector::BitCollector->new(
+ bit_vector => $bit_vec, # required
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Collector::BitCollector",
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [qw( collect )],
+ },
+);
+
+}
+
+sub bind_sortcollector {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Search::Collector::SortCollector",
+ bind_methods => [qw( Pop_Match_Docs Get_Total_Hits )],
+ bind_constructors => ["new"],
+);
+
+}
+
+1;
Added: incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Store.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Store.pm?rev=1232020&view=auto
==============================================================================
--- incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Store.pm (added)
+++ incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Store.pm Mon Jan 16 15:10:03 2012
@@ -0,0 +1,478 @@
+# 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 Lucy::Build::Binding::Store;
+
+
+sub bind_all {
+ my $class = shift;
+ $class->bind_fsfilehandle;
+ $class->bind_fsfolder;
+ $class->bind_filehandle;
+ $class->bind_folder;
+ $class->bind_instream;
+ $class->bind_lock;
+ $class->bind_lockerr;
+ $class->bind_lockfactory;
+ $class->bind_outstream;
+ $class->bind_ramfile;
+ $class->bind_ramfilehandle;
+ $class->bind_ramfolder;
+}
+
+sub bind_fsfilehandle {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::FSFileHandle",
+ bind_constructors => ['_open|do_open'],
+);
+
+}
+
+sub bind_fsfolder {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $folder = Lucy::Store::FSFolder->new(
+ path => '/path/to/folder',
+ );
+END_SYNOPSIS
+
+my $constructor = $synopsis;
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::FSFolder",
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ },
+);
+
+}
+
+sub bind_filehandle {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Store::FileHandle
+
+=for comment
+
+For testing purposes only. Track number of FileHandle objects in existence.
+
+=cut
+
+uint32_t
+FH_READ_ONLY()
+CODE:
+ RETVAL = LUCY_FH_READ_ONLY;
+OUTPUT: RETVAL
+
+uint32_t
+FH_WRITE_ONLY()
+CODE:
+ RETVAL = LUCY_FH_WRITE_ONLY;
+OUTPUT: RETVAL
+
+uint32_t
+FH_CREATE()
+CODE:
+ RETVAL = LUCY_FH_CREATE;
+OUTPUT: RETVAL
+
+uint32_t
+FH_EXCLUSIVE()
+CODE:
+ RETVAL = LUCY_FH_EXCLUSIVE;
+OUTPUT: RETVAL
+
+
+int32_t
+object_count()
+CODE:
+ RETVAL = lucy_FH_object_count;
+OUTPUT: RETVAL
+
+=for comment
+
+For testing purposes only. Used to help produce buffer alignment tests.
+
+=cut
+
+IV
+_BUF_SIZE()
+CODE:
+ RETVAL = LUCY_IO_STREAM_BUF_SIZE;
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::FileHandle",
+ xs_code => $xs_code,
+ bind_methods => [qw( Length Close )],
+ bind_constructors => ['_open|do_open'],
+);
+
+}
+
+sub bind_folder {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::Folder",
+ bind_methods => [
+ qw(
+ Open_Out
+ Open_In
+ MkDir
+ List_R
+ Exists
+ Rename
+ Hard_Link
+ Delete
+ Slurp_File
+ Close
+ Get_Path
+ )
+ ],
+ bind_constructors => ["new"],
+ make_pod => { synopsis => " # Abstract base class.\n", },
+);
+
+}
+
+sub bind_instream {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Store::InStream
+
+void
+read(self, buffer_sv, len, ...)
+ lucy_InStream *self;
+ SV *buffer_sv;
+ size_t len;
+PPCODE:
+{
+ UV offset = items == 4 ? SvUV(ST(3)) : 0;
+ char *ptr;
+ size_t total_len = offset + len;
+ SvUPGRADE(buffer_sv, SVt_PV);
+ if (!SvPOK(buffer_sv)) { SvCUR_set(buffer_sv, 0); }
+ ptr = SvGROW(buffer_sv, total_len + 1);
+ Lucy_InStream_Read_Bytes(self, ptr + offset, len);
+ SvPOK_on(buffer_sv);
+ if (SvCUR(buffer_sv) < total_len) {
+ SvCUR_set(buffer_sv, total_len);
+ *(SvEND(buffer_sv)) = '\0';
+ }
+}
+
+SV*
+read_string(self)
+ lucy_InStream *self;
+CODE:
+{
+ char *ptr;
+ size_t len = Lucy_InStream_Read_C32(self);
+ RETVAL = newSV(len + 1);
+ SvCUR_set(RETVAL, len);
+ SvPOK_on(RETVAL);
+ SvUTF8_on(RETVAL); // Trust source. Reconsider if API goes public.
+ *SvEND(RETVAL) = '\0';
+ ptr = SvPVX(RETVAL);
+ Lucy_InStream_Read_Bytes(self, ptr, len);
+}
+OUTPUT: RETVAL
+
+int
+read_raw_c64(self, buffer_sv)
+ lucy_InStream *self;
+ SV *buffer_sv;
+CODE:
+{
+ char *ptr;
+ SvUPGRADE(buffer_sv, SVt_PV);
+ ptr = SvGROW(buffer_sv, 10 + 1);
+ RETVAL = Lucy_InStream_Read_Raw_C64(self, ptr);
+ SvPOK_on(buffer_sv);
+ SvCUR_set(buffer_sv, RETVAL);
+}
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::InStream",
+ xs_code => $xs_code,
+ bind_methods => [
+ qw(
+ Seek
+ Tell
+ Length
+ Reopen
+ Close
+ Read_I8
+ Read_I32
+ Read_I64
+ Read_U8
+ Read_U32
+ Read_U64
+ Read_C32
+ Read_C64
+ Read_F32
+ Read_F64
+ )
+ ],
+ bind_constructors => ['open|do_open'],
+);
+
+}
+
+sub bind_lock {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $lock = $lock_factory->make_lock(
+ name => 'write',
+ timeout => 5000,
+ );
+ $lock->obtain or die "can't get lock for " . $lock->get_name;
+ do_stuff();
+ $lock->release;
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $lock = Lucy::Store::Lock->new(
+ name => 'commit', # required
+ folder => $folder, # required
+ host => $hostname, # required
+ timeout => 5000, # default: 0
+ interval => 1000, # default: 100
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::Lock",
+ bind_methods => [
+ qw(
+ Obtain
+ Request
+ Is_Locked
+ Release
+ Clear_Stale
+ Get_Name
+ Get_Lock_Path
+ Get_Host
+ )
+ ],
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ methods => [
+ qw(
+ obtain
+ request
+ release
+ is_locked
+ clear_stale
+ )
+ ],
+ },
+);
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::LockFileLock",
+ bind_constructors => ["new"],
+);
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::SharedLock",
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_lockerr {
+ my $synopsis = <<'END_SYNOPSIS';
+ while (1) {
+ my $bg_merger = eval {
+ Lucy::Index::BackgroundMerger->new( index => $index );
+ };
+ if ( blessed($@) and $@->isa("Lucy::Store::LockErr") ) {
+ warn "Retrying...\n";
+ }
+ elsif (!$bg_merger) {
+ # Re-throw.
+ die "Failed to open BackgroundMerger: $@";
+ }
+ ...
+ }
+END_SYNOPSIS
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::LockErr",
+ make_pod => { synopsis => $synopsis }
+);
+
+}
+
+sub bind_lockfactory {
+ my $synopsis = <<'END_SYNOPSIS';
+ use Sys::Hostname qw( hostname );
+ my $hostname = hostname() or die "Can't get unique hostname";
+ my $folder = Lucy::Store::FSFolder->new(
+ path => '/path/to/index',
+ );
+ my $lock_factory = Lucy::Store::LockFactory->new(
+ folder => $folder,
+ host => $hostname,
+ );
+ my $write_lock = $lock_factory->make_lock(
+ name => 'write',
+ timeout => 5000,
+ interval => 100,
+ );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $lock_factory = Lucy::Store::LockFactory->new(
+ folder => $folder, # required
+ host => $hostname, # required
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::LockFactory",
+ bind_methods => [qw( Make_Lock Make_Shared_Lock )],
+ bind_constructors => ["new"],
+ make_pod => {
+ methods => [qw( make_lock make_shared_lock)],
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ }
+);
+
+}
+
+sub bind_outstream {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Store::OutStream
+
+void
+print(self, ...)
+ lucy_OutStream *self;
+PPCODE:
+{
+ int i;
+ for (i = 1; i < items; i++) {
+ STRLEN len;
+ char *ptr = SvPV(ST(i), len);
+ Lucy_OutStream_Write_Bytes(self, ptr, len);
+ }
+}
+
+void
+write_string(self, aSV)
+ lucy_OutStream *self;
+ SV *aSV;
+PPCODE:
+{
+ STRLEN len = 0;
+ char *ptr = SvPVutf8(aSV, len);
+ Lucy_OutStream_Write_C32(self, len);
+ Lucy_OutStream_Write_Bytes(self, ptr, len);
+}
+END_XS_CODE
+
+my $synopsis = <<'END_SYNOPSIS'; # Don't use this yet.
+ my $outstream = $folder->open_out($filename) or die $@;
+ $outstream->write_u64($file_position);
+END_SYNOPSIS
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::OutStream",
+ xs_code => $xs_code,
+ bind_methods => [
+ qw(
+ Tell
+ Length
+ Flush
+ Close
+ Absorb
+ Write_I8
+ Write_I32
+ Write_I64
+ Write_U8
+ Write_U32
+ Write_U64
+ Write_C32
+ Write_C64
+ Write_F32
+ Write_F64
+ )
+ ],
+ bind_constructors => ['open|do_open'],
+);
+
+}
+
+sub bind_ramfile {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::RAMFile",
+ bind_methods => [qw( Get_Contents )],
+ bind_constructors => ['new'],
+);
+
+}
+
+sub bind_ramfilehandle {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::RAMFileHandle",
+ bind_methods => [qw( Get_File )],
+ bind_constructors => ['_open|do_open'],
+);
+
+}
+
+sub bind_ramfolder {
+ my $synopsis = <<'END_SYNOPSIS';
+ my $folder = Lucy::Store::RAMFolder->new;
+
+ # or sometimes...
+ my $folder = Lucy::Store::RAMFolder->new(
+ path => $relative_path,
+ );
+END_SYNOPSIS
+
+my $constructor = <<'END_CONSTRUCTOR';
+ my $folder = Lucy::Store::RAMFolder->new(
+ path => $relative_path, # default: empty string
+ );
+END_CONSTRUCTOR
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Store::RAMFolder",
+ bind_constructors => ["new"],
+ make_pod => {
+ synopsis => $synopsis,
+ constructor => { sample => $constructor },
+ }
+);
+
+}
+
+1;
Added: incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Test/Util.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Test/Util.pm?rev=1232020&view=auto
==============================================================================
--- incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Test/Util.pm (added)
+++ incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Test/Util.pm Mon Jan 16 15:10:03 2012
@@ -0,0 +1,77 @@
+# 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 Lucy::Build::Binding::Test::Util;
+
+
+sub bind_all {
+ my $class = shift;
+ $class->bind_bbsortex;
+}
+
+sub bind_bbsortex {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Test::Util::BBSortEx
+
+SV*
+fetch(self)
+ lucy_BBSortEx *self;
+CODE:
+{
+ void *address = Lucy_BBSortEx_Fetch(self);
+ if (address) {
+ RETVAL = XSBind_cfish_to_perl(*(lucy_Obj**)address);
+ CFISH_DECREF(*(lucy_Obj**)address);
+ }
+ else {
+ RETVAL = newSV(0);
+ }
+}
+OUTPUT: RETVAL
+
+SV*
+peek(self)
+ lucy_BBSortEx *self;
+CODE:
+{
+ void *address = Lucy_BBSortEx_Peek(self);
+ if (address) {
+ RETVAL = XSBind_cfish_to_perl(*(lucy_Obj**)address);
+ }
+ else {
+ RETVAL = newSV(0);
+ }
+}
+OUTPUT: RETVAL
+
+void
+feed(self, bb)
+ lucy_BBSortEx *self;
+ lucy_ByteBuf *bb;
+CODE:
+ CFISH_INCREF(bb);
+ Lucy_BBSortEx_Feed(self, &bb);
+
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Test::Util::BBSortEx",
+ bind_constructors => ["new"],
+ xs_code => $xs_code,
+);
+
+}
+
+1;
Added: incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Util.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Util.pm?rev=1232020&view=auto
==============================================================================
--- incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Util.pm (added)
+++ incubator/lucy/trunk/perl/buildlib/Lucy/Build/Binding/Util.pm Mon Jan 16 15:10:03 2012
@@ -0,0 +1,307 @@
+# 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 Lucy::Build::Binding::Util;
+
+
+sub bind_all {
+ my $class = shift;
+ $class->bind_debug;
+ $class->bind_indexfilenames;
+ $class->bind_memorypool;
+ $class->bind_priorityqueue;
+ $class->bind_sortexternal;
+ $class->bind_stepper;
+ $class->bind_stringhelper;
+}
+
+sub bind_debug {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Util::Debug
+
+#include "Lucy/Util/Debug.h"
+
+void
+DEBUG_PRINT(message)
+ char *message;
+PPCODE:
+ LUCY_DEBUG_PRINT("%s", message);
+
+void
+DEBUG(message)
+ char *message;
+PPCODE:
+ LUCY_DEBUG("%s", message);
+
+chy_bool_t
+DEBUG_ENABLED()
+CODE:
+ RETVAL = LUCY_DEBUG_ENABLED;
+OUTPUT: RETVAL
+
+=for comment
+
+Keep track of any Lucy objects that have been assigned to global Perl
+variables. This is useful when accounting how many objects should have been
+destroyed and diagnosing memory leaks.
+
+=cut
+
+void
+track_globals(...)
+PPCODE:
+{
+ CHY_UNUSED_VAR(items);
+ LUCY_IFDEF_DEBUG(lucy_Debug_num_globals++;);
+}
+
+void
+set_env_cache(str)
+ char *str;
+PPCODE:
+ lucy_Debug_set_env_cache(str);
+
+void
+ASSERT(maybe)
+ int maybe;
+PPCODE:
+ LUCY_ASSERT(maybe, "XS ASSERT binding test");
+
+IV
+num_allocated()
+CODE:
+ RETVAL = lucy_Debug_num_allocated;
+OUTPUT: RETVAL
+
+IV
+num_freed()
+CODE:
+ RETVAL = lucy_Debug_num_freed;
+OUTPUT: RETVAL
+
+IV
+num_globals()
+CODE:
+ RETVAL = lucy_Debug_num_globals;
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Util::Debug",
+ xs_code => $xs_code,
+);
+
+}
+
+sub bind_indexfilenames {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Util::IndexFileNames
+
+uint64_t
+extract_gen(name)
+ const lucy_CharBuf *name;
+CODE:
+ RETVAL = lucy_IxFileNames_extract_gen(name);
+OUTPUT: RETVAL
+
+SV*
+latest_snapshot(folder)
+ lucy_Folder *folder;
+CODE:
+{
+ lucy_CharBuf *latest = lucy_IxFileNames_latest_snapshot(folder);
+ RETVAL = XSBind_cb_to_sv(latest);
+ CFISH_DECREF(latest);
+}
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Util::IndexFileNames",
+ xs_code => $xs_code,
+);
+
+}
+
+sub bind_memorypool {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Util::MemoryPool",
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_priorityqueue {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Util::PriorityQueue",
+ bind_methods => [
+ qw(
+ Less_Than
+ Insert
+ Pop
+ Pop_All
+ Peek
+ Get_Size
+ )
+ ],
+ bind_constructors => ["new"],
+);
+
+}
+
+sub bind_sortexternal {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::Util::SortExternal
+
+IV
+_DEFAULT_MEM_THRESHOLD()
+CODE:
+ RETVAL = LUCY_SORTEX_DEFAULT_MEM_THRESHOLD;
+OUTPUT: RETVAL
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Util::SortExternal",
+ xs_code => $xs_code,
+ bind_methods => [
+ qw(
+ Flush
+ Flip
+ Add_Run
+ Refill
+ Sort_Cache
+ Cache_Count
+ Clear_Cache
+ Set_Mem_Thresh
+ )
+ ],
+);
+
+}
+
+sub bind_stepper {
+ Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Util::Stepper",
+ bind_methods => [qw( Read_Record )],
+);
+
+}
+
+sub bind_stringhelper {
+ my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy PACKAGE = Lucy::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[lucy_StrHelp_MAX_BASE36_BYTES];
+ size_t size = lucy_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);
+
+chy_bool_t
+utf8_valid(sv)
+ SV *sv;
+CODE:
+{
+ STRLEN len;
+ char *ptr = SvPV(sv, len);
+ RETVAL = lucy_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(LUCY_ERR, "Can't cat_bytes onto a UTF-8 SV"); }
+ sv_catpvn(sv, ptr, len);
+}
+END_XS_CODE
+
+Clownfish::CFC::Binding::Perl::Class->register(
+ parcel => "Lucy",
+ class_name => "Lucy::Util::StringHelper",
+ xs_code => $xs_code,
+);
+
+}
+
+1;