Devel-PLstrtab

Devel-PLstrtab.md

See test.pl for a usage example.

.gitignore

/MYMETA.json
/MYMETA.yml
/Makefile
/PLstrtab.c
/PLstrtab.o
/blib
/pm_to_blib

Makefile.PL

use strict;
use ExtUtils::MakeMaker;

WriteMakefile
    (
	'NAME'	       => 'Devel::PLstrtab',
	'VERSION_FROM' => 'PLstrtab.pm',
    );

PLstrtab.pm

package Devel::PLstrtab;

our $VERSION = '0.01';

require XSLoader;
XSLoader::load();

1;

__END__

PLstrtab.xs

/* -*- c-basic-offset:2 -*- */
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif

MODULE = Devel::PLstrtab	PACKAGE = Devel::PLstrtab

PROTOTYPES: DISABLE

void
dumpToStderr()
    CODE:
    sv_dump(PL_strtab);

SV*
dump()
    PREINIT:
    int   err[3], n;
    char  buf[128];

    CODE:
    if (pipe (err)) return (NULL);
 
    RETVAL = newSVpv("",0);
    err[2] = dup (2);
    close (2);
    if (dup (err[1]) == 2)
        sv_dump (PL_strtab);
    close (err[1]);
    close (2);
    err[1] = dup (err[2]);
    close (err[2]);
 
    sv_setpvn (RETVAL, "", 0);
    while ((n = read (err[0], buf, 128)) > 0)
#if PERL_VERSION >= 8
        /* perl 5.8.0 did not export Perl_sv_catpvn */
        sv_catpvn_flags (RETVAL, buf, n, SV_GMAGIC);
#else
        sv_catpvn       (RETVAL, buf, n);
#endif

    OUTPUT:
    RETVAL

test.pl

#!/usr/bin/perl -w
# -*- cperl -*-

#
# Author: Slaven Rezic
#

use strict;
use Test::More 'no_plan';

use Devel::PLstrtab;

Devel::PLstrtab::dumpToStderr();
my %x = map { ($_=>1) } (1..600);
Devel::PLstrtab::dumpToStderr();

my $ret = Devel::PLstrtab::dump();
warn $ret;

pass "something happened, maybe";

__END__