lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From mar...@apache.org
Subject [lucy-commits] svn commit: r1058782 - in /incubator/lucy/trunk: clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm perl/lib/Lucy.pm perl/lib/Lucy/Document/Doc.pm perl/lib/Lucy/Document/HitDoc.pm perl/t/200-doc.t
Date Thu, 13 Jan 2011 22:58:42 GMT
Author: marvin
Date: Thu Jan 13 22:58:41 2011
New Revision: 1058782

URL: http://svn.apache.org/viewvc?rev=1058782&view=rev
Log:
Remove type mapping of void* for Perl binding which assumes that it's a Perl
RV*.  Hand roll some method bindings which can no longer be autogenerated
(because void* is in the signature).

Modified:
    incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm
    incubator/lucy/trunk/perl/lib/Lucy.pm
    incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm
    incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm
    incubator/lucy/trunk/perl/t/200-doc.t

Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm?rev=1058782&r1=1058781&r2=1058782&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/TypeMap.pm Thu Jan 13 22:58:41
2011
@@ -97,18 +97,6 @@ sub _sv_to_cf_obj {
     }
 }
 
-sub _void_star_to_clownfish {
-    my ( $type, $cf_var, $xs_var ) = @_;
-    # Assume that void* is a reference SV -- either a hashref or an arrayref.
-    return qq|if (SvROK($xs_var)) {
-            $cf_var = SvRV($xs_var);
-        }
-        else {
-            $cf_var = NULL; /* avoid uninitialized compiler warning */
-            CFISH_THROW(CFISH_ERR, "$cf_var is not a reference");
-        }\n|;
-}
-
 sub from_perl {
     my ( $type, $cf_var, $xs_var ) = @_;
     confess("Not a Clownfish::Type")
@@ -122,11 +110,6 @@ sub from_perl {
             return $sub->( $cf_var, $xs_var );
         }
     }
-    elsif ( $type->is_composite ) {
-        if ( $type->to_c eq 'void*' ) {
-            return _void_star_to_clownfish( $type, $cf_var, $xs_var );
-        }
-    }
 
     confess( "Missing typemap for " . $type->to_c );
 }

Modified: incubator/lucy/trunk/perl/lib/Lucy.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy.pm?rev=1058782&r1=1058781&r2=1058782&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy.pm Thu Jan 13 22:58:41 2011
@@ -118,6 +118,11 @@ sub error {$Lucy::Object::Err::error}
     use bytes;
     no bytes;
 
+    our %new_PARAMS = (
+        fields => undef,
+        doc_id => 0,
+    );
+
     use overload
         fallback => 1,
         '%{}'    => \&get_fields;
@@ -139,6 +144,16 @@ sub error {$Lucy::Object::Err::error}
 }
 
 {
+    package Lucy::Document::HitDoc;
+
+    our %new_PARAMS = (
+        fields => undef,
+        score  => 0,
+        doc_id => 0,
+    );
+}
+
+{
     package Lucy::Object::I32Array;
     our %new_PARAMS = ( ints => undef );
 }

Modified: incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm?rev=1058782&r1=1058781&r2=1058782&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Document/Doc.pm Thu Jan 13 22:58:41 2011
@@ -26,12 +26,55 @@ my $xs_code = <<'END_XS_CODE';
 MODULE = Lucy     PACKAGE = Lucy::Document::Doc
 
 SV*
+new(either_sv, ...)
+    SV *either_sv;
+CODE:
+{
+    SV* fields_sv = NULL; 
+    SV* doc_id_sv = NULL; 
+    chy_bool_t args_ok = XSBind_allot_params(
+        &(ST(0)), 1, items, "Lucy::Document::Doc::new_PARAMS",
+        &fields_sv, "fields", 6,
+        &doc_id_sv, "doc_id", 6,
+        NULL);
+    if (!args_ok) {
+        CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
+    }     
+
+    HV      *fields = NULL;
+    int32_t  doc_id = 0;
+    if (fields_sv && XSBind_sv_defined(fields_sv)) {
+        if (SvROK(fields_sv)) {
+            fields = (HV*)SvRV(fields_sv);
+        }     
+        if (!fields || SvTYPE((SV*)fields) != SVt_PVHV) {
+            CFISH_THROW(CFISH_ERR, "fields is not a hashref");
+        }
+    }     
+    if (doc_id_sv && XSBind_sv_defined(doc_id_sv)) {
+        doc_id = (int32_t)SvIV( doc_id_sv );
+    }     
+
+    lucy_Doc *self = (lucy_Doc*)XSBind_new_blank_obj(either_sv);
+    lucy_Doc_init(self, fields, doc_id);
+    RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
+}
+OUTPUT: RETVAL
+
+SV*
 get_fields(self, ...)
     lucy_Doc *self;
 CODE:
     CHY_UNUSED_VAR(items);
     RETVAL = newRV_inc( (SV*)Lucy_Doc_Get_Fields(self) );
 OUTPUT: RETVAL
+
+void
+set_fields(self, fields)
+    lucy_Doc *self;
+    HV *fields;
+PPCODE:
+    lucy_Doc_set_fields(self, fields);
 END_XS_CODE
 
 my $synopsis = <<'END_SYNOPSIS';
@@ -56,8 +99,7 @@ Clownfish::Binding::Perl::Class->registe
     parcel            => "Lucy",
     class_name        => "Lucy::Document::Doc",
     xs_code           => $xs_code,
-    bind_constructors => ['new'],
-    bind_methods      => [qw( Set_Doc_ID Get_Doc_ID Set_Fields )],
+    bind_methods      => [qw( Set_Doc_ID Get_Doc_ID )],
     make_pod          => {
         methods     => [qw( set_doc_id get_doc_id get_fields )],
         synopsis    => $synopsis,

Modified: incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm?rev=1058782&r1=1058781&r2=1058782&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm (original)
+++ incubator/lucy/trunk/perl/lib/Lucy/Document/HitDoc.pm Thu Jan 13 22:58:41 2011
@@ -22,6 +22,52 @@ __END__
 
 __BINDING__
 
+my $xs_code = <<'END_XS_CODE';
+MODULE = Lucy   PACKAGE = Lucy::Document::HitDoc
+
+SV*
+new(either_sv, ...)
+    SV *either_sv;
+CODE:
+{
+    SV* fields_sv = NULL; 
+    SV* doc_id_sv = NULL; 
+    SV* score_sv  = NULL; 
+    chy_bool_t args_ok = XSBind_allot_params(
+        &(ST(0)), 1, items, "Lucy::Document::HitDoc::new_PARAMS",
+        &fields_sv, "fields", 6,
+        &doc_id_sv, "doc_id", 6,
+        &score_sv, "score", 5,
+        NULL);
+    if (!args_ok) {
+        CFISH_RETHROW(LUCY_INCREF(cfish_Err_get_error()));
+    }     
+
+    HV      *fields = NULL;
+    int32_t  doc_id = 0;
+    float    score  = 0.0f;
+    if (fields_sv && XSBind_sv_defined(fields_sv)) {
+        if (SvROK(fields_sv)) {
+            fields = (HV*)SvRV(fields_sv);
+        }     
+        if (!fields || SvTYPE((SV*)fields) != SVt_PVHV) {
+            CFISH_THROW(CFISH_ERR, "fields is not a hashref");
+        }
+    }     
+    if (doc_id_sv && XSBind_sv_defined(doc_id_sv)) {
+        doc_id = (int32_t)SvIV( doc_id_sv );
+    }     
+    if (score_sv && XSBind_sv_defined(score_sv)) {
+        score = (float)SvNV( score_sv );
+    }     
+
+    lucy_HitDoc *self = (lucy_HitDoc*)XSBind_new_blank_obj(either_sv);
+    lucy_HitDoc_init(self, fields, doc_id, score);
+    RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
+}
+OUTPUT: RETVAL
+END_XS_CODE
+
 my $synopsis = <<'END_SYNOPSIS';
     while ( my $hit_doc = $hits->next ) {
         print "$hit_doc->{title}\n";
@@ -33,8 +79,8 @@ END_SYNOPSIS
 Clownfish::Binding::Perl::Class->register(
     parcel            => "Lucy",
     class_name        => "Lucy::Document::HitDoc",
-    bind_constructors => ['new'],
     bind_methods      => [qw( Set_Score Get_Score )],
+    xs_code           => $xs_code,
     make_pod          => {
         methods  => [qw( set_score get_score )],
         synopsis => $synopsis,

Modified: incubator/lucy/trunk/perl/t/200-doc.t
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/perl/t/200-doc.t?rev=1058782&r1=1058781&r2=1058782&view=diff
==============================================================================
--- incubator/lucy/trunk/perl/t/200-doc.t (original)
+++ incubator/lucy/trunk/perl/t/200-doc.t Thu Jan 13 22:58:41 2011
@@ -16,7 +16,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10;
+use Test::More tests => 11;
 use Storable qw( nfreeze thaw );
 use Lucy::Test;
 
@@ -24,6 +24,9 @@ my $doc = Lucy::Document::Doc->new;
 is_deeply( $doc->get_fields, {}, "get_fields" );
 is( $doc->get_doc_id, 0, "default doc_id of 0" );
 
+$doc->set_fields( { foo => 'oink' } );
+is_deeply( $doc->get_fields, { foo => 'oink' }, "set_fields" );
+
 $doc->{foo} = "blah";
 is_deeply( $doc->get_fields, { foo => 'blah' }, "overloading" );
 



Mime
View raw message