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         Perl_sv_catpvn (dd, buf, n);
  32     return (dd);
  33     } /* _DDump */
  34
  35 MODULE = DDumper                PACKAGE = DDumper
  36
  37 PROTOTYPES: DISABLE
  38
  39 void
  40 DPeek (sv)
  41     SV   *sv
  42
  43   PPCODE:
  44     ST (0) = newSVpv (Perl_sv_peek (sv), 0);
  45     XSRETURN (1);
  46     /* XS DPeek */
  47
  48 void
  49 DDump_XS (sv)
  50     SV   *sv
  51
  52   PPCODE:
  53     SV   *dd = _DDump (sv);
  54
  55     if (dd) {
  56         ST (0) = dd;
  57         XSRETURN (1);
  58         }
  59
  60     XSRETURN (0);
  61     /* XS DDump */
  62
  63 void
  64 DDump_rf (sv)
  65     SV   *sv
  66
  67   PPCODE:
  68     SV   *dd = SvROK (sv) ? _DDump (SvRV (sv)) : NULL;
  69
  70     if (dd) {
  71         ST (0) = dd;
  72         XSRETURN (1);
  73         }
  74
  75     XSRETURN (0);
  76     /* XS DDump reference */
  77
  78 #if PERL_VERSION >= 8
  79
  80 void
  81 DDump_IO (io, sv, level)
  82     PerlIO *io
  83     SV     *sv
  84     IV      level
  85
  86   PPCODE:
  87     Perl_do_sv_dump (0, io, sv, 1, level, 1, 0);
  88     XSRETURN (1);
  89     /* XS DDump */
  90
  91 #endif