Show an example of storing private data in magic.

This is useful to hide C pointers from Perl land (to prevent
segfaults and tinkering, etc)

Simple-Class-Private-Data/Changes

@@ -0,0 +1,6 @@
+Revision history for Perl extension Simple:Class::Private::Data.
+
+0.01  Wed Oct 30 18:36:50 2013
+	- original version; created by h2xs 1.23 with options
+		-A -n Simple:Class::Private::Data
+

Simple-Class-Private-Data/Data.xs

@@ -0,0 +1,153 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+
+/* Taken from XS::Object::Magic */
+
+STATIC MGVTBL null_mg_vtbl = {
+    NULL, /* get */
+    NULL, /* set */
+    NULL, /* len */
+    NULL, /* clear */
+    NULL, /* free */
+#if MGf_COPY
+    NULL, /* copy */
+#endif /* MGf_COPY */
+#if MGf_DUP
+    NULL, /* dup */
+#endif /* MGf_DUP */
+#if MGf_LOCAL
+    NULL, /* local */
+#endif /* MGf_LOCAL */
+};
+
+MODULE = Simple::Class::Private::Data		PACKAGE = Simple::Class::Private::Data
+
+SV *
+new(package, ...)
+    SV *package
+  PREINIT:
+    HV *self;
+    HV *stash;
+    SV *self_ref;
+    int i = 0;
+  CODE:
+    /* Make sure the first argument is a string */
+    if (!SvPOK(package)) {
+        croak("new() expects a package name");
+    }
+
+    /* Make sure we have an even number of arguments for our hash */
+    if ((items-1) % 2) {
+        croak("Odd number of elements in constructor arguments");
+    }
+
+    /* my %self; */
+    self = newHV();
+
+    /* Get our packages stash (needed for bless) */
+    stash = gv_stashpv(SvPV_nolen(package), 0);
+    if (!stash) {
+        croak("Failed to find our stash!");
+    }
+
+    /* my $ref = \%self; # Weakened, though... */
+    self_ref = newRV_noinc((SV*)self);
+
+    /* Take @_ and fill in our object with it
+     *
+     *  ST(0) is the package name, ST(i) to ST(items-1) are the rest
+     *  of the arguments */
+    for (i = 1; i < items; i+= 2) {
+        SV *obj = ST(i+1);
+
+        /* if (ref $val) { # no refs allowed! } */
+        if (SvROK(obj)) {
+            croak("Hash value for '%s' must be a string", SvPV_nolen(ST(i)));
+        }
+
+        /* obj has refcount of 0 here I guess. It needs 1 which our
+           hash will own */
+        SvREFCNT_inc(obj);
+
+        /* Storing '_private' string? Hide it from Perl land in magic */
+        if (!strcmp(SvPV_nolen(ST(i)), "_private")) {
+            /* if (ref $val) { # no refs allowed! } */
+            if (SvROK(obj)) {
+                croak("Hash value for '%s' must be a string", SvPV_nolen(ST(i)));
+            }
+
+            char *data = SvPV_nolen(obj);
+
+            /* Make us magic! */
+            sv_magicext((SV*)self, NULL, PERL_MAGIC_ext, &null_mg_vtbl, data, strlen(data));
+
+        } else {
+
+            /* $self{$key} = $val */
+            if (NULL == hv_store(self, SvPV_nolen(ST(i)), strlen(SvPV_nolen(ST(i))), obj, 0)) {
+                croak("panic: hv_store() failed to store element in hash");
+            }
+        }
+    }
+
+    /* return bless $self, __PACKAGE__ */
+    RETVAL = sv_bless(self_ref, stash);
+  OUTPUT:
+    RETVAL
+
+
+void
+display(self)
+    SV *self
+  PREINIT:
+    HV *obj;
+    SV *next;
+    char *key;
+    I32 rlen;
+  CODE:
+    if (!sv_isobject(self)) {
+         croak("Self is not an object");
+    }
+
+    obj = (HV*) SvRV(self);
+
+    /* if (Scalar::Util::reftype($obj) ne 'HASH') { ... } */
+    if (!(SvTYPE(obj) == SVt_PVHV)) {
+        croak("Reference is not a hashref");
+    }
+
+    PerlIO_printf(PerlIO_stdout(), "Self:\n");
+
+    /* Iterate through our hash and print out our keys/values.
+     * 
+     * Similar to:
+     *
+     *   while (my ($k, $v) = each %$self) {
+     *       print "$k: $v\n";
+     *   }
+     */
+    hv_iterinit(obj);
+
+    while (next = hv_iternextsv(obj, &key, &rlen)) {
+        PerlIO_printf(PerlIO_stdout(), "\t%s: %s\n", key, SvPV_nolen(next));
+    }
+
+    /* Any private data? */
+    if (SvTYPE(obj) >= SVt_PVMG) {
+        MAGIC *mg;
+
+        /* Our object may have lots of magic, look through it all to
+           find ours */
+        for (mg = SvMAGIC(obj); mg; mg = mg->mg_moremagic) {
+            if (
+                    (mg->mg_type == PERL_MAGIC_ext)
+                 && (mg->mg_virtual == &null_mg_vtbl)
+            ) {
+                PerlIO_printf(PerlIO_stdout(), "\t%s: %s\n", "(private)", mg->mg_ptr);
+            }
+        }
+    }
+

Simple-Class-Private-Data/MANIFEST

@@ -0,0 +1,10 @@
+Changes
+Data.xs
+lib/Simple/Class/Private/Data.pm
+Makefile.PL
+MANIFEST			This list of files
+META.json
+META.yml
+ppport.h
+README
+t/Simple-Class-Private-Data.t

Simple-Class-Private-Data/META.json

@@ -0,0 +1,39 @@
+{
+   "abstract" : "Example class in XS",
+   "author" : [
+      "Matthew Horsfall <WolfSage@gmail.com>"
+   ],
+   "dynamic_config" : 0,
+   "generated_by" : "ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830",
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : "2"
+   },
+   "name" : "Simple-Class-Private-Data",
+   "no_index" : {
+      "directory" : [
+         "t",
+         "inc"
+      ]
+   },
+   "prereqs" : {
+      "build" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : "0"
+         }
+      },
+      "configure" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : "0"
+         }
+      },
+      "runtime" : {
+         "requires" : {}
+      }
+   },
+   "release_status" : "stable",
+   "version" : "0.01"
+}

Simple-Class-Private-Data/META.yml

@@ -0,0 +1,21 @@
+---
+abstract: 'Example class in XS'
+author:
+  - 'Matthew Horsfall <WolfSage@gmail.com>'
+build_requires:
+  ExtUtils::MakeMaker: 0
+configure_requires:
+  ExtUtils::MakeMaker: 0
+dynamic_config: 0
+generated_by: 'ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: Simple-Class-Private-Data
+no_index:
+  directory:
+    - t
+    - inc
+requires: {}
+version: 0.01

Simple-Class-Private-Data/Makefile.PL

@@ -0,0 +1,13 @@
+use 5.014002;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME              => 'Simple::Class::Private::Data',
+    VERSION_FROM      => 'lib/Simple/Class/Private/Data.pm',
+    PREREQ_PM         => {},
+    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM  => 'lib/Simple/Class/Private/Data.pm',
+       AUTHOR         => 'Matthew Horsfall <WolfSage@gmail.com>') : ()),
+    LICENSE           => "perl",
+);
+

Simple-Class-Private-Data/README

@@ -0,0 +1,18 @@
+Simple-Class-Private-Data version 0.01 (EXPERIMENTAL)
+=============================
+
+An example XS Perl class (package).
+
+Interesting files:
+
+  Data.xs                           - The meat of the class, in C/XS.
+  lib/Simple/Class/Private/Data.pm  - The Perl side of the package.
+  t/Simple-Class-Private-Data.t     - A test showing usage.
+
+Created with:
+
+  h2xs -A -n Simple::Class::Private::Data
+
+And then cleaned up significantly.
+
+-- Matthew Horsfall (alh)

Simple-Class-Private-Data/lib/Simple/Class/Private/Data.pm

@@ -0,0 +1,79 @@
+package Simple::Class::Private::Data;
+
+use 5.014002;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+require Exporter;
+our @ISA = qw(Exporter);
+
+require XSLoader;
+XSLoader::load('Simple::Class::Private::Data', $VERSION);
+
+1;
+__END__
+
+=head1 NAME
+
+Simple::Class::Private::Data - Example class in XS
+
+=head1 SYNOPSIS
+
+  my $c = Simple::Class::Private::Data->new(%data);
+
+  $c->display;
+
+=head1 DESCRIPTION
+
+An example XS implementation of a Perl class (package) that 
+contains private data that's unavailable in Perl land.
+
+=head2 Constructor
+
+=head3 new
+
+  Simple::Class::Private::Data->new('cat' => 'meow');
+
+Creates a new L<Simple::Class::Private::Data> object and copies the
+hash passed to C<new()> to it, ensuring that all values
+are non-references.
+
+If the key '_private' exists and is a string, the object becomes magic
+and the data for '_private' is stored where Perl-land can't see it.
+
+Returns the new object.
+
+=head2 Methods
+
+=head3 display
+
+  $obj->display();
+
+Prints out something like:
+
+  Self:
+  	key1: val1
+  	key2: val2
+  	...
+
+If '_private' data was set, C<<display()>> might look like:
+
+  Self:
+        key1: val1
+        (private): some private val
+
+=head1 AUTHOR
+
+Matthew Horsfall (alh) - <WolfSage@gmail.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2013 by Matthew Horsfall.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut