xapian-bindings/perl/perl.i

   1 %module xapian
   2 %{
   3 /* perl.i: SWIG interface file for the Perl bindings
   4  *
   5  * Copyright (C) 2009 Kosei Moriyama
   6  * Copyright (C) 2011,2012,2013,2015,2016,2019,2020,2024 Olly Betts
   7  *
   8  * This program is free software; you can redistribute it and/or
   9  * modify it under the terms of the GNU General Public License as
  10  * published by the Free Software Foundation; either version 2 of the
  11  * License, or (at your option) any later version.
  12  *
  13  * This program is distributed in the hope that it will be useful,
  14  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  15  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16  * GNU General Public License for more details.
  17  *
  18  * You should have received a copy of the GNU General Public License
  19  * along with this program; if not, write to the Free Software
  20  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301
  21  * USA
  22  */
  23 %}
  24
  25 %begin %{
  26 // Older Perl headers contain things which cause warnings with more recent
  27 // C++ compilers.  There's nothing we can really do about them, so just
  28 // suppress them.
  29 #ifdef __clang__
  30 # pragma clang diagnostic push
  31 # pragma clang diagnostic ignored "-Wreserved-user-defined-literal"
  32 #elif defined __GNUC__
  33 // Warning added in GCC 4.8 and we don't support anything older.
  34 # pragma GCC diagnostic push
  35 # pragma GCC diagnostic ignored "-Wliteral-suffix"
  36 #endif
  37
  38 extern "C" {
  39 #include "EXTERN.h"
  40 #include "perl.h"
  41 #include "XSUB.h"
  42 }
  43
  44 #ifdef __clang__
  45 # pragma clang diagnostic pop
  46 #elif defined __GNUC__
  47 # pragma GCC diagnostic pop
  48 #endif
  49 %}
  50
  51 %include ../xapian-head.i
  52
  53 /* "next" is a keyword in Perl. */
  54 %rename(increment_weight) *::next(double min_wt);
  55
  56 /* Wrapping constant values. */
  57 %constant int OP_AND = Xapian::Query::OP_AND;
  58 %constant int OP_OR = Xapian::Query::OP_OR;
  59 %constant int OP_AND_NOT = Xapian::Query::OP_AND_NOT;
  60 %constant int OP_XOR = Xapian::Query::OP_XOR;
  61 %constant int OP_AND_MAYBE = Xapian::Query::OP_AND_MAYBE;
  62 %constant int OP_FILTER = Xapian::Query::OP_FILTER;
  63 %constant int OP_NEAR = Xapian::Query::OP_NEAR;
  64 %constant int OP_PHRASE = Xapian::Query::OP_PHRASE;
  65 %constant int OP_VALUE_RANGE = Xapian::Query::OP_VALUE_RANGE;
  66 %constant int OP_SCALE_WEIGHT = Xapian::Query::OP_SCALE_WEIGHT;
  67 %constant int OP_ELITE_SET = Xapian::Query::OP_ELITE_SET;
  68 %constant int OP_VALUE_GE = Xapian::Query::OP_VALUE_GE;
  69 %constant int OP_SYNONYM = Xapian::Query::OP_SYNONYM;
  70 %constant int OP_MAX = Xapian::Query::OP_MAX;
  71 %constant int OP_WILDCARD = Xapian::Query::OP_WILDCARD;
  72 %constant int OP_VALUE_LE = Xapian::Query::OP_VALUE_LE;
  73 %constant int OP_INVALID = Xapian::Query::OP_INVALID;
  74 %constant int ENQ_ASCENDING = Xapian::Enquire::ASCENDING;
  75 %constant int ENQ_DESCENDING = Xapian::Enquire::DESCENDING;
  76 %constant int ENQ_DONT_CARE = Xapian::Enquire::DONT_CARE;
  77 %constant int FLAG_ACCUMULATE = Xapian::QueryParser::FLAG_ACCUMULATE;
  78 %constant int FLAG_BOOLEAN = Xapian::QueryParser::FLAG_BOOLEAN;
  79 %constant int FLAG_FUZZY = Xapian::QueryParser::FLAG_FUZZY;
  80 %constant int FLAG_NO_POSITIONS = Xapian::QueryParser::FLAG_NO_POSITIONS;
  81 %constant int FLAG_PHRASE = Xapian::QueryParser::FLAG_PHRASE;
  82 %constant int FLAG_LOVEHATE = Xapian::QueryParser::FLAG_LOVEHATE;
  83 %constant int FLAG_BOOLEAN_ANY_CASE = Xapian::QueryParser::FLAG_BOOLEAN_ANY_CASE;
  84 %constant int FLAG_WILDCARD = Xapian::QueryParser::FLAG_WILDCARD;
  85 %constant int FLAG_WILDCARD_GLOB = Xapian::QueryParser::FLAG_WILDCARD_GLOB;
  86 %constant int FLAG_WILDCARD_MULTI = Xapian::QueryParser::FLAG_WILDCARD_MULTI;
  87 %constant int FLAG_WILDCARD_SINGLE = Xapian::QueryParser::FLAG_WILDCARD_SINGLE;
  88 %constant int FLAG_PURE_NOT = Xapian::QueryParser::FLAG_PURE_NOT;
  89 %constant int FLAG_PARTIAL = Xapian::QueryParser::FLAG_PARTIAL;
  90 %constant int FLAG_SPELLING_CORRECTION = Xapian::QueryParser::FLAG_SPELLING_CORRECTION;
  91 %constant int FLAG_SYNONYM = Xapian::QueryParser::FLAG_SYNONYM;
  92 %constant int FLAG_AUTO_SYNONYMS = Xapian::QueryParser::FLAG_AUTO_SYNONYMS;
  93 %constant int FLAG_AUTO_MULTIWORD_SYNONYMS = Xapian::QueryParser::FLAG_AUTO_MULTIWORD_SYNONYMS;
  94 %constant int FLAG_NGRAMS = Xapian::QueryParser::FLAG_NGRAMS;
  95 %constant int FLAG_CJK_NGRAM = Xapian::QueryParser::FLAG_CJK_NGRAM;
  96 %constant int FLAG_WORD_BREAKS = Xapian::QueryParser::FLAG_WORD_BREAKS;
  97 %constant int FLAG_DEFAULT = Xapian::QueryParser::FLAG_DEFAULT;
  98 %constant int STEM_NONE = Xapian::QueryParser::STEM_NONE;
  99 %constant int STEM_SOME = Xapian::QueryParser::STEM_SOME;
 100 %constant int STEM_SOME_FULL_POS = Xapian::QueryParser::STEM_SOME_FULL_POS;
 101 %constant int STEM_ALL = Xapian::QueryParser::STEM_ALL;
 102 %constant int STEM_ALL_Z = Xapian::QueryParser::STEM_ALL_Z;
 103 %constant int FLAG_SPELLING = Xapian::TermGenerator::FLAG_SPELLING;
 104 // FLAG_NGRAMS, FLAG_CJK_NGRAM and FLAG_WORD_BREAKS are already set above from
 105 // QueryParser (values match).
 106 %constant int WILDCARD_LIMIT_ERROR = Xapian::Query::WILDCARD_LIMIT_ERROR;
 107 %constant int WILDCARD_LIMIT_FIRST = Xapian::Query::WILDCARD_LIMIT_FIRST;
 108 %constant int WILDCARD_LIMIT_MOST_FREQUENT = Xapian::Query::WILDCARD_LIMIT_MOST_FREQUENT;
 109
 110 /* Xapian::Enquire */
 111 %feature("shadow") Xapian::Enquire::get_mset
 112 %{
 113 sub get_mset {
 114   my $self = $_[0];
 115   my $nargs = scalar(@_);
 116   if( $nargs == 4 ) {
 117     my $type = ref( $_[2] );
 118     if ( $type eq 'Xapian::RSet' ) {
 119       # get_mset(first, max, rset)
 120       splice @_, 2, 0, (0); # insert checkatleast
 121     }
 122   }
 123   return Xapianc::Enquire_get_mset( @_ );
 124 }
 125 %}
 126
 127 %feature("shadow") Xapian::Enquire::set_query
 128 %{
 129 sub set_query {
 130   if (ref($_[1]) ne 'Xapian::Query') {
 131     push @_, Xapian::Query->new(splice @_, 1);
 132   }
 133   Xapianc::Enquire_set_query(@_);
 134 }
 135 %}
 136
 137 %feature("shadow") Xapian::Enquire::set_sort_by_key
 138 %{
 139 sub set_sort_by_key {
 140     my $self = $_[0];
 141     my $sorter = $_[1];
 142     $self{_sorter} = $sorter;
 143     Xapianc::Enquire_set_sort_by_key( @_ );
 144 }
 145 %}
 146
 147 %feature("shadow") Xapian::Enquire::set_sort_by_key_then_relevance
 148 %{
 149 sub set_sort_by_key_then_relevance {
 150     my $self = $_[0];
 151     my $sorter = $_[1];
 152     $self{_sorter} = $sorter;
 153     Xapianc::Enquire_set_sort_by_key_then_relevance( @_ );
 154 }
 155 %}
 156
 157 %feature("shadow") Xapian::Enquire::set_sort_by_relevance_then_key
 158 %{
 159 sub set_sort_by_relevance_then_key {
 160     my $self = $_[0];
 161     my $sorter = $_[1];
 162     $self{_sorter} = $sorter;
 163     Xapianc::Enquire_set_sort_by_relevance_then_key( @_ );
 164 }
 165 %}
 166
 167 /* Xapian::Enquire */
 168 %extend Xapian::Enquire {
 169 // For compatibility with Search::Xapian.
 170 Xapian::MSet get_mset(Xapian::doccount first,
 171                       Xapian::doccount maxitems,
 172                       const Xapian::MatchDecider* mdecider) {
 173     return $self->get_mset(first, maxitems, 0, NULL, mdecider);
 174 }
 175 }
 176
 177 /* Xapian::ESet */
 178 %extend Xapian::ESet {
 179 Xapian::ESetIterator FETCH(int index) {
 180     return ((*self)[index]);
 181 }
 182 }
 183
 184 /* Xapian::ESetIterator */
 185 %extend Xapian::ESetIterator {
 186 std::string get_termname() {
 187     return self->operator*();
 188 }
 189 }
 190
 191 /* Xapian::MSet */
 192 %extend Xapian::MSet {
 193 Xapian::MSetIterator FETCH(int index) {
 194     return ((*self)[index]);
 195 }
 196 }
 197
 198 /* Xapian::Query */
 199 %feature("shadow") Xapian::Query::Query
 200 %{
 201 sub new {
 202   my $class = shift;
 203   my $query;
 204
 205   if( @_ <= 1 ) {
 206     $query = Xapianc::new_Query(@_);
 207   } else {
 208     use Carp;
 209     my $op = $_[0];
 210     if( $op !~ /^\d+$/ ) {
 211         Carp::croak( "USAGE: $class->new('term') or $class->new(OP, <args>)" );
 212     }
 213     if( $op == 8 ) { # FIXME: 8 is OP_VALUE_RANGE; eliminate hardcoded literal
 214       if( @_ != 4 ) {
 215         Carp::croak( "USAGE: $class->new(OP_VALUE_RANGE, VALNO, START, END)" );
 216       }
 217       $query = Xapianc::new_Query( @_ );
 218     } elsif( $op == 9 ) { # FIXME: OP_SCALE_WEIGHT
 219       if( @_ != 3 ) {
 220         Carp::croak( "USAGE: $class->new(OP_SCALE_WEIGHT, QUERY, FACTOR)" );
 221       }
 222       $query = Xapianc::new_Query( @_ );
 223     } elsif( $op == 11 || $op == 12 ) { # FIXME: OP_VALUE_GE, OP_VALUE_LE; eliminate hardcoded literals
 224       if( @_ != 3 ) {
 225         Carp::croak( "USAGE: $class->new(OP_VALUE_[GL]E, VALNO, LIMIT)" );
 226       }
 227       $query = Xapianc::new_Query( @_ );
 228     } else {
 229       shift @_;
 230       $query = Xapian::newN( $op, \@_ );
 231     }
 232   }
 233   return $query;
 234 }
 235 %}
 236
 237 %typemap(in) SV ** {
 238         AV *tempav;
 239         I32 len;
 240         int i;
 241         SV  **tv;
 242         if (!SvROK($input))
 243             croak("Argument $argnum is not a reference.");
 244         if (SvTYPE(SvRV($input)) != SVt_PVAV)
 245             croak("Argument $argnum is not an array.");
 246         tempav = (AV*)SvRV($input);
 247         len = av_len(tempav);
 248         $1 = (SV **) malloc((len+2)*sizeof(SV *));
 249         for (i = 0; i <= len; i++) {
 250             tv = av_fetch(tempav, i, 0);
 251             $1[i] = *tv;
 252         }
 253         $1[i] = NULL;
 254 };
 255
 256 %typemap(freearg) SV ** {
 257         free($1);
 258 }
 259
 260 %{
 261 class XapianSWIGQueryItor {
 262     AV * array;
 263
 264     int i;
 265
 266   public:
 267     XapianSWIGQueryItor() { }
 268
 269     void begin(AV * array_) {
 270         array = array_;
 271         i = 0;
 272     }
 273
 274     void end(int n) {
 275         i = n;
 276     }
 277
 278     XapianSWIGQueryItor & operator++() {
 279         ++i;
 280         return *this;
 281     }
 282
 283     Xapian::Query operator*() const {
 284         SV **svp = av_fetch(array, i, 0);
 285         if( svp == NULL )
 286             croak("Unexpected NULL returned by av_fetch()");
 287         SV *sv = *svp;
 288
 289         if (!SvOK(sv)) {
 290             croak("USAGE: Xapian::Query->new(OP, @TERMS_OR_QUERY_OBJECTS)");
 291         }
 292
 293         Xapian::Query *q;
 294         if (SWIG_ConvertPtr(sv, (void**)&q,
 295                             SWIGTYPE_p_Xapian__Query, 0) == SWIG_OK) {
 296             return *q;
 297         }
 298
 299         STRLEN len;
 300         const char * ptr = SvPV(sv, len);
 301         return Xapian::Query(string(ptr, len));
 302     }
 303
 304     bool operator==(const XapianSWIGQueryItor & o) {
 305         return i == o.i;
 306     }
 307
 308     bool operator!=(const XapianSWIGQueryItor & o) {
 309         return !(*this == o);
 310     }
 311
 312     typedef std::input_iterator_tag iterator_category;
 313     typedef Xapian::Query value_type;
 314     typedef Xapian::termcount_diff difference_type;
 315     typedef Xapian::Query * pointer;
 316     typedef Xapian::Query & reference;
 317 };
 318
 319 %}
 320
 321 %inline %{
 322 Xapian::Query * newN(int op_, SV *q_) {
 323     Xapian::Query::op op = (Xapian::Query::op)op_;
 324     XapianSWIGQueryItor b, e;
 325
 326     AV *q = (AV *) SvRV(q_);
 327
 328     b.begin(q);
 329     e.end(av_len(q) + 1);
 330
 331     try {
 332         return new Xapian::Query(op, b, e);
 333     } catch (const Xapian::Error &error) {
 334         croak( "Exception: %s", error.get_msg().c_str() );
 335     }
 336 }
 337 %}
 338
 339 /* Xapian::QueryParser */
 340 %feature("shadow") Xapian::QueryParser::QueryParser
 341 %{
 342 sub new {
 343   my $class = shift;
 344   my $qp = Xapianc::new_QueryParser();
 345
 346   bless $qp, $class;
 347   $qp->set_database(@_) if scalar(@_) == 1;
 348
 349   return $qp;
 350 }
 351 %}
 352
 353 %feature("shadow") Xapian::QueryParser::set_stopper
 354 %{
 355 sub set_stopper {
 356     my ($self, $stopper) = @_;
 357     $self{_stopper} = $stopper;
 358     Xapianc::QueryParser_set_stopper( @_ );
 359 }
 360 %}
 361
 362 %feature("shadow") Xapian::QueryParser::add_rangeprocessor
 363 %{
 364 sub add_rangeprocessor {
 365     my ($self, $rproc) = @_;
 366     push @{$self{_rproc}}, $rproc;
 367     Xapianc::QueryParser_add_rangeprocessor( @_ );
 368 }
 369 %}
 370
 371 /* Xapian::SimpleStopper */
 372 %feature("shadow") Xapian::SimpleStopper::SimpleStopper
 373 %{
 374 sub new {
 375     my $class = shift;
 376     my $stopper = Xapianc::new_SimpleStopper();
 377
 378     bless $stopper, $class;
 379     foreach (@_) {
 380         $stopper->add($_);
 381     }
 382
 383     return $stopper;
 384 }
 385 %}
 386
 387 %extend Xapian::SimpleStopper {
 388 bool stop_word(std::string term) {
 389      return (*self)(term);
 390 }
 391 }
 392
 393 /* Xapian::Stem */
 394 %extend Xapian::Stem {
 395 std::string stem_word(std::string word) {
 396             return (*self)(word);
 397 }
 398 }
 399
 400 /* Xapian::TermIterator */
 401 %rename(get_termname) Xapian::TermIterator::get_term;
 402
 403 /* Xapian::WritableDatabase */
 404 %rename(replace_document_by_term) \
 405         Xapian::WritableDatabase::replace_document(std::string_view,
 406                                                    const Xapian::Document&);
 407 %rename(delete_document_by_term) \
 408         Xapian::WritableDatabase::delete_document(std::string_view);
 409
 410 %feature("shadow") Xapian::WritableDatabase::WritableDatabase
 411 %{
 412 sub new {
 413   my $pkg = shift;
 414   my $self;
 415   if( scalar(@_) == 0 ) {
 416     # For compatibility with Search::Xapian
 417     @_ = ('', $Xapianc::DB_BACKEND_INMEMORY);
 418   }
 419   $self = Xapianc::new_WritableDatabase(@_);
 420   bless $self, $pkg if defined($self);
 421 }
 422 %}
 423
 424 %define SUB_CLASS(NS, CLASS)
 425 %{
 426 class perl##CLASS : public NS::CLASS {
 427     SV* callback;
 428
 429   public:
 430     perl##CLASS(SV* func) {
 431         callback = newSVsv(func);
 432     }
 433
 434     ~perl##CLASS() {
 435         SvREFCNT_dec(callback);
 436     }
 437
 438     bool operator()(const std::string& term) const override {
 439         dSP;
 440
 441         ENTER;
 442         SAVETMPS;
 443
 444         PUSHMARK(SP);
 445
 446         SV* arg = sv_newmortal();
 447         sv_setpvn(arg, term.data(), term.size());
 448         XPUSHs(arg);
 449         PUTBACK;
 450
 451         int count = call_sv(callback, G_SCALAR);
 452
 453         SPAGAIN;
 454         if (count != 1)
 455             croak("callback function should return 1 value, got %d", count);
 456
 457         bool result = POPi;
 458
 459         PUTBACK;
 460
 461         FREETMPS;
 462         LEAVE;
 463
 464         return result;
 465     }
 466 };
 467 %}
 468
 469 %enddef
 470
 471 SUB_CLASS(Xapian, ExpandDecider)
 472 SUB_CLASS(Xapian, Stopper)
 473
 474 %{
 475 class perlMatchDecider : public Xapian::MatchDecider {
 476     SV* callback;
 477
 478   public:
 479     perlMatchDecider(SV* func) {
 480         callback = newSVsv(func);
 481     }
 482
 483     ~perlMatchDecider() {
 484         SvREFCNT_dec(callback);
 485     }
 486
 487     bool operator()(const Xapian::Document& doc) const override {
 488         dSP;
 489
 490         ENTER;
 491         SAVETMPS;
 492
 493         PUSHMARK(SP);
 494
 495         XPUSHs(SWIG_NewPointerObj(const_cast<Xapian::Document*>(&doc),
 496                                   SWIGTYPE_p_Xapian__Document, 0));
 497         PUTBACK;
 498
 499         int count = call_sv(callback, G_SCALAR);
 500
 501         SPAGAIN;
 502         if (count != 1)
 503             croak("callback function should return 1 value, got %d", count);
 504
 505         bool result = POPi;
 506
 507         PUTBACK;
 508
 509         FREETMPS;
 510         LEAVE;
 511
 512         return result;
 513     }
 514 };
 515 %}
 516
 517 %{
 518 class perlStemImplementation : public Xapian::StemImplementation {
 519     SV* callback;
 520
 521   public:
 522     perlStemImplementation(SV* func) {
 523         callback = newSVsv(func);
 524     }
 525
 526     ~perlStemImplementation() {
 527         SvREFCNT_dec(callback);
 528     }
 529
 530     std::string operator()(const std::string& word) override {
 531         dSP;
 532
 533         ENTER;
 534         SAVETMPS;
 535
 536         PUSHMARK(SP);
 537
 538         SV* arg = sv_newmortal();
 539         sv_setpvn(arg, word.data(), word.size());
 540         XPUSHs(arg);
 541         PUTBACK;
 542
 543         int count = call_sv(callback, G_SCALAR);
 544
 545         SPAGAIN;
 546         if (count != 1)
 547             croak("callback function should return 1 value, got %d", count);
 548
 549         SV* sv = POPs;
 550         STRLEN len;
 551         const char* ptr = SvPV(sv, len);
 552         std::string result(ptr, len);
 553
 554         PUTBACK;
 555
 556         FREETMPS;
 557         LEAVE;
 558
 559         return result;
 560     }
 561
 562     std::string get_description() const override {
 563         return "perlStemImplementation()";
 564     }
 565 };
 566 %}
 567
 568 %{
 569 class perlKeyMaker : public Xapian::KeyMaker {
 570     SV* callback;
 571
 572   public:
 573     perlKeyMaker(SV* func) {
 574         callback = newSVsv(func);
 575     }
 576
 577     ~perlKeyMaker() {
 578         SvREFCNT_dec(callback);
 579     }
 580
 581     std::string operator()(const Xapian::Document& doc) const override {
 582         dSP;
 583
 584         ENTER;
 585         SAVETMPS;
 586
 587         PUSHMARK(SP);
 588
 589         XPUSHs(SWIG_NewPointerObj(const_cast<Xapian::Document*>(&doc),
 590                                   SWIGTYPE_p_Xapian__Document, 0));
 591         PUTBACK;
 592
 593         int count = call_sv(callback, G_SCALAR);
 594
 595         SPAGAIN;
 596         if (count != 1)
 597             croak("callback function should return 1 value, got %d", count);
 598
 599         SV* sv = POPs;
 600         STRLEN len;
 601         const char* ptr = SvPV(sv, len);
 602         std::string result(ptr, len);
 603
 604         PUTBACK;
 605
 606         FREETMPS;
 607         LEAVE;
 608
 609         return result;
 610     }
 611 };
 612 %}
 613
 614 %{
 615 class perlRangeProcessor : public Xapian::RangeProcessor {
 616     SV* callback;
 617
 618   public:
 619     perlRangeProcessor(SV* func) {
 620         callback = newSVsv(func);
 621     }
 622
 623     ~perlRangeProcessor() {
 624         SvREFCNT_dec(callback);
 625     }
 626
 627     Xapian::Query operator()(const std::string& begin,
 628                              const std::string& end) override {
 629         dSP;
 630
 631         ENTER;
 632         SAVETMPS;
 633
 634         PUSHMARK(SP);
 635         EXTEND(SP, 2);
 636         SV* arg = sv_newmortal();
 637         sv_setpvn(arg, begin.data(), begin.size());
 638         PUSHs(arg);
 639         arg = sv_newmortal();
 640         sv_setpvn(arg, end.data(), end.size());
 641         PUSHs(arg);
 642         PUTBACK;
 643
 644         int count = call_sv(callback, G_SCALAR);
 645
 646         SPAGAIN;
 647         if (count != 1)
 648             croak("callback function should return 1 value, got %d", count);
 649
 650         // Allow the function to return a string or Query object.
 651         SV* sv = POPs;
 652         if (!SvOK(sv))
 653             croak("function must return a string or Query object");
 654
 655         Xapian::Query result;
 656         Xapian::Query* q;
 657         if (SWIG_ConvertPtr(sv, (void**)&q,
 658                             SWIGTYPE_p_Xapian__Query, 0) == SWIG_OK) {
 659             result = *q;
 660         } else {
 661             STRLEN len;
 662             const char* ptr = SvPV(sv, len);
 663             result = Xapian::Query(string(ptr, len));
 664         }
 665
 666         PUTBACK;
 667
 668         FREETMPS;
 669         LEAVE;
 670
 671         return result;
 672     }
 673 };
 674 %}
 675
 676 %{
 677 class perlFieldProcessor : public Xapian::FieldProcessor {
 678     SV* callback;
 679
 680   public:
 681     perlFieldProcessor(SV* func) {
 682         callback = newSVsv(func);
 683     }
 684
 685     ~perlFieldProcessor() {
 686         SvREFCNT_dec(callback);
 687     }
 688
 689     Xapian::Query operator()(const std::string& str) override {
 690         dSP;
 691
 692         ENTER;
 693         SAVETMPS;
 694
 695         PUSHMARK(SP);
 696
 697         SV* arg = sv_newmortal();
 698         sv_setpvn(arg, str.data(), str.size());
 699         XPUSHs(arg);
 700         PUTBACK;
 701
 702         int count = call_sv(callback, G_SCALAR);
 703
 704         SPAGAIN;
 705         if (count != 1)
 706             croak("callback function should return 1 value, got %d", count);
 707
 708         // Allow the function to return a string or Query object.
 709         SV* sv = POPs;
 710         if (!SvOK(sv))
 711             croak("function must return a string or Query object");
 712
 713         Xapian::Query result;
 714         Xapian::Query* q;
 715         if (SWIG_ConvertPtr(sv, (void**)&q,
 716                             SWIGTYPE_p_Xapian__Query, 0) == SWIG_OK) {
 717             result = *q;
 718         } else {
 719             STRLEN len;
 720             const char* ptr = SvPV(sv, len);
 721             result = Xapian::Query(string(ptr, len));
 722         }
 723
 724         PUTBACK;
 725
 726         FREETMPS;
 727         LEAVE;
 728
 729         return result;
 730     }
 731 };
 732 %}
 733
 734 %{
 735 class perlMatchSpy : public Xapian::MatchSpy {
 736     SV* callback;
 737
 738   public:
 739     perlMatchSpy(SV* func) {
 740         callback = newSVsv(func);
 741     }
 742
 743     ~perlMatchSpy() {
 744         SvREFCNT_dec(callback);
 745     }
 746
 747     void operator()(const Xapian::Document& doc, double wt) override {
 748         dSP;
 749
 750         ENTER;
 751         SAVETMPS;
 752
 753         PUSHMARK(SP);
 754         EXTEND(SP, 2);
 755         PUSHs(SWIG_NewPointerObj(const_cast<Xapian::Document*>(&doc),
 756                                  SWIGTYPE_p_Xapian__Document, 0));
 757         mPUSHn(wt);
 758         PUTBACK;
 759
 760         (void)call_sv(callback, G_VOID);
 761
 762         SPAGAIN;
 763         PUTBACK;
 764
 765         FREETMPS;
 766         LEAVE;
 767     }
 768 };
 769 %}
 770
 771 %define SUB_CLASS_TYPEMAPS(NS, CLASS)
 772
 773 %typemap(typecheck, precedence=100) NS::CLASS * {
 774     SV* sv = $input;
 775     void* ptr;
 776     if (SWIG_ConvertPtr(sv, &ptr, $descriptor(NS::CLASS *), 0) == SWIG_OK) {
 777         (void)ptr;
 778         $1 = 1;
 779     } else {
 780         /* The docs in perlapi for call_sv say:
 781          *
 782          *    [T]he SV may be any of a CV, a GV, a reference to a CV, a
 783          *    reference to a GV or "SvPV(sv)" will be used as the name of the
 784          *    sub to call.
 785          *
 786          * To make overloading work helpfully, we don't allow passing the name
 787          * of a sub.  Search::Xapian did in some cases, but it seems unlikely
 788          * anyone relied on this.
 789          */
 790         svtype t = SvTYPE(sv);
 791         if (t == SVt_RV) {
 792             t = SvTYPE(SvRV(sv));
 793         }
 794         $1 = (t == SVt_PVCV || t == SVt_PVGV);
 795     }
 796 }
 797 %typemap(in) NS::CLASS * {
 798     SV* sv = $input;
 799     if (SWIG_ConvertPtr(sv, (void**)&$1,
 800                         $descriptor(NS::CLASS *), 0) != SWIG_OK) {
 801         $1 = new perl##CLASS(sv);
 802     }
 803 }
 804
 805 %enddef
 806 SUB_CLASS_TYPEMAPS(Xapian, MatchDecider)
 807 SUB_CLASS_TYPEMAPS(Xapian, ExpandDecider)
 808 SUB_CLASS_TYPEMAPS(Xapian, Stopper)
 809 SUB_CLASS_TYPEMAPS(Xapian, StemImplementation)
 810 SUB_CLASS_TYPEMAPS(Xapian, KeyMaker)
 811 SUB_CLASS_TYPEMAPS(Xapian, RangeProcessor)
 812 SUB_CLASS_TYPEMAPS(Xapian, FieldProcessor)
 813 SUB_CLASS_TYPEMAPS(Xapian, MatchSpy)
 814
 815 %include except.i
 816 %include ../xapian-headers.i
 817 %include extra.i