git.gag.com Git - debian/amanda/blob - perl/amglue/objwrap.c

   1 /*
   2  * Copyright (c) 2009-2012 Zmanda, Inc.  All Rights Reserved.
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful, but
  10  * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  11  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  12  * for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  17  *
  18  * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  19  * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
  20  */
  21
  22 /* Functions to wrap arbitrary C objects into perl, with a blessing.  These
  23  * functions are used when we totally skip SWIG's object-wrapping and build
  24  * our own Perl methods to wrap a class -- currently only in AManda::Xfer.
  25  */
  26
  27 #include "amglue.h"
  28
  29 SV *
  30 new_sv_for_c_obj(
  31     gpointer c_obj,
  32     const char *perl_class)
  33 {
  34     SV *sv = newSV(0);
  35
  36     /* Make an SV that contains a pointer to the object, and bless it
  37      * with the appropriate class. */
  38     sv_setref_pv(sv, perl_class, c_obj);
  39
  40     return sv;
  41 }
  42
  43 gpointer
  44 c_obj_from_sv(
  45     SV *sv,
  46     const char *derived_from)
  47 {
  48     SV *referent;
  49     IV tmp;
  50
  51     if (!sv) return NULL;
  52     if (!SvOK(sv)) return NULL;
  53
  54     /* Peel back the layers.  The sv should be a blessed reference to a PV,
  55      * and we check the class against derived_from to ensure we have the right
  56      * stuff. */
  57     if (!sv_isobject(sv) || !sv_derived_from(sv, derived_from)) {
  58         croak("Value is not an object of type %s", derived_from);
  59         return NULL;
  60     }
  61
  62     referent = (SV *)SvRV(sv);
  63     tmp = SvIV(referent);
  64     return INT2PTR(gpointer, tmp);
  65 }
  66