Add sample XS file

samples/XS/CommonMark.xs

@@ -0,0 +1,466 @@
+/*
+ * This software is copyright (C) by Nick Wellnhofer <wellnhofer@aevum.de>.
+ *
+ * This is free software; you can redistribute it and/or modify it under
+ * the same terms as the Perl 5 programming language system itself.
+ *
+ * Terms of the Perl programming language system itself
+ *
+ * a) the GNU General Public License as published by the Free
+ *    Software Foundation; either version 1, or (at your option) any
+ *    later version, or
+ * b) the "Artistic License"
+ */
+
+/*
+ * Notes on memory management
+ *
+ * - A pointer to the Perl SV representing a node is stored in the
+ *   user data slot of `struct cmark_node`, so there's a 1:1 mapping
+ *   between Perl and C objects.
+ * - Every node SV keeps a reference to the parent SV. This is done
+ *   indirectly by looking up the parent SV and increasing its refcount.
+ * - This makes sure that a document isn't freed if the last reference
+ *   from Perl to the root node is dropped, as references to child nodes
+ *   might still exist.
+ * - As a consequence, as long as a node is referenced from Perl, all its
+ *   ancestor nodes will also be associated with a Perl object.
+ */
+
+#define PERL_NO_GET_CONTEXT
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <stdlib.h>
+#include <cmark.h>
+
+#if CMARK_VERSION < 0x001000
+    #error libcmark 0.16.0 is required.
+#endif
+
+/* Fix prefixes of render functions. */
+#define cmark_node_render_html cmark_render_html
+#define cmark_node_render_xml  cmark_render_xml
+#define cmark_node_render_man  cmark_render_man
+
+static SV*
+S_create_or_incref_node_sv(pTHX_ cmark_node *node) {
+    SV *new_obj = NULL;
+
+    while (node) {
+        SV *obj;
+        HV *stash;
+
+        /* Look for existing object. */
+        obj = (SV*)cmark_node_get_user_data(node);
+
+        if (obj) {
+            /* Incref if found. */
+            SvREFCNT_inc_simple_void_NN(obj);
+            if (!new_obj) {
+                new_obj = obj;
+            }
+            break;
+        }
+
+        /* Create a new SV. */
+        obj = newSViv(PTR2IV(node));
+        cmark_node_set_user_data(node, obj);
+        if (!new_obj) {
+            new_obj = obj;
+        }
+
+        /*
+         * Unfortunately, Perl doesn't offer an API function to bless an SV
+         * without a reference. The following code is mostly copied from
+         * sv_bless.
+         */
+        SvOBJECT_on(obj);
+#if (PERL_VERSION <= 16)
+        PL_sv_objcount++;
+#endif
+        SvUPGRADE(obj, SVt_PVMG);
+        stash = gv_stashpvn("CommonMark::Node", 16, GV_ADD);
+        SvSTASH_set(obj, (HV*)SvREFCNT_inc(stash));
+
+        /* Recurse into parent. */
+        node = cmark_node_parent(node);
+    }
+
+    return new_obj;
+}
+
+static void
+S_decref_node_sv(pTHX_ cmark_node *node) {
+    SV *obj;
+
+    if (!node) {
+        return;
+    }
+
+    obj = (SV*)cmark_node_get_user_data(node);
+    if (!obj) {
+        /* Should never happen. */
+        croak("Internal error: node SV not found");
+    }
+
+    SvREFCNT_dec_NN(obj);
+}
+
+/* Find or create an SV for a cmark_node. */
+static SV*
+S_node2sv(pTHX_ cmark_node *node) {
+    SV *obj;
+
+    if (!node) {
+        return &PL_sv_undef;
+    }
+
+    obj = S_create_or_incref_node_sv(aTHX_ node);
+
+    return newRV_noinc(obj);
+}
+
+/* Transfer refcount from a node to another. */
+static void
+S_transfer_refcount(pTHX_ cmark_node *from, cmark_node *to) {
+    if (from != to) {
+        S_create_or_incref_node_sv(aTHX_ to);
+        S_decref_node_sv(aTHX_ from);
+    }
+}
+
+/* Get C struct pointer from an SV argument. */
+static void*
+S_sv2c(pTHX_ SV *sv, const char *class_name, STRLEN len, CV *cv,
+       const char *var_name) {
+    if (!SvROK(sv) || !sv_derived_from_pvn(sv, class_name, len, 0)) {
+        const char *sub_name = GvNAME(CvGV(cv));
+        croak("%s: %s is not of type %s", sub_name, var_name, class_name);
+    }
+    return INT2PTR(void*, SvIV(SvRV(sv)));
+}
+
+
+MODULE = CommonMark  PACKAGE = CommonMark  PREFIX = cmark_
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    if (cmark_version != CMARK_VERSION) {
+        warn("Compiled against libcmark %s, but runtime version is %s",
+             CMARK_VERSION_STRING, cmark_version_string);
+    }
+
+char*
+cmark_markdown_to_html(package, string)
+    SV *package = NO_INIT
+    SV *string
+PREINIT:
+    STRLEN len;
+    const char *buffer;
+CODE:
+    (void)package;
+    buffer = SvPVutf8(string, len);
+    RETVAL = cmark_markdown_to_html(buffer, len);
+OUTPUT:
+    RETVAL
+
+cmark_node*
+cmark_parse_document(package, string)
+    SV *package = NO_INIT
+    SV *string
+PREINIT:
+    STRLEN len;
+    const char *buffer;
+CODE:
+    (void)package;
+    buffer = SvPVutf8(string, len);
+    RETVAL = cmark_parse_document(buffer, len);
+OUTPUT:
+    RETVAL
+
+cmark_node*
+cmark_parse_file(package, file)
+    SV *package = NO_INIT
+    SV *file
+PREINIT:
+    PerlIO *perl_io;
+    FILE *stream = NULL;
+CODE:
+    (void)package;
+    perl_io = IoIFP(sv_2io(file));
+    if (perl_io) {
+        stream = PerlIO_findFILE(perl_io);
+    }
+    if (!stream) {
+        croak("parse_file: file is not a file handle");
+    }
+    RETVAL = cmark_parse_file(stream);
+OUTPUT:
+    RETVAL
+
+int
+cmark_version(package)
+    SV *package = NO_INIT
+CODE:
+    (void)package;
+    RETVAL = cmark_version;
+OUTPUT:
+    RETVAL
+
+const char*
+cmark_version_string(package)
+    SV *package = NO_INIT
+CODE:
+    (void)package;
+    RETVAL = cmark_version_string;
+OUTPUT:
+    RETVAL
+
+int
+cmark_compile_time_version(package)
+    SV *package = NO_INIT
+CODE:
+    (void)package;
+    RETVAL = CMARK_VERSION;
+OUTPUT:
+    RETVAL
+
+const char*
+cmark_compile_time_version_string(package)
+    SV *package = NO_INIT
+CODE:
+    (void)package;
+    RETVAL = CMARK_VERSION_STRING;
+OUTPUT:
+    RETVAL
+
+
+MODULE = CommonMark  PACKAGE = CommonMark::Node  PREFIX = cmark_node_
+
+cmark_node*
+new(package, type)
+    SV *package = NO_INIT
+    cmark_node_type type
+CODE:
+    (void)package;
+    RETVAL = cmark_node_new(type);
+OUTPUT:
+    RETVAL
+
+void
+DESTROY(cmark_node *node)
+CODE:
+    cmark_node *parent = cmark_node_parent(node);
+    if (parent) {
+        cmark_node_set_user_data(node, NULL);
+        S_decref_node_sv(aTHX_ parent);
+    }
+    else {
+        cmark_node_free(node);
+    }
+
+cmark_iter*
+iterator(cmark_node *node)
+CODE:
+    S_create_or_incref_node_sv(aTHX_ node);
+    RETVAL = cmark_iter_new(node);
+OUTPUT:
+    RETVAL
+
+cmark_node*
+interface_get_node(cmark_node *node)
+INTERFACE:
+    cmark_node_next
+    cmark_node_previous
+    cmark_node_parent
+    cmark_node_first_child
+    cmark_node_last_child
+
+int
+interface_get_int(cmark_node *node)
+INTERFACE:
+    cmark_node_get_type
+    cmark_node_get_header_level
+    cmark_node_get_list_type
+    cmark_node_get_list_delim
+    cmark_node_get_list_start
+    cmark_node_get_list_tight
+    cmark_node_get_start_line
+    cmark_node_get_start_column
+    cmark_node_get_end_line
+    cmark_node_get_end_column
+
+NO_OUTPUT int
+interface_set_int(cmark_node *node, int value)
+INTERFACE:
+    cmark_node_set_header_level
+    cmark_node_set_list_type
+    cmark_node_set_list_delim
+    cmark_node_set_list_start
+    cmark_node_set_list_tight
+POSTCALL:
+    if (!RETVAL) {
+        croak("%s: invalid operation", GvNAME(CvGV(cv)));
+    }
+
+const char*
+interface_get_utf8(cmark_node *node)
+INTERFACE:
+    cmark_node_get_type_string
+    cmark_node_get_literal
+    cmark_node_get_title
+    cmark_node_get_url
+    cmark_node_get_fence_info
+
+NO_OUTPUT int
+interface_set_utf8(cmark_node *node, const char *value)
+INTERFACE:
+    cmark_node_set_literal
+    cmark_node_set_title
+    cmark_node_set_url
+    cmark_node_set_fence_info
+POSTCALL:
+    if (!RETVAL) {
+        croak("%s: invalid operation", GvNAME(CvGV(cv)));
+    }
+
+void
+cmark_node_unlink(cmark_node *node)
+PREINIT:
+    cmark_node *old_parent;
+INIT:
+    old_parent = cmark_node_parent(node);
+POSTCALL:
+    S_decref_node_sv(aTHX_ old_parent);
+
+NO_OUTPUT int
+interface_move_node(cmark_node *node, cmark_node *other)
+PREINIT:
+    cmark_node *old_parent;
+    cmark_node *new_parent;
+INIT:
+    old_parent = cmark_node_parent(other);
+INTERFACE:
+    cmark_node_insert_before
+    cmark_node_insert_after
+    cmark_node_prepend_child
+    cmark_node_append_child
+POSTCALL:
+    if (!RETVAL) {
+        croak("%s: invalid operation", GvNAME(CvGV(cv)));
+    }
+    new_parent = cmark_node_parent(other);
+    S_transfer_refcount(aTHX_ old_parent, new_parent);
+
+char*
+interface_render(cmark_node *root, long options = 0)
+INTERFACE:
+    cmark_node_render_html
+    cmark_node_render_xml
+    cmark_node_render_man
+
+
+MODULE = CommonMark  PACKAGE = CommonMark::Iterator  PREFIX = cmark_iter_
+
+void
+DESTROY(cmark_iter *iter)
+CODE:
+    S_decref_node_sv(aTHX_ cmark_iter_get_node(iter));
+    S_decref_node_sv(aTHX_ cmark_iter_get_root(iter));
+    cmark_iter_free(iter);
+
+void
+cmark_iter_next(cmark_iter *iter)
+PREINIT:
+    I32 gimme;
+    cmark_node *old_node;
+    cmark_event_type ev_type;
+PPCODE:
+    gimme    = GIMME_V;
+    old_node = cmark_iter_get_node(iter);
+    ev_type  = cmark_iter_next(iter);
+
+    if (ev_type != CMARK_EVENT_DONE) {
+        cmark_node *node = cmark_iter_get_node(iter);
+
+        ST(0) = sv_2mortal(newSViv((IV)ev_type));
+
+        if (gimme == G_ARRAY) {
+            SV *obj = S_create_or_incref_node_sv(aTHX_ node);
+
+            /* A bit more efficient than S_transfer_refcount. */
+            if (old_node != node) {
+                S_decref_node_sv(aTHX_ old_node);
+                SvREFCNT_inc_simple_void_NN(obj);
+            }
+
+            ST(1) = sv_2mortal(newRV_noinc(obj));
+            XSRETURN(2);
+        }
+        else {
+            S_transfer_refcount(aTHX_ old_node, node);
+            XSRETURN(1);
+        }
+    }
+    else {
+        S_decref_node_sv(aTHX_ old_node);
+
+        if (gimme == G_ARRAY) {
+            XSRETURN_EMPTY;
+        }
+        else {
+            ST(0) = sv_2mortal(newSViv((IV)ev_type));
+            XSRETURN(1);
+        }
+    }
+
+cmark_node*
+cmark_iter_get_node(cmark_iter *iter)
+
+cmark_event_type
+cmark_iter_get_event_type(cmark_iter *iter)
+
+void
+cmark_iter_reset(iter, node, event_type)
+    cmark_iter *iter
+    cmark_node *node
+    cmark_event_type event_type
+PREINIT:
+    cmark_node *old_node;
+INIT:
+    old_node = cmark_iter_get_node(iter);
+    S_transfer_refcount(aTHX_ old_node, node);
+
+
+MODULE = CommonMark  PACKAGE = CommonMark::Parser  PREFIX = cmark_parser_
+
+cmark_parser*
+cmark_parser_new(package)
+    SV *package = NO_INIT
+CODE:
+    (void)package;
+    RETVAL = cmark_parser_new();
+OUTPUT:
+    RETVAL
+
+void
+DESTROY(cmark_parser *parser)
+CODE:
+    cmark_parser_free(parser);
+
+void
+cmark_parser_feed(cmark_parser *parser, SV *string)
+PREINIT:
+    STRLEN len;
+    const char *buffer;
+CODE:
+    buffer = SvPVutf8(string, len);
+    cmark_parser_feed(parser, buffer, len);
+
+cmark_node*
+cmark_parser_finish(cmark_parser *parser)
+