Changeset 4025

Timestamp:

01/04/08 10:18:55 (5 years ago)

Author:

daisuke

Message:

lang/perl/Senna; fix Query->snip, other various XS stuff

Location:

lang/perl/Senna/trunk

Files:

• Changes (modified) (1 diff)
• lib/Senna.pm (modified) (1 diff)
• lib/Senna.xs (modified) (3 diffs)
• senna-perl.h (modified) (1 diff)
• senna-query.c (modified) (4 diffs)
• typemap (modified) (1 diff)

lang/perl/Senna/trunk/Changes

@@ -4 +4 @@
 0.60000_01
  * Complete rewrite.
- * Now only works with newer libsenna >= 1.0.9
+     * Now only works with newer libsenna >= 1.0.9
+     * Various XS tunings.
  * Deprecated getters for Senna::Index. These should now be accessed
    via Senna::Index::Info, which is returned by using $index->info()
+ * Deprecated usage of $foo->method(%args). Everything should now be
+   called as $foo->method(\%args)
 
 0.50 -

lang/perl/Senna/trunk/lib/Senna.pm

@@ -25 +25 @@
 use Senna::Encoding;
 use Senna::Index;
+use Senna::Query;
 use Senna::RC;
 use Senna::Symbol;

lang/perl/Senna/trunk/lib/Senna.xs

@@ -193 +193 @@
 
 SV *
-SennaPerl_Query_open(pkg, str, default_op, max_exprs, encoding)
+SennaPerl_Query__XS_open(pkg, str, default_op, max_exprs, encoding)
         char *pkg;
         char *str;
@@ -199 +199 @@
         int max_exprs;
         sen_encoding encoding;
+    CODE:
+        RETVAL = SennaPerl_Query_open(pkg, str, default_op, max_exprs, encoding);
+    OUTPUT:
+        RETVAL
 
 sen_rc
@@ -209 +213 @@
 
 sen_rc
-SennaPerl_Query_exec(obj, index, records, op)
+SennaPerl_Query__XS_exec(obj, index, records, op)
         SennaPerl_Query *obj;
         SennaPerl_Index *index;
         SennaPerl_Records *records;
         sen_sel_operator op
-
-SV *
-SennaPerl_Query_snip(query, flags, width, max_results, n_tags, opentags_av, closetags_av, mapping)
+    CODE:
+        RETVAL = SennaPerl_Query_exec(obj, index, records, op);
+    OUTPUT:
+        RETVAL
+
+SennaPerl_Snip *
+SennaPerl_Query_snip(query, flags, width, max_results, tags, mapping)
         SennaPerl_Query *query;
         int flags;
         unsigned int width;
         unsigned int max_results;
-        unsigned int n_tags;
-        AV *opentags_av;
-        AV *closetags_av;
+        AV *tags;
         sen_snip_mapping *mapping;
 
-
+SV *
+SennaPerl_Query_rest(query)
+        SennaPerl_Query *query;
+
+void
+SennaPerl_Query_term(query, callback)
+        SennaPerl_Query *query;
+        SV *callback;
+

lang/perl/Senna/trunk/senna-perl.h

@@ -131 +131 @@
 void SennaPerl_Query_DESTROY(SennaPerl_Query *obj);
 sen_rc SennaPerl_Query_exec(SennaPerl_Query *obj, SennaPerl_Index *index, SennaPerl_Records *records, sen_sel_operator op);
+SennaPerl_Snip * SennaPerl_Query_snip( SennaPerl_Query *query, int flags, unsigned int width, unsigned int max_results, AV *tags, sen_snip_mapping *mapping);
+void SennaPerl_Query_term(SennaPerl_Query *obj, SV *callback);
+SV * SennaPerl_Query_rest(SennaPerl_Query *query);
 
 #endif /* ifndef __SENNA_PERL_H__ */

lang/perl/Senna/trunk/senna-query.c

@@ -66 +66 @@
 }
 
-sen_snip *
-SennaPerl_Query_snip(query, flags, width, max_results, n_tags, opentags_av, closetags_av, mapping)
+SennaPerl_Snip *
+SennaPerl_Query_snip(query, flags, width, max_results, tags, mapping)
         SennaPerl_Query *query;
         int flags;
         unsigned int width;
         unsigned int max_results;
-        unsigned int n_tags;
-        AV *opentags_av;
-        AV *closetags_av;
+        AV *tags;
         sen_snip_mapping *mapping;
 {
     sen_snip *snip;
     SV **svr;
-    I32 list_len;
+    unsigned int tags_av_len;
+    
     STRLEN tag_len;
     char **opentags = NULL;
@@ -86 +85 @@
     unsigned int *closetag_lens = NULL;
 
-    {
-        /* first the open tags */
+    
+    tags_av_len = tags != NULL ? av_len(tags) : 0;
+    if (tags_av_len > 0) {
         I32 i;
-        list_len = opentags_av != NULL ? av_len(opentags_av) : 0;
-        if (list_len > 0) {
-            Newz(1234, opentags, list_len, char *);
-            Newz(1234, opentag_lens, list_len, unsigned int);
-
-            for(i = 0; i < list_len; i++) {
-                svr = av_fetch(opentags_av, i, 0);
-                if (svr != NULL && SvOK(*svr)) {
-                    /* won't make a copy to save memory */
-                    opentags[i] = SvPV(*svr, tag_len);
-                    opentag_lens[i] = tag_len;
-                }
+        SV **svr;
+        AV *tag_pair;
+
+        Newz(1234, opentags, tags_av_len, char *);
+        Newz(1234, opentag_lens, tags_av_len, unsigned int);
+        Newz(1234, closetags, tags_av_len, char *);
+        Newz(1234, closetag_lens, tags_av_len, unsigned int);
+        
+        for(i = 0; i < tags_av_len; i++) {
+            /* each array element contains another array, which should
+             * contain two elements [ 'opentag', 'closetag' ]
+             */
+            svr = av_fetch(tags, i, 0);
+            if (svr == NULL || ! SvOK(*svr) || ! SvROK(*svr) ||
+                SvTYPE(*svr) != SVt_PVAV )
+            {
+                croak("tags must contain arrayref(s)");
             }
-        }
-    }
-
-    {
-        I32 i;
-        list_len = closetags_av != NULL ? av_len(closetags_av) : 0;
-        if (list_len > 0) {
-            Newz(1234, closetags, list_len, char *);
-            Newz(1234, closetag_lens, list_len, unsigned int);
-
-            for(i = 0; i < list_len; i++) {
-                svr = av_fetch(closetags_av, i, 0);
-                if (svr != NULL && SvOK(*svr)) {
-                    /* won't make a copy to save memory */
-                    closetags[i] = SvPV(*svr, tag_len);
-                    closetag_lens[i] = tag_len;
-                }
+
+            tag_pair = (AV *) SvRV(*svr);
+            svr = av_fetch(tag_pair, 0, 0);
+            if (svr == NULL || ! SvOK(*svr)) {
+                croak("each element in tags must contain a tag string");
             }
+
+            opentags[i] = SvPV(*svr, tag_len);
+            opentag_lens[i] = tag_len;
+
+            tag_pair = (AV *) SvRV(*svr);
+            svr = av_fetch(tag_pair, 1, 0);
+            if (svr == NULL || ! SvOK(*svr)) {
+                croak("each element in tags must contain a tag string");
+            }
+
+            closetags[i] = SvPV(*svr, tag_len);
+            closetag_lens[i] = tag_len;
         }
     }
@@ -127 +132 @@
         width,
         max_results,
-        n_tags,
+        tags_av_len,
         (const char **) opentags,
         opentag_lens,
@@ -143 +148 @@
 }
 
+SV *
+SennaPerl_Query_rest(query)
+        SennaPerl_Query *query;
+{
+    char *rest;
+    unsigned int len;
+
+    len = sen_query_rest(XS_2SENQUERY(query), (const char **) &rest);
+    return newSVpv(rest, len);
+}
+
+/* sen_query_term needs a callback. This C callback is a bridge that
+ * calls a Perl subroutine from within that callback. The first argument
+ * in C<args> is the ref to sub
+ */
+int
+SennaPerl_Query_Term_CallbackBridge(const char *value, unsigned int len, void *args)
+{
+    SV *sv;
+    SV *callback;
+    dSP;
+
+    ENTER;
+    SAVETMPS;
+
+    PUSHMARK(SP);
+    EXTEND(SP, 1);
+    PUSHs(sv_2mortal(newSVpv(value, len)));
+    PUTBACK;
+
+    call_sv((SV *) args, G_DISCARD|G_VOID);
+
+    SPAGAIN;
+    sv = POPs;
+
+    FREETMPS;
+    LEAVE;
+
+    return SvIV(sv);
+}
+
+void
+SennaPerl_Query_term(query, callback)
+        SennaPerl_Query *query;
+        SV *callback;
+{
+    if (callback == NULL || !SvOK(callback) || ! SvROK(callback) ||
+        SvTYPE( SvRV( callback ) ) != SVt_PVCV )
+    {
+        croak("Senna::Query->term needs a coderef");
+    }
+
+    sen_query_term( XS_2SENQUERY(query), 
+        SennaPerl_Query_Term_CallbackBridge,
+        (void *) callback
+    );
+}
 
 #if 0
-
-unsigned int sen_query_rest(sen_query *q, const char ** const rest);
-void sen_query_term(sen_query *q, query_term_callback func, void *func_arg);
+/* Not documented as of 2008/01/03 */
 sen_rc sen_query_scan(sen_query *q, const char **strs, unsigned int *str_lens,
                       unsigned int nstrs, int flags, int *found, int *score);

lang/perl/Senna/trunk/typemap

@@ -26 +26 @@
         $var = XS_STATE(SennaPerl_Snip *, $arg);
 
+OUTPUT
+T_PTROBJ_SNIP
+        XS_STRUCT2OBJ($arg, "Senna::Snip", $var);
+        SvREADONLY_on($arg);
+