DDumper.xs

   1 /*  Copyright (c) 2007-2008 H.Merijn Brand.  All rights reserved.
   2  *  This program is free software; you can redistribute it and/or
   3  *  modify it under the same terms as Perl itself.
   4  */
   5
   6 #include <EXTERN.h>
   7 #include <perl.h>
   8 #include <XSUB.h>
   9 #include "ppport.h"
  10
  11 SV *_DDump (SV *sv)
  12 {
  13     int   err[3], n, l = 0;
  14     char  buf[128];
  15     SV   *dd;
  16
  17     if (pipe (err)) return (NULL);
  18
  19     dd = Perl_sv_newmortal ();
  20     err[2] = dup (2);
  21     close (2);
  22     if (dup (err[1]) == 2)
  23         Perl_sv_dump (sv);
  24     close (err[1]);
  25     close (2);
  26     dup (err[2]);
  27     close (err[2]);
  28
  29     Perl_sv_setpvn (dd, "", 0);
  30     while ((n = read (err[0], buf, 128)) > 0)
  31 #if PERL_VERSION >= 8
  32         /* perl 5.8.0 did not export Perl_sv_catpvn */
  33         Perl_sv_catpvn_flags (dd, buf, n, SV_GMAGIC);
  34 #else
  35         Perl_sv_catpvn       (dd, buf, n);
  36 #endif
  37     return (dd);
  38     } /* _DDump */
  39
  40 MODULE = DDumper                PACKAGE = DDumper
  41
  42 PROTOTYPES: DISABLE
  43
  44 void
  45 DPeek (sv)
  46     SV   *sv
  47
  48   PPCODE:
  49     ST (0) = newSVpv (Perl_sv_peek (sv), 0);
  50     XSRETURN (1);
  51     /* XS DPeek */
  52
  53 void
  54 DDump_XS (sv)
  55     SV   *sv
  56
  57   PPCODE:
  58     SV   *dd = _DDump (sv);
  59
  60     if (dd) {
  61         ST (0) = dd;
  62         XSRETURN (1);
  63         }
  64
  65     XSRETURN (0);
  66     /* XS DDump */
  67
  68 void
  69 DDump_rf (sv)
  70     SV   *sv
  71
  72   PPCODE:
  73     SV   *dd = SvROK (sv) ? _DDump (SvRV (sv)) : NULL;
  74
  75     if (dd) {
  76         ST (0) = dd;
  77         XSRETURN (1);
  78         }
  79
  80     XSRETURN (0);
  81     /* XS DDump reference */
  82
  83 #if PERL_VERSION >= 8
  84
  85 void
  86 DDump_IO (io, sv, level)
  87     PerlIO *io
  88     SV     *sv
  89     IV      level
  90
  91   PPCODE:
  92     Perl_do_sv_dump (0, io, sv, 1, level, 1, 0);
  93     XSRETURN (1);
  94     /* XS DDump */
  95
  96 #endif