=head1 NAME

VFunc How-To - How to write bindings for GObject VFuncs

=head1 CONTEXT

Gtk2-Perl's Glib module provides extensive facilities for writing Perl
extensions for libraries based on GObject.  In most cases, the built-in
magic does everything you need; in some cases, however, you run into a
snag trying to bind a particular portion of some library's API.

In particular, GObject vfuncs without associated signals cause some pain
and suffering for binding writers.

This document attempts to collate the current state-of-the-art for how
to bind GObject vfuncs to Perl.

=head1 PHILOSOPHY

The idea is to make things as Perl-ish as possible.  In Perl, you override
methods my simply providing your own method with the same name as the parent
class' method.  When perl does a method lookup, your class' method is found
first and gets called first.  To chain up to the parent class, you use
SUPER::I<methodname> and perl finds the next occurrence of that method name
in @ISA and calls it.

However, GObjects use vtables to store function pointers for virtual
functions.  When some code invokes a virtual method on a GObject, the C code
typically looks up the associated GObjectClass, finds the right function
pointer, and calls it --- the Perl interpreter is never involved, so your
overrides never get called!  Worse yet, the vfuncs are usually private and
typically have the same name as a public function which invokes them.

So, we have to figure out how to make the GObject stuff behave like Perl stuff.

=head1 METHODOLOGY

The solution is to install as GObjectClass vfuncs C functions that marshal to
Perl code with C<call_method>.   As always, the devil is in the details.
Perl uses ALLCAPSNAMES for functions that get called from deep inside the
interpreter rather than by other Perl code.  Sticking with this convention,
but using underscores to keep separate the words and avoid deviating from the
GLib-ish names too much (that is, ALL_CAPS_NAMES) will help us avoid the
infinite recursion problem -- C<< $object->foo >> will invoke C<FOO> instead
of calling C<foo> again.

We should provide a fallback implementation as an xsub, so that Perl code
can use SUPER:: to chain up.  (This is not necessary in some situations,
for example functions like Gtk2::Container::SET_PROPERTY which are not
meant to be chained.)  For speed, we'll find out before marshaling whether
the method can be found, and if not, immediately look up the parent's
method and call it; otherwise, we'll marshal to Perl and then immediately
back to C via the fallback xsub, which is simply wasteful.

=head1 EXAMPLE

The methodology described above will require great attention to detail and
involves a lot of boilerplate-style code which can't necessarily be copied
or made generic for all objects to use.  Here's an example to get you
started.

Here's the object we need to wrap:

  typedef struct _MupTricky      MupTricky;
  typedef struct _MupTrickyClass MupTrickyClass;
  ...
  struct _MupTricky {
          GObject object;
          gpointer priv;
  };

  struct _MupTrickyClass {
          GObjectClass parent_class;
          /* vfuncs without associated signals */
          void     (*frobnicate) (MupTricky   * tricky);
          gboolean (*masticate)  (MupTricky   * tricky,
                                  const gchar * target);
  };
  ...
  /* invokes the virtual methods */
  void     mup_tricky_frobnicate (MupTricky   * tricky);
  gboolean mup_tricky_masticate  (MupTricky   * tricky,
                                  const gchar * target);


Bindings for this would be along these lines...

The typemap file:

  TYPEMAP
  MupTricky*	T_GPERL_GENERIC_WRAPPER
  MupTricky_noinc*	T_GPERL_GENERIC_WRAPPER

And the XS file:

  /* MupTricky.xs */
  #include "gperl.h"
  #include <muptricky.h>

  /* boilerplate -- this is often done for you by Gtk2::CodeGen */
  /* so we can use the _noinc variant */
  typedef MupTricky MupTricky_noinc;
  #define newSVMupTricky(obj)        (gperl_new_object ((obj), FALSE))
  #define newSVMupTricky_noinc(obj)  (gperl_new_object ((obj), TRUE))

  /*
   * here's where the fun begins: some private functions to be
   * used as vfunc overrides.  they marshal to Perl code, falling
   * back if necessary.
   */

  /* first, some utility code: */
  static gpointer
  get_parent_class (GObject * object, GType as_type)
  {
          GType parent_type = g_type_parent (G_OBJECT_TYPE (object));
          gpointer klass = g_type_class_peek (parent_type);
          if (! G_TYPE_CHECK_CLASS_TYPE (klass, as_type))
                 croak ("%s is not a %s",
                        g_type_name (parent_type),
                        g_type_name (as_type));
          return klass;
  }
  #define GET_PARENT_CLASS(obj)	\
      ((MupTrickyClass*) get_parent_class ((GObject*)(obj), MUP_TYPE_TRICKY))

  #define FIND_METHOD(obj, methname) \
      gv_fetchmethod (gperl_object_stash_from_type (G_OBJECT_TYPE ((obj))), \
                      (name))

  /* now the vfunc overrides: */
  static void
  mupperl_tricky_frobnicate (MupTricky * tricky)
  {
          dSP;
          ENTER;
          SAVETMPS;
          PUSHMARK (SP);
          PUSHs (sv_2mortal (newSVMupTricky (tricky)));
          PUTBACK;
          call_method ("FROBNICATE", G_VOID|G_DISCARD);
          FREETMPS;
          LEAVE;
  }

  static gboolean
  mupperl_tricky_masticate (MupTricky   * tricky,
                            const gchar * target)
  {
          /* this method is optional, and subclasses may have no interest
           * in overriding it.  therefore, for efficiency, we see first if
           * the object provides an override; if not, we don't marshal to
           * perl at all.
           */
          HV * stash = gperl_object_stash_from_type (G_OBJECT_TYPE (tricky));
          GV * method = gv_fetchmethod (stash, "MASTICATE");
          gboolean ret = FALSE;

          if (method && GvCV (method)) {
                  gboolean ret;
                  dSP;
                  ENTER;
                  SAVETMPS;
                  PUSHMARK (SP);
                  EXTEND (SP, 2);
                  PUSHs (sv_2mortal (newSVMupTricky (tricky)));
                  PUSHs (sv_2mortal (newSVGChar (target)));
                  PUTBACK;
                  call_sv ((SV*) GvCV (method), G_SCALAR);
                  SPAGAIN;
                  ret = POPi;
                  PUTBACK;
                  FREETMPS;
                  LEAVE;
                  return ret;
          } else {
                  /* no override found, fall back immediately to the
                   * parent class' implementation. */
                  MupTrickyClass * klass = GET_PARENT_CLASS (tricky);
                  if (klass->masticate)
                          return klass->masticate (tricky, target);
                  else
                          return FALSE;
          }
  }

  /*
   * a class init function to be used on Perl-derived classes.
   * we'll call this from _INSTALL_OVERRIDES, and install our own
   * vfuncs in the class' vtable.
   */
  static void
  mupperl_tricky_class_init (MupTrickyClass * klass)
  {
          klass->frobnicate = mupperl_tricky_frobnicate;
          klass->masticate = mupperl_tricky_masticate;
  }

  /* now we return to your regularly-scheduled bindings.... */

  MODULE = Mup::Tricky  PACKAGE = Mup::Tricky  PREFIX = mup_tricky_

  BOOT:
          /* again, Gtk2::CodeGen can do this for you. */
          gperl_register_object (MUP_TYPE_TRICKY, "Mup::Tricky");

  ...

  ## normal method/function bindings

  void mup_tricky_frobnicate (MupTricky * tricky)

  gboolean mup_tricky_masticate (MupTricky * tricky, gchar * target)

  ...

  ## now the extra stuff for the vfuncs:

  ##
  ## As part of the object registration process triggered by
  ## Glib::Type::register_object, the method _INSTALL_OVERRIDES
  ## will be invoked, if found, on all classes in the new type's
  ## ancestry from the root to the bottom, so that the various
  ## classes can install vfunc marshaling overrides.  let's
  ## have one for ourselves.
  ##
  void
  _INSTALL_OVERRIDES (const char * package)
      PREINIT:
          GType gtype;
          MupTrickyClass * klass;
      CODE:
          gtype = gperl_object_type_from_package (package);
          /* sanity-check that */
          if (!gtype)
                  croak ("package '%s' is not registered with Gtk2-Perl",
                         package);
          if (!g_type_is_a (gtype, MUP_TYPE_TRICKY))
                  croak ("%s(%s) is not a MupTricky",
                         package, g_type_name (gtype));
          /* peek should suffice, because the bindings keep perl-registered
           * classes alive. */
          klass = g_type_class_peek (gtype);
          mupperl_tricky_class_init (klass);
  
  ##
  ## and now, fallback implementations for the VFuncs
  ##
  
  void
  FROBNICATE (MupTricky * tricky)
      PREINIT:
          MupTrickyClass * klass;
      CODE:
          klass = GET_PARENT_CLASS (tricky);
          if (klass->frobnicate)
                  klass->frobnicate (tricky);
  
  gboolean
  MASTICATE (MupTricky * tricky, gchar * target)
      PREINIT:
          MupTrickyClass * klass;
      CODE:
          klass = GET_PARENT_CLASS (tricky);
          if (klass->masticate)
                  RETVAL = klass->masticate (tricky, target);
          else
                  RETVAL = FALSE;
      OUTPUT:
          RETVAL


This was, of course, a rather contrived example, but it should be relatively
obvious (if you were paying close attention) that there are a million ways
to optimize this process, and the actual implementation details you choose
will depend almost entirely on the situation at hand.  For example, if
child classes absolutely B<must> provide an implementation of C<frobnicate>
(for example if the base class is abstract), then you wouldn't provide
a fallback implementation at all, and the springboard marshaler would
simply use C<call_method>, which would fail with perl's normal "can't locate
method FROBNICATE in class Foo" message.

Notice that at all points in the example we explicitly look up the type for
the instance object; this is because the instance will be an instance of a
type derived from the class we're currently implementing.  This is a subtle
yet vitally important point.  FIXME: in fact, we probably need to ensure
that we seek up the hierarchy to the first non-perl-derived class in order
to avoid another nasty case of infinite recursion. 

=head1 SEE ALSO

This assumes you have read the bindings howto at
http://gtk2-perl.sourceforge.net/doc/binding_howto.pod.html

Other good things to read are L<Glib::devel>, L<Gtk2::devel>,
L<Glib::xsapi>, and of course L<perlapi>, L<perlxs>, L<perlxstut>, 
L<perlcall>, and L<perlguts>.

=head1 AUTHOR

muppet <scott at asofyet dot org>

=head1 COPYRIGHT

Copyright (C) 2004 by muppet.

You are free to use this information however you like, provided you don't
pretend that you wrote it.

=head1 VERSION

$Header:$