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