view release on metacpan or  search on metacpan

AVLTree.xs  view on Meta::CPAN

    declaring the PERL_NO_GET_CONTEXT macro
  */
  dTHX; 
  
  int cmp;
  
  dSP;
  int count;

  //ENTER;
  //SAVETMPS;
  
  PUSHMARK(SP);
  XPUSHs(sv_2mortal(newSVsv(p1)));
  XPUSHs(sv_2mortal(newSVsv(p2)));
  PUTBACK;
  
  /* Call the Perl sub to process the callback */
  count = call_sv(callback, G_SCALAR);

  SPAGAIN;

  if(count != 1)
    croak("Did not return a value\n");
  
  cmp = POPi;
  PUTBACK;

  //FREETMPS;
  //LEAVE;

  return cmp;
}

static SV* svclone(SV* p) {
  dTHX;       /* fetch context */
  
  return newSVsv(p);
}

void svdestroy(SV* p) {
  dTHX;       /* fetch context */
  
  SvREFCNT_dec(p);
}

/*====================================================================
 * XS SECTION                                                     
 *====================================================================*/

MODULE = AVLTree 	PACKAGE = AVLTree

void
new ( class, cmp_fn )
    char* class
    SV*   cmp_fn
    PROTOTYPE: $$
    PREINIT:
        AVLTree* tree;
        AVLTrav* trav;
    PPCODE:
    {
      SV* self;
      HV* hash = newHV();

      TRACEME("Registering callback for comparison");
      if(callback == (SV*)NULL)
        callback = newSVsv(cmp_fn);
      else
        SvSetSV(callback, cmp_fn);
    
      TRACEME("Allocating AVL tree");      
      tree = avltree_new(svcompare, svclone, svdestroy);
      if(tree == NULL)
	croak("Unable to allocate AVL tree");	
      hv_store(hash, "tree", 4, newSViv(PTR2IV(tree)), 0);

      TRACEME("Allocating AVL tree traversal");
      trav = avltnew();
      if(trav == NULL)
	croak("Unable to allocate AVL tree traversal");
      hv_store(hash, "trav", 4, newSViv(PTR2IV(trav)), 0);
      
      self = newRV_noinc((SV*)hash);;
      sv_2mortal(self);
      sv_bless(self, gv_stashpv(class, FALSE));
     
      PUSHs(self);
      XSRETURN(1);
    }

SV*
find(self, ...)
  SV* self
  PREINIT:
    AVLTree* tree;
  INIT:
    if(items < 2 || !SvOK(ST(1)) || SvTYPE(ST(1)) == SVt_NULL) {
      XSRETURN_UNDEF;
    }
  CODE:
    // get tree pointer
    SV** svp = hv_fetch((HV*)SvRV(self), "tree", 4, 0);
    if(svp == NULL)
      croak("Unable to access tree\n");
    tree = INT2PTR(AVLTree*, SvIV(*svp));

    SV* result = avltree_find(aTHX_ tree, ST(1));
    if(SvOK(result) && SvTYPE(result) != SVt_NULL) {
      /* WARN: if it's mortalised e.g. sv_2mortal(...)? returns "Attempt to free unreferenced scalar: SV" */
      RETVAL = newSVsv(result);
    } else
      XSRETURN_UNDEF;
  OUTPUT:
    RETVAL

int
insert(self, item)
  SV* self
  SV* item
  PROTOTYPE: $$