#!/usr/bin/perl -l
use strict;
use warnings;

use Inline C => <<'END_C';

typedef struct Artist {
    char *name;
    SV *perlobj;
} Artist;

typedef struct CD {
    Artist *artist;
    /* ... */
} CD;

/* Constructor for Artist. */
SV*
new_artist(char *name) {
    SV *perlref;
    Artist *artist;

    printf("Creating artist: %s\n", name);
    /* allocate and initialize Artist struct */
    New(0, artist, 1, Artist);
    artist->name = savepv(name);

    /* create perl object and ref; store pointer to object in struct *
+/
    perlref = newSV(0);
    sv_setref_pv(perlref, "Artist", (void*)artist);
    artist->perlobj = SvRV(perlref);

    return perlref;
}

/* Constructor for CD. */
SV*
new_cd(SV *artist_sv) {
    CD *cd;
    Artist *artist = (Artist*) SvIV(SvRV(artist_sv));
    SV *cd_ref;

    printf("Creating CD (artist = %s)\n", artist->name);
    /* allocate and initialize CD struct */
    New(0, cd, 1, CD);
    cd->artist = artist;

    SvREFCNT_inc(artist->perlobj);

    cd_ref = newSV(0);
    sv_setref_pv(cd_ref, "CD", (void*)cd);

    return cd_ref;
}

/* getter */
SV*
get_name_from_artist(SV *artist_sv) {
    Artist *artist = INT2PTR( Artist*, SvIV(SvRV(artist_sv)) );
    return newSVpv(artist->name, 0);
}

/* getter */
SV*
get_artist_name_from_cd(SV *cd_sv) {
    CD *cd = INT2PTR( CD*, SvIV(SvRV(cd_sv)) );
    return newSVpv(cd->artist->name, 0);
}

/* Destructor for Artist objects */
void
destroy_artist(SV *artist_sv) {
    Artist *artist = INT2PTR( Artist*, SvIV(SvRV(artist_sv)) );
    Safefree(artist->name);
    Safefree(artist);
}

/* Destructor for CD objects */
void
destroy_cd(SV *cd_sv) {
    CD *cd = INT2PTR( CD*, SvIV(SvRV(cd_sv)) );
    SvREFCNT_dec(cd->artist->perlobj);
    Safefree(cd);
}

SV* refcnt (SV *sv) {
  return newSViv(SvREFCNT(sv));
}

END_C

package Artist;
use strict;
use warnings;

use Devel::Peek qw( Dump );

sub DESTROY {
    my $artist = shift;
    my $artist_name = main::get_name_from_artist($artist);
    print STDERR "Artist::DESTROY called ($artist_name)";
    main::destroy_artist($artist);
}

package CD;
use strict;
use warnings;

sub DESTROY {
    my $cd = shift;
    print STDERR "CD::DESTROY called.";
    main::destroy_cd($cd);
}

package main;
use strict;
use warnings;

{
  # Create an Artist object.
  my $artist = new_artist("Johnny Houseburner");
  print 'Refcount: $artist: ' . refcnt($artist);
  print 'Refcount: $$artist: ' . refcnt($$artist);

  # Save a copy of the Artist object in a CD object.
  my $cd = new_cd($artist);
  print 'Refcount: $artist: ' . refcnt($artist);
  print 'Refcount: $$artist: ' . refcnt($$artist);
  print 'Refcount: $cd: ' . refcnt($cd);
  print 'Refcount: $$cd: ' . refcnt($$cd);

  print 'undef $artist';
  undef $artist;
  print "Artist name via cd: " . get_artist_name_from_cd($cd);
  print 'undef $cd';
  undef $cd;
  print "End block";
}
print "End code";
[download]